'From Squeak3.0 of 4 February 2001 [latest update: #3545] on 18 February 2001 at 1:11:38 am'!

!AsynchFilePlugin methodsFor: 'primitives' stamp: 'ar 2/6/2001 14:03'!
primitiveAsyncFileOpen: fileName forWrite: writeFlag semaIndex: semaIndex 
	| fileNameSize fOop f |
	self var: #f declareC: 'AsyncFile *f'.
	self primitive: 'primitiveAsyncFileOpen'
		parameters: #(String Boolean SmallInteger ).

	fileNameSize _ interpreterProxy slotSizeOf: (fileName asOop: String).
	(self ioCanOpenAsyncFile: fileName OfSize: fileNameSize Writable: writeFlag)
		ifFalse:[^interpreterProxy primitiveFail].
	fOop _ interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: (self cCode: 'sizeof(AsyncFile)').
	f _ self asyncFileValueOf: fOop.
	interpreterProxy failed ifFalse: [self cCode: 'asyncFileOpen(f, (int)fileName, fileNameSize, writeFlag, semaIndex)'].
	^ fOop! !

!AsynchFilePlugin class methodsFor: 'translation' stamp: 'ar 2/6/2001 14:04'!
headerFile
^'/* Header file for AsynchFile plugin */
/* module initialization/shutdown */
int asyncFileInit(void);
int asyncFileShutdown(void);

/*** Experimental Asynchronous File I/O ***/
typedef struct {
	int			sessionID;
	void		*state;
} AsyncFile;

int asyncFileClose(AsyncFile *f);
int asyncFileOpen(AsyncFile *f, int fileNamePtr, int fileNameSize, int writeFlag, int semaIndex);
int asyncFileRecordSize();
int asyncFileReadResult(AsyncFile *f, int bufferPtr, int bufferSize);
int asyncFileReadStart(AsyncFile *f, int fPosition, int count);
int asyncFileWriteResult(AsyncFile *f);
int asyncFileWriteStart(AsyncFile *f, int fPosition, int bufferPtr, int bufferSize);

/*** security traps ***/
/* following is equivalent ioCanOpenFileOfSize() and should really be handled from there */
int ioCanOpenAsyncFileOfSizeWritable(char* fileNameIndex, int fileNameSize, int writeFlag);

#ifdef DISABLE_SECURITY
#define ioCanOpenAsyncFileOfSizeWritable(index, size, flag) 1
#endif

'! !

!AutoStart class methodsFor: 'class initialization' stamp: 'ar 2/6/2001 17:12'!
initialize
	"AutoStart initialize"

	Smalltalk addToStartUpList: AutoStart after: SecurityManager.! !

I am a conversion utility for reading X11 Bitmap Distribution Format fonts.  My code is derived from the multilingual Squeak changeset written by OHSHIMA Yoshiki (ohshima@is.titech.ac.jp), although all support for fonts with more than 256 glyphs has been ripped out.  See http://www.is.titech.ac.jp/~ohshima/squeak/squeak-multilingual-e.html .

My class methods contain tools for fetching BDF source files from a well-known archive site, batch conversion to Squeak's .sf2 format, and installation of these fonts as TextStyles.  Also, the legal notices for the standard 75dpi fonts I process this way are included as "x11FontLegalNotices'.!
!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:45'!
errorFileFormat
	self error: 'malformed bdf format'! !

!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:46'!
errorUnsupported
	self error: 'unsupported bdf'! !

!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:43'!
getLine
	^self upTo: Character cr.! !

!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:44'!
initialize
	properties _ Dictionary new.! !

!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/23/2000 18:58'!
read
	| xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx array width blt lastAscii pointSize ret dwidth cell cellBlt |
	form _ encoding _ bbx _ nil.
	self initialize.
	self readAttributes.
	height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2).
	ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first.
	descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first.
	pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10.
	
	maxWidth _ 0.
	minAscii _ 9999.
	strikeWidth _ 0.
	maxAscii _ 0.

	charsNum _ Integer readFromString: (properties at: #CHARS) first.
	chars _ Set new: charsNum.

	1 to: charsNum do: [:i |
		array _ self readOneCharacter.
		form _ array at: 1.
		encoding _ array at: 2.
		bbx _ array at: 3.
		dwidth _ array at: 4.

		"form isNil ifFalse: [form morphEdit]."
		"self halt."
		
		form ifNotNil: [
			dwidth _ dwidth - 1.
			width _ dwidth max: (bbx at: 1).
			maxWidth _ maxWidth max: width.
			minAscii _ minAscii min: encoding.
			maxAscii _ maxAscii max: encoding.
			strikeWidth _ strikeWidth + width.
			chars add: array.
		].
	].

	chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)].
	charsNum _ chars size. "undefined encodings make this different"

	xTable _ (Array new: 258) atAllPut: 0.

	glyphs _ Form extent: strikeWidth@height.
	blt _ BitBlt toForm: glyphs.
	lastAscii _ 0.
	
	1 to: charsNum do: [:i | 
		| unspliceArray |
		unspliceArray _ chars at: i.
		form _ unspliceArray at: 1.
		encoding _ unspliceArray at: 2.
		bbx _ unspliceArray at: 3.
		dwidth _ (unspliceArray at: 4).
		width _ dwidth max: (bbx at: 1).
		lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)].

		"I should be able to do all of this in one blit, but I'm too confused.  Create
		a Form of the proper size for this glyph, render the BDF bitmap into it, then 
		stamp it into the StrikeFont glyphs form."
		cell _ Form extent: width@height.
		cellBlt _ BitBlt toForm: cell.

		cellBlt copy: ((bbx at: 3)@((ascent - (bbx at: 2) - (bbx at: 4)))
				extent: (bbx at: 1)@(bbx at: 2))
			from: 0@0 in: form.

		blt copyForm: cell to: (xTable at: encoding+1)@0 rule: Form over.		

		"blt copy: (( ((xTable at: encoding+1)+(bbx at: 3))@(ascent - (bbx at: 2) - (bbx at: 4)))
				extent: (bbx at: 1)@(bbx at: 2))
			from: 0@0 in: form."
		xTable at: encoding+2 put: (xTable at: encoding+1)+(width).
		lastAscii _ encoding.
	].

	ret _ Array new: 8.
	ret at: 1 put: xTable.
	ret at: 2 put: glyphs.
	ret at: 3 put: minAscii.
	ret at: 4 put: maxAscii.
	ret at: 5 put: maxWidth.
	ret at: 6 put: ascent.
	ret at: 7 put: descent.
	ret at: 8 put: pointSize.
	^ret.
" ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}"! !

!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:44'!
readAttributes
	| str a |
	"I don't handle double-quotes correctly, but it works"
	self reset.
	[self atEnd] whileFalse: [
		str _ self getLine.
		(str beginsWith: 'STARTCHAR') ifTrue: [self skip: (0 - str size - 1). ^self].
		a _ str substrings.
		properties at: a first asSymbol put: a allButFirst.
	].
	self error: 'file seems corrupted'.! !

!BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/22/2000 23:33'!
readOneCharacter
	| str a encoding bbx form bits hi low pos char dwidth |
	((str _ self getLine) beginsWith: 'STARTCHAR') ifFalse: [self errorFileFormat].
	char _ str substrings second.
	((str _ self getLine) beginsWith: 'ENCODING') ifFalse: [self errorFileFormat].
	encoding _ Integer readFromString: str substrings second.
	(self getLine beginsWith: 'SWIDTH') ifFalse: [self errorFileFormat].
	((str _ self getLine) beginsWith: 'DWIDTH') ifFalse: [self errorFileFormat].
	dwidth _ Integer readFromString: str substrings second.
	
	((str _ self getLine) beginsWith: 'BBX') ifFalse: [self errorFileFormat].
	a _ str substrings.
	bbx _ (2 to: 5) collect: [:i | Integer readFromString: (a at: i)].
	((str _ self getLine) beginsWith: 'ATTRIBUTES') ifTrue: [str _ self getLine].
	(str beginsWith: 'BITMAP') ifFalse: [self errorFileFormat].

	form _ Form extent: (bbx at: 1)@(bbx at: 2).
	bits _ form bits.
	pos _ 0.
	1 to: (bbx at: 2) do: [:t |
		1 to: (((bbx at: 1) - 1) // 8 + 1) do: [:i |
			hi _ (('0123456789ABCDEF' indexOf: (self next asUppercase)) - 1) bitShift: 4.
			low _ ('0123456789ABCDEF' indexOf: (self next asUppercase)) - 1.
			
			bits byteAt: (pos+i) put: (hi+low).
		].
		self next ~= Character cr ifTrue: [self errorFileFormat].
		pos _ pos + ((((bbx at: 1) + 31) // 32) * 4).
	].

	(self getLine beginsWith: 'ENDCHAR') ifFalse: [self errorFileFormat].

	encoding < 0 ifTrue: [^{nil. nil. nil. nil}].
	^{form. encoding. bbx. dwidth}.
! !

!BDFFontReader class methodsFor: 'file creation' stamp: 'nop 1/23/2000 19:00'!
convertFilesNamed: fileName toFamilyNamed: familyName inDirectoryNamed: dirName
		"BDFFontReader convertFilesNamed: 'helvR' toFamilyNamed: 'Helvetica' inDirectoryNamed: '' "

	"This utility converts X11 BDF font files to Squeak .sf2 StrikeFont files."

	"For this utility to work as is, the BDF files must be named 'familyNN.bdf',
	and must reside in the directory named by dirName (use '' for the current directory).
	The output StrikeFont files will be named familyNN.sf2, and will be placed in the
	current directory."

	| f allFontNames sizeChars dir |
	"Check for matching file names."
	dir _ dirName isEmpty
		ifTrue: [FileDirectory default]
		ifFalse: [FileDirectory default directoryNamed: dirName].
	allFontNames _ dir fileNamesMatching: fileName , '##.bdf'.
	allFontNames isEmpty ifTrue: [^ self error: 'No files found like ' , fileName , 'NN.bdf'].
	
	Utilities informUserDuring: [:info |
		allFontNames do: [:fname | 
			info value: 'Converting ', familyName, ' BDF file ', fname, ' to SF2 format'.
			sizeChars _ (fname copyFrom: fileName size + 1 to: fname size) copyUpTo: $. .

			f _ StrikeFont new readBDFFromFile: (dir fullNameFor: fname) name: familyName, sizeChars.
			f writeAsStrike2named: familyName, sizeChars, '.sf2'.
		].
	]! !

!BDFFontReader class methodsFor: 'resource download' stamp: 'nop 1/23/2000 18:43'!
convertX11FontsToStrike2  "BDFFontReader convertX11FontsToStrike2"
	"Given a set of standard X11 BDF font files (probably downloaded via BDFFontReader downloadFonts), produce .sf2 format fonts.  The source and destination directory is the current directory."

	"Charter currently tickles a bug in the BDF parser.  Skip it for now."
	"self convertFilesNamed: 'charR' toFamilyNamed: 'Charter' inDirectoryNamed: ''."

	self convertFilesNamed: 'courR' toFamilyNamed: 'Courier' inDirectoryNamed: ''.
	self convertFilesNamed: 'helvR' toFamilyNamed: 'Helvetica' inDirectoryNamed: ''.

	self convertFilesNamed: 'lubR' toFamilyNamed: 'LucidaBright' inDirectoryNamed: ''.
	self convertFilesNamed: 'luRS' toFamilyNamed: 'Lucida' inDirectoryNamed: ''.
	self convertFilesNamed: 'lutRS' toFamilyNamed: 'LucidaTypewriter' inDirectoryNamed: ''.

	self convertFilesNamed: 'ncenR' toFamilyNamed: 'NewCenturySchoolbook' inDirectoryNamed: ''.
	self convertFilesNamed: 'timR' toFamilyNamed: 'TimesRoman' inDirectoryNamed: ''.! !

!BDFFontReader class methodsFor: 'resource download' stamp: 'nop 2/11/2001 00:24'!
downloadFonts  "BDFFontReader downloadFonts"
	"Download a standard set of BDF sources from x.org.  
	The combined size of these source files is around 1.2M; after conversion 
	to .sf2 format they may be deleted."

	| heads tails filenames baseUrl basePath newUrl newPath document f |
	heads _ #( 'charR' 'courR' 'helvR' 'lubR' 'luRS' 'lutRS' 'ncenR' 'timR' ).
	tails _ #( '08' '10' '12' '14' '18' '24').

	filenames _ OrderedCollection new.
	heads do: [:head |
		filenames addAll: (tails collect: [:tail | head , tail , '.bdf'])
	].

	baseUrl _ Url absoluteFromText: 'http://ftp.x.org/pub/R6.4/xc/fonts/bdf/75dpi/'.
	basePath _ baseUrl path.

	filenames do: [:filename |
		newUrl _ baseUrl clone.
		newPath _ OrderedCollection newFrom: basePath.

		newPath addLast: filename.
		newUrl path: newPath.

		Utilities informUser: 'Fetching ' , filename during: 
			[document _ newUrl retrieveContents].

		f _ CrLfFileStream newFileNamed: filename.
		f nextPutAll: document content.
		f close.
	].
! !

!BDFFontReader class methodsFor: 'resource download' stamp: 'nop 1/23/2000 18:44'!
installX11Fonts "BDFFontReader installX11Fonts"
	"Installs previously-converted .sf2 fonts into the TextConstants dictionary.  This makes them available as TextStyles everywhere in the image."

	| families fontArray textStyle |
	families _ #( 'Courier' 'Helvetica' 'LucidaBright' 'Lucida' 'LucidaTypewriter' 'NewCenturySchoolbook' 'TimesRoman' ).

	families do: [:family |
		fontArray _ StrikeFont readStrikeFont2Family: family.
		textStyle _ TextStyle fontArray: fontArray.
		TextConstants at: family asSymbol put: textStyle.
	].
! !

!BDFFontReader class methodsFor: 'documentation' stamp: 'nop 2/11/2001 00:22'!
gettingAndInstallingTheFonts

	"Download the 1.3M of BDF font source files from x.org:

		BDFFontReader downloadFonts.

	Convert them to .sf2 StrikeFont files:

		BDFFontReader convertX11FontsToStrike2.

	Install them into the system as TextStyles:

		BDFFontReader installX11Fonts.

	Read the legal notices in 'BDFFontReader x11FontLegalNotices' before
	redistributing images containing these fonts."! !

!BDFFontReader class methodsFor: 'documentation' stamp: 'nop 1/23/2000 18:30'!
x11FontLegalNotices

	^ 'The X11 BDF fonts contain copyright and license information as comments in the
font source code.  For the font family files "cour" (Courier), "helv" (Helvetica), "ncen" (New Century Schoolbook), and "tim" (Times Roman) the notice reads:

COMMENT  Copyright 1984-1989, 1994 Adobe Systems Incorporated.
COMMENT  Copyright 1988, 1994 Digital Equipment Corporation.
COMMENT
COMMENT  Adobe is a trademark of Adobe Systems Incorporated which may be
COMMENT  registered in certain jurisdictions.
COMMENT  Permission to use these trademarks is hereby granted only in
COMMENT  association with the images described in this file.
COMMENT
COMMENT  Permission to use, copy, modify, distribute and sell this software
COMMENT  and its documentation for any purpose and without fee is hereby
COMMENT  granted, provided that the above copyright notices appear in all
COMMENT  copies and that both those copyright notices and this permission
COMMENT  notice appear in supporting documentation, and that the names of
COMMENT  Adobe Systems and Digital Equipment Corporation not be used in
COMMENT  advertising or publicity pertaining to distribution of the software
COMMENT  without specific, written prior permission.  Adobe Systems and
COMMENT  Digital Equipment Corporation make no representations about the
COMMENT  suitability of this software for any purpose.  It is provided "as
COMMENT  is" without express or implied warranty.

For the font family files "char" (Charter), the notice reads:

COMMENT  Copyright 1988 Bitstream, Inc., Cambridge, Massachusetts, USA
COMMENT  Bitstream and Charter are registered trademarks of Bitstream, Inc.
COMMENT  
COMMENT  The names "Bitstream" and "Charter" are registered trademarks of
COMMENT  Bitstream, Inc.  Permission to use these trademarks is hereby
COMMENT  granted only in association with the images described in this file.
COMMENT  
COMMENT  Permission to use, copy, modify, and distribute this software and
COMMENT  its documentation for any purpose and without fee is hereby
COMMENT  granted, provided that the above copyright notice appear in all
COMMENT  copies and that both that copyright notice and this permission
COMMENT  notice appear in supporting documentation, and that the name of
COMMENT  Bitstream not be used in advertising or publicity pertaining to
COMMENT  distribution of the software without specific, written prior
COMMENT  permission.  Bitstream makes no representations about the
COMMENT  suitability of this software for any purpose.  It is provided "as
COMMENT  is" without express or implied warranty.
COMMENT  
COMMENT  BITSTREAM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
COMMENT  INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN
COMMENT  NO EVENT SHALL BITSTREAM BE LIABLE FOR ANY SPECIAL, INDIRECT OR
COMMENT  CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
COMMENT  OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
COMMENT  NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
COMMENT  CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

For the font family files "lu" (Lucida), "lub" (Lucida Bright), and "lut" (Lucida Typewriter),
the notice reads:

COMMENT  (c) Copyright Bigelow & Holmes 1986, 1985. Lucida is a registered
COMMENT  trademark of Bigelow & Holmes. See LEGAL NOTICE file for terms 
COMMENT  of the license. 

The LEGAL NOTICE contains:

This is the LEGAL NOTICE pertaining to the Lucida fonts from Bigelow & Holmes:

	NOTICE TO USER: The source code, including the glyphs or icons 
	forming a par of the OPEN LOOK TM Graphic User Interface, on this 
	tape and in these files is copyrighted under U.S. and international
	laws. Sun Microsystems, Inc. of Mountain View, California owns
	the copyright and has design patents pending on many of the icons. 
	AT&T is the owner of the OPEN LOOK trademark associated with the
	materials on this tape. Users and possessors of this source code 
	are hereby granted a nonexclusive, royalty-free copyright and 
	design patent license to use this code in individual and 
	commercial software. A royalty-free, nonexclusive trademark
	license to refer to the code and output as "OPEN LOOK" compatible 
	is available from AT&T if, and only if, the appearance of the 
	icons or glyphs is not changed in any manner except as absolutely
	necessary to accommodate the standard resolution of the screen or
	other output device, the code and output is not changed except as 
	authorized herein, and the code and output is validated by AT&T. 
	Bigelow & Holmes is the owner of the Lucida (R) trademark for the
	fonts and bit-mapped images associated with the materials on this 
	tape. Users are granted a royalty-free, nonexclusive license to use
	the trademark only to identify the fonts and bit-mapped images if, 
	and only if, the fonts and bit-mapped images are not modified in any
	way by the user. 


	Any use of this source code must include, in the user documentation 
	and internal comments to the code, notices to the end user as  
	follows:


	(c) Copyright 1989 Sun Microsystems, Inc. Sun design patents
	pending in the U.S. and foreign countries. OPEN LOOK is a 
	trademark of AT&T. Used by written permission of the owners.


 	(c) Copyright Bigelow & Holmes 1986, 1985. Lucida is a registered 
	trademark of Bigelow & Holmes. Permission to use the Lucida 
	trademark is hereby granted only in association with the images 
	and fonts described in this file.



	SUN MICROSYSTEMS, INC., AT&T, AND BIGELOW & HOLMES 
	MAKE NO REPRESENTATIONS ABOUT THE SUITABILITY OF
 	THIS SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" 
	WITHOUT EXPRESS OR IMPLIED WARRANTY OF ANY KIND. 
	SUN  MICROSYSTEMS, INC., AT&T AND BIGELOW  & HOLMES, 
	SEVERALLY AND INDIVIDUALLY, DISCLAIM ALL WARRANTIES 
	WITH REGARD TO THIS SOURCE CODE, INCLUDING ALL IMPLIED
	WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
	PARTICULAR PURPOSE. IN NO EVENT SHALL SUN MICROSYSTEMS,
	INC., AT&T OR BIGELOW & HOLMES BE LIABLE FOR ANY
	SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES,
	OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA 	
	OR PROFITS, WHETHER IN AN ACTION OF  CONTRACT, NEGLIGENCE
	OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
	WITH THE USE OR PERFORMANCE OF THIS SOURCE CODE.

'.





! !

!Base64MimeConverter methodsFor: 'conversion' stamp: 'ls 2/10/2001 13:26'!
mimeEncode
	"Convert from data to 6 bit characters."

	| phase1 phase2 raw nib lineLength |
	phase1 _ phase2 _ false.
	lineLength := 0.
	[dataStream atEnd] whileFalse: [
		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].

! !

!BitBltSimulation methodsFor: 'combination rules' stamp: 'hg 2/2/2001 15:23'!
partitionedMul: word1 with: word2 nBits: nBits nPartitions: nParts
	"Multiply word1 with word2 as nParts partitions of nBits each.
	This is useful for packed pixels, or packed colors.
	Bug in loop version when non-white background"

	| sMask product result dMask |
	sMask _ maskTable at: nBits.  "partition mask starts at the right"
	dMask _  sMask << nBits.
	result _ (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) - 1 
				bitAnd: dMask) >> nBits.	"optimized first step"
	product _ (((word1>>nBits bitAnd: sMask)+1) * ((word2>>nBits bitAnd: sMask)+1) - 1 bitAnd: dMask).
	result _ result bitOr: (product bitAnd: dMask).
	product _ (((word1>>(2*nBits) bitAnd: sMask)+1) * ((word2>>(2*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
	result _ result bitOr: (product bitAnd: dMask) << nBits.
	^ result


"	| sMask product result dMask |
	sMask _ maskTable at: nBits.  'partition mask starts at the right'
	dMask _  sMask << nBits.
	result _ (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) - 1 
				bitAnd: dMask) >> nBits.	'optimized first step'
	nBits to: nBits * (nParts-1) by: nBits do: [:ofs |
		product _ (((word1>>ofs bitAnd: sMask)+1) * ((word2>>ofs bitAnd: sMask)+1) - 1 bitAnd: dMask).
		result _ result bitOr: (product bitAnd: dMask) << (ofs-nBits)].
	^ result"! !

!BitBltSimulation methodsFor: 'combination rules' stamp: 'hg 8/24/2000 14:41'!
rgbMul: sourceWord with: destinationWord
	self inline: false.
	destPixSize < 16 ifTrue:
		["Mul each pixel separately"
		^ self partitionedMul: sourceWord with: destinationWord
						nBits: destPixSize nPartitions: pixPerWord].
	destPixSize = 16 ifTrue:
		["Mul RGB components of each pixel separately"
		^ (self partitionedMul: sourceWord with: destinationWord
						nBits: 5 nPartitions: 3)
		+ ((self partitionedMul: sourceWord>>16 with: destinationWord>>16
						nBits: 5 nPartitions: 3) << 16)]
	ifFalse:
		["Mul RGB components of the pixel separately"
		^ self partitionedMul: sourceWord with: destinationWord
						nBits: 8 nPartitions: 3]

"	| scanner |
	Display repaintMorphicDisplay.
	scanner _ DisplayScanner quickPrintOn: Display.
	MessageTally time: [0 to: 760 by: 4 do:  [:y |scanner drawString: 'qwrepoiuasfd=)(/&()=#!!¡lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,Mqwrepoiuasfd=)(/&()=#!!¡lkjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,M1234124356785678' at: 0@y]]. "! !

!BitBltSimulation methodsFor: 'translation support' stamp: 'hg 1/29/2001 17:03'!
initBBOpTable
	self cCode: 'opTable[0+1] = (int)clearWordwith'.
	self cCode: 'opTable[1+1] = (int)bitAndwith'.
	self cCode: 'opTable[2+1] = (int)bitAndInvertwith'.
	self cCode: 'opTable[3+1] = (int)sourceWordwith'.
	self cCode: 'opTable[4+1] = (int)bitInvertAndwith'.
	self cCode: 'opTable[5+1] = (int)destinationWordwith'.
	self cCode: 'opTable[6+1] = (int)bitXorwith'.
	self cCode: 'opTable[7+1] = (int)bitOrwith'.
	self cCode: 'opTable[8+1] = (int)bitInvertAndInvertwith'.
	self cCode: 'opTable[9+1] = (int)bitInvertXorwith'.
	self cCode: 'opTable[10+1] = (int)bitInvertDestinationwith'.
	self cCode: 'opTable[11+1] = (int)bitOrInvertwith'.
	self cCode: 'opTable[12+1] = (int)bitInvertSourcewith'.
	self cCode: 'opTable[13+1] = (int)bitInvertOrwith'.
	self cCode: 'opTable[14+1] = (int)bitInvertOrInvertwith'.
	self cCode: 'opTable[15+1] = (int)destinationWordwith'.
	self cCode: 'opTable[16+1] = (int)destinationWordwith'.
	self cCode: 'opTable[17+1] = (int)destinationWordwith'.
	self cCode: 'opTable[18+1] = (int)addWordwith'.
	self cCode: 'opTable[19+1] = (int)subWordwith'.
	self cCode: 'opTable[20+1] = (int)rgbAddwith'.
	self cCode: 'opTable[21+1] = (int)rgbSubwith'.
	self cCode: 'opTable[22+1] = (int)OLDrgbDiffwith'.
	self cCode: 'opTable[23+1] = (int)OLDtallyIntoMapwith'.
	self cCode: 'opTable[24+1] = (int)alphaBlendwith'.
	self cCode: 'opTable[25+1] = (int)pixPaintwith'.
	self cCode: 'opTable[26+1] = (int)pixMaskwith'.
	self cCode: 'opTable[27+1] = (int)rgbMaxwith'.
	self cCode: 'opTable[28+1] = (int)rgbMinwith'.
	self cCode: 'opTable[29+1] = (int)rgbMinInvertwith'.
	self cCode: 'opTable[30+1] = (int)alphaBlendConstwith'.
	self cCode: 'opTable[31+1] = (int)alphaPaintConstwith'.
	self cCode: 'opTable[32+1] = (int)rgbDiffwith'.
	self cCode: 'opTable[33+1] = (int)tallyIntoMapwith'.
	self cCode: 'opTable[34+1] = (int)alphaBlendScaledwith'.
	self cCode: 'opTable[35+1] = (int)alphaBlendScaledwith'.
	self cCode: 'opTable[36+1] = (int)alphaBlendScaledwith'.	
	self cCode: 'opTable[37+1] = (int)rgbMulwith'.! !

!BitBltSimulation methodsFor: 'primitives' stamp: 'yo 2/14/2001 12:43'!
primitiveDisplayString
	| kernDelta xTable glyphMap stopIndex startIndex sourceString bbObj maxGlyph ascii glyphIndex sourcePtr left |
	self export: true.
	self var: #sourcePtr type: 'unsigned char *'.
	interpreterProxy methodArgumentCount = 6 
		ifFalse:[^interpreterProxy primitiveFail].
	kernDelta _ interpreterProxy stackIntegerValue: 0.
	xTable _ interpreterProxy stackObjectValue: 1.
	glyphMap _ interpreterProxy stackObjectValue: 2.
	((interpreterProxy fetchClassOf: xTable) = interpreterProxy classArray and:[
		(interpreterProxy fetchClassOf: glyphMap) = interpreterProxy classArray])
			ifFalse:[^interpreterProxy primitiveFail].
	(interpreterProxy slotSizeOf: glyphMap) = 256 ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy failed ifTrue:[^nil].
	maxGlyph _ (interpreterProxy slotSizeOf: xTable) - 2.

	stopIndex _ interpreterProxy stackIntegerValue: 3.
	startIndex _ interpreterProxy stackIntegerValue: 4.
	sourceString _ interpreterProxy stackObjectValue: 5.
	(interpreterProxy isBytes: sourceString) ifFalse:[^interpreterProxy primitiveFail].
	(startIndex > 0 and:[stopIndex > 0 and:[
		stopIndex <= (interpreterProxy byteSizeOf: sourceString)]])
			ifFalse:[^interpreterProxy primitiveFail].

	bbObj _ interpreterProxy stackObjectValue: 6.
	(self loadBitBltFrom: bbObj) ifFalse:[^interpreterProxy primitiveFail].
	left _ destX.
	sourcePtr _ interpreterProxy firstIndexableField: sourceString.
	startIndex to: stopIndex do:[:charIndex|
		ascii _ interpreterProxy byteAt: sourcePtr + charIndex - 1.
		glyphIndex _ interpreterProxy fetchInteger: ascii ofObject: glyphMap.
		(glyphIndex < 0 or:[glyphIndex > maxGlyph]) 
			ifTrue:[^interpreterProxy primitiveFail].
		sourceX _ interpreterProxy fetchInteger: glyphIndex ofObject: xTable.
		width _ (interpreterProxy fetchInteger: glyphIndex+1 ofObject: xTable) - sourceX.
		interpreterProxy failed ifTrue:[^nil].
		self clipRange.	"Must clip here"
		(bbW > 0 and:[bbH > 0]) ifTrue: [self copyBits].
		interpreterProxy failed ifTrue:[^nil].
		destX _ destX + width + kernDelta.
	 ].
	affectedL _ left.
	self showDisplayBits.
	interpreterProxy pop: 6. "pop args, return rcvr"! !

!BitBltSimulation class methodsFor: 'initialization' stamp: 'hg 1/29/2001 17:02'!
initializeRuleTable
	"BitBltSimulation initializeRuleTable"
	"**WARNING** You MUST change initBBOpTable if you change this"
	OpTable _ #(
		"0" clearWord:with:
		"1" bitAnd:with:
		"2" bitAndInvert:with:
		"3" sourceWord:with:
		"4" bitInvertAnd:with:
		"5" destinationWord:with:
		"6" bitXor:with:
		"7" bitOr:with:
		"8" bitInvertAndInvert:with:
		"9" bitInvertXor:with:
		"10" bitInvertDestination:with:
		"11" bitOrInvert:with:
		"12" bitInvertSource:with:
		"13" bitInvertOr:with:
		"14" bitInvertOrInvert:with:
		"15" destinationWord:with:
		"16" destinationWord:with: "unused - was old paint"
		"17" destinationWord:with: "unused - was old mask"
		"18" addWord:with:
		"19" subWord:with:
		"20" rgbAdd:with:
		"21" rgbSub:with:
		"22" OLDrgbDiff:with:
		"23" OLDtallyIntoMap:with:
		"24" alphaBlend:with:
		"25" pixPaint:with:
		"26" pixMask:with:
		"27" rgbMax:with:
		"28" rgbMin:with:
		"29" rgbMinInvert:with:
		"30" alphaBlendConst:with:
		"31" alphaPaintConst:with:
		"32" rgbDiff:with:
		"33" tallyIntoMap:with:
		"34" alphaBlendScaled:with:

		"35" alphaBlendScaled:with:	"unused here - only used by FXBlt"
		"36" alphaBlendScaled:with:	"unused here - only used by FXBlt"
		"37" rgbMul:with:
	).
	OpTableSize _ OpTable size + 1.  "0-origin indexing"
! !

!BitBltSimulation class methodsFor: 'translation' stamp: 'hg 2/2/2001 14:36'!
declareCVarsIn: aCCodeGenerator
	aCCodeGenerator var: 'opTable'
		declareC: 'int opTable[' , OpTableSize printString , ']'.
	aCCodeGenerator var: 'maskTable'
		declareC:'int maskTable[33] = {
0, 1, 3, 0, 15, 31, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 65535,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1
}'.
	aCCodeGenerator var: 'ditherMatrix4x4'
		declareC:'const int ditherMatrix4x4[16] = {
0,	8,	2,	10,
12,	4,	14,	6,
3,	11,	1,	9,
15,	7,	13,	5
}'.
	aCCodeGenerator var: 'ditherThresholds16'
		declareC:'const int ditherThresholds16[8] = { 0, 2, 4, 6, 8, 12, 14, 16 }'.
	aCCodeGenerator var: 'ditherValues16'
		declareC:'const int ditherValues16[32] = {
0, 0, 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
}'.

	aCCodeGenerator var: 'warpBitShiftTable'
		declareC:'int warpBitShiftTable[32]'.! !

!BitBltSimulator methodsFor: 'as yet unclassified' stamp: 'hg 2/2/2001 14:15'!
initBBOpTable
	opTable _ OpTable.
	maskTable _ Array new: 32.
	#(1 2 4 5 8 16 32) do:[:i| maskTable at: i put: (1 << i)-1].
	self initializeDitherTables.
	warpBitShiftTable _ CArrayAccessor on: (Array new: 32).! !

!BlockNode methodsFor: 'tiles' stamp: 'RAA 2/16/2001 09:08'!
asMorphicSyntaxIn: parent

	^parent 
		blockNode: self 
		arguments: arguments 
		statements: statements! !

!Browser methodsFor: 'class list' stamp: 'nk 2/13/2001 13:26'!
classListIndex: anInteger 
	"Set anInteger to be the index of the current class selection."

	| className |
	classListIndex _ anInteger.
	self setClassOrganizer.
	messageCategoryListIndex _ 1.
	messageListIndex _ 0.
	self classCommentIndicated
		ifTrue: []
		ifFalse: [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: #classListIndex.	"update my selection"
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #relabel.
	self contentsChanged! !

!Browser methodsFor: 'initialize-release' stamp: 'RAA 2/9/2001 16:36'!
buildMorphicClassList

	| myClassList |

	(myClassList _ PluggableListMorph new) 
			setProperty: #highlightSelector toValue: #highlightClassList:with:;

			on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:.
	myClassList borderWidth: 0.
	myClassList enableDragNDrop: Preferences browseWithDragNDrop.
	^myClassList

! !

!Browser methodsFor: 'initialize-release' stamp: 'RAA 2/9/2001 16:37'!
buildMorphicMessageCatList

	| myMessageCatList |

	(myMessageCatList _ PluggableMessageCategoryListMorph new) 
			setProperty: #highlightSelector toValue: #highlightMessageCategoryList:with:;

			on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: 
			keystroke: #arrowKey:from: getRawListSelector: #rawMessageCategoryList.
	myMessageCatList enableDragNDrop: Preferences browseWithDragNDrop.
	^myMessageCatList
! !

!Browser methodsFor: 'initialize-release' stamp: 'RAA 2/9/2001 16:35'!
buildMorphicMessageList

	| aListMorph |

	(aListMorph _ PluggableListMorph new) 
			setProperty: #highlightSelector toValue: #highlightMessageList:with:;

			on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: Preferences browseWithDragNDrop.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	^aListMorph

! !

!Browser methodsFor: 'initialize-release' stamp: 'RAA 2/9/2001 16:34'!
buildMorphicSystemCatList
	| dragNDropFlag myCatList |
	dragNDropFlag _ Preferences browseWithDragNDrop.
	(myCatList _ PluggableListMorph new) 
			setProperty: #highlightSelector toValue: #highlightSystemCategoryList:with:;

			on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:.
	myCatList enableDragNDrop: dragNDropFlag.
	^myCatList
! !

!Browser methodsFor: 'initialize-release' stamp: 'nk 2/13/2001 13:25'!
labelString
	^self selectedClass ifNil: [ self defaultBrowserTitle ]
		ifNotNil: [ self defaultBrowserTitle, ': ', self selectedClass printString ].
! !

!Browser methodsFor: 'initialize-release' stamp: 'sw 2/6/2001 03:34'!
optionalButtonPairs
	"Answer a tuple (formerly pairs) defining buttons, in the format:
			button label
			selector to send
			help message"

	^ #(
	('senders' 			browseSendersOfMessages	'browse senders of...')
	('implementors'		browseMessages				'browse implementors of...')
	('versions'			browseVersions				'browse versions')), 

	(Preferences decorateBrowserButtons
		ifTrue:
			[{#('inheritance'		methodHierarchy 'browse method inheritance
green: sends to super
tan: has override(s)
mauve: both of the above' )}]
		ifFalse:
			[{#('inheritance'		methodHierarchy			'browse method inheritance')}]),

	#(
	('hierarchy'		classHierarchy				'browse class hierarchy')
	('inst vars'			browseInstVarRefs			'inst var refs...')
	('class vars'			browseClassVarRefs			'class var refs...'))! !

!Browser methodsFor: 'message list' stamp: 'di 2/5/2001 22:04'!
validateMessageSource: selector
	| sourcesName |
	(self selectedClass compilerClass == Object compilerClass 
			and: [(contents asString findString: selector keywords first ) ~= 1])
		ifTrue: [sourcesName _ FileDirectory localNameFor: Smalltalk sourcesName.
			PopUpMenu notify: 'There may be a problem with your sources file!!

The source code for every method should start with the method
selector but this is not the case!! 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.'].! !

!Browser class methodsFor: 'instance creation' stamp: 'nk 2/13/2001 13:47'!
fullOnClass: aClass selector: aSelector
	"Open a new full browser set to class."

	| brow classToUse |
	classToUse _ Preferences browseToolClass.
	brow _ classToUse new.
	brow setClass: aClass selector: aSelector.
	classToUse openBrowserView: (brow openEditString: nil)
		label: brow labelString! !

!CArrayAccessor methodsFor: 'comparing' stamp: 'yo 2/9/2001 11:23'!
< other

	^ (object == other object) and: [offset < other offset].! !

!CArrayAccessor methodsFor: 'comparing' stamp: 'yo 2/9/2001 11:24'!
<= other

	^ (object == other object) and: [offset <= other offset].! !

!CArrayAccessor methodsFor: 'comparing' stamp: 'yo 2/9/2001 11:24'!
> other

	^ (object == other object) and: [offset > other offset].! !

!CArrayAccessor methodsFor: 'comparing' stamp: 'yo 2/9/2001 11:24'!
>= other

	^ (object == other object) and: [offset >= other offset].! !

!CObjectAccessor methodsFor: 'accessing' stamp: 'yo 2/9/2001 11:23'!
object

	^ object! !

!CObjectAccessor methodsFor: 'accessing' stamp: 'yo 2/9/2001 11:23'!
offset

	^ offset
! !

!Celeste methodsFor: 'categories pane' stamp: 'ls 2/10/2001 10:25'!
cacheTOC
	"Caches a version of the TOC"
	| tocStringColumns |
	self initializeTocLists.

	'Processing ' , currentMessages size printString , ' messages.'
		displayProgressAt: Sensor cursorPoint
		from: 0
		to: currentMessages size
		during: [:bar | 1
				to: currentMessages size
				do: [:i | 
					bar value: i.

					(self tocLists at: 1)
						add: i printString.

					"columns from the database are 5"
					tocStringColumns _ mailDB
								getTOCstringAsColumns: (currentMessages at: i).

					(self tocLists at: 2)
						add: ((tocStringColumns at: 5)
								ifTrue: ['@']
								ifFalse: [' ']).
					(self tocLists at: 3)
						add: (tocStringColumns at: 1).
					(self tocLists at: 4)
						add: (tocStringColumns at: 2).
					(self tocLists at: 5)
						add: (tocStringColumns at: 4).
					(self tocLists at: 6)
						add: (tocStringColumns at: 3)]].

	(currentMessages includes: currentMsgID)
		ifFalse: [currentMsgID _ nil]! !

!Celeste methodsFor: 'categories pane' stamp: 'ls 2/10/2001 10:32'!
setCategory: newCategory 
	"Change the currently selected category. We must also compute the table  
	of contents and message list for the new category."
	| messageCount |
	currentCategory _ newCategory.
	newCategory isNil
		ifTrue: [currentMessages _ currentMsgID _ nil.
			self class includeStatusPane
				ifTrue: [status _ nil]]
		ifFalse: [currentMessages _ self filteredMessagesIn: newCategory.
			messageCount _ currentMessages size.
			messageCount > self maxMessagesToDisplay
				ifTrue: [self messages: self maxMessagesToDisplay from: messageCount.
				currentMessages _ currentMessages copyLast: self maxMessagesToDisplay]
				ifFalse: [self messages: messageCount from: messageCount].
			self cacheTOC].
	self changed: #category.
	self changed: #tocEntryList.
	self changed: #tocEntry.
	self changed: #messageText.
	self changed: #status! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 14:24'!
autoFile
	"automatically pick a folder for the current message, and file the current message there"
	| folder |
	folder := self chooseFilterForCurrentMessage.
	folder ifNil: [ ^self].
	lastCategory := folder.
	mailDB file: currentMsgID inCategory: folder.! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 14:24'!
autoMove
	"automatically pick a folder for the current message, and move the message there"
	| folder |
	folder := self chooseFilterForCurrentMessage.
	folder ifNil: [ ^self].
	lastCategory := folder.
	mailDB file: currentMsgID inCategory: folder.
	self removeMessage.! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 10:31'!
nextMessage
	"Select the next message."

	| index |
	(currentCategory isNil | currentMsgID isNil) ifTrue: [^ self].
	index _ currentMessages indexOf: currentMsgID.
	index < currentMessages size
		ifTrue: [self setTOCEntry: ((self tocLists at: 1) at: index + 1)]
		ifFalse: [self setTOCEntry: ((self tocLists at: 1) at: 1)].
! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 10:31'!
previousMessage
	"Select the previous message."

	| index |
	(currentCategory isNil | currentMsgID isNil) ifTrue: [^ self].
	index _ currentMessages indexOf: currentMsgID.
	index > 1
		ifTrue: [self setTOCEntry: ((self tocLists at: 1)  at: index - 1)]
		ifFalse: [self setTOCEntry: ((self tocLists at: 1)  at: currentMessages size)].

! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 10:23'!
removeAll
	"Remove all messages from the current category."
	mailDB removeAll: currentMessages fromCategory: currentCategory.
	currentMsgID _ nil.
	currentMessages _ #().

	self initializeTocLists.
	self changed: #tocEntryList.
	self changed: #tocEntry.
	self changed: #messageText
! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 11:21'!
removeMessage
	"Remove the current message from the current category."
	| currentMessageIndex |
	currentMsgID
		ifNil: [^ self].
	mailDB remove: currentMsgID fromCategory: currentCategory.
	"remove the message from the listing"
	currentMessageIndex _ currentMessages indexOf: currentMsgID.
	currentMessages _ currentMessages copyWithout: currentMsgID.

	2
		to: self tocLists size
		do: [:index | (tocLists at: index) removeAt: currentMessageIndex].
	tocLists first removeLast.


	"update the message index and message ID"
	currentMessages isEmpty
		ifTrue: [currentMsgID _ nil]
		ifFalse: [currentMsgID _ currentMessages
						at: (currentMessageIndex min: currentMessages size)].
	self changed: #tocEntryList.
	self changed: #tocEntry.
	self changed: #messageText! !

!Celeste methodsFor: 'table of contents pane' stamp: 'ls 2/10/2001 10:26'!
setTOCEntry: newTOCentry 
	"Change the currently selected message. This is done by finding the  
	message ID corresponding to the selected table of contents entry."
	| i |
	newTOCentry isNil 
		ifTrue: [currentMsgID _ nil]
		ifFalse: [i _ (self tocLists at: 1)
						indexOf: newTOCentry
						ifAbsent: [].
			i isNil
				ifTrue: [currentMsgID _ nil]
				ifFalse: [currentMsgID _ currentMessages at: i]].
	self changed: #tocEntry.
	Cursor read
		showWhile: [self changed: #messageText]! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 14:26'!
chooseFilterForCurrentMessage
	"automatically choose a filter to move the selected message.  Returns nil if there isn't a message selected, or if there isn't exactly 1 matching filter"
	| matchingFilters |
	currentMsgID ifNil: [ ^nil ].
	matchingFilters := self filtersFor: currentMsgID from: self filterNames.
	matchingFilters size = 1
		ifTrue: [ ^matchingFilters anyOne ]
		ifFalse: [ ^nil ]! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 10:16'!
customFilterNamed: filterName
 	^CustomFiltersCompiled at: filterName! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 14:22'!
customFilterOn
	"Select or define and activate a custom filter."

	| filterName filterMenu |
	filterMenu := CustomMenu new.

	currentMsgID ifNotNil: [
		(self filtersFor: currentMsgID from: self filterNames) do: [ :name |
			filterMenu add: name action: name ].
		filterMenu addLine.].

	filterMenu add: '(none)' action: #none.
	filterMenu add: '<define new filter...>' action: #define.
	filterMenu add: '<edit exising filter...>' action: #edit.
	filterMenu add: '<delete a filter...>' action: #delete.
	filterMenu addLine.

	self filterNames do: [ :name |
		filterMenu add: name action: name ].

	filterName _ filterMenu startUpWithCaption: 'Select a filter:'.

	filterName ifNil: [ ^self ].
	filterName = #none ifTrue: [^self customFilterOff ].
	filterName = #delete ifTrue: [ ^self deleteFilter].
	filterName = #edit
		ifTrue: [filterName _ self editFilter]
		ifFalse: [
			filterName = #define
				ifTrue: [filterName _ self defineFilter] ].
	filterName ifNil: [ ^self ].
	filterName isEmpty ifTrue: [^self].

	customFilterBlock _ CustomFiltersCompiled at: filterName.

	self updateTOC.
	self changed: #isCustomFilterOn.! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 14:22'!
deleteFilter

	| filterName |
	CustomFilters isEmpty ifTrue: [^''].

	filterName _ (CustomMenu selections: self filterNames)
		startUpWithCaption: 'Filter to delete?'.
	filterName = nil ifTrue: [^''].
	CustomFilters removeKey: filterName ifAbsent: [].
	CustomFiltersCompiled removeKey: filterName ifAbsent: [].! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 14:22'!
editFilter

	| filterName |
	CustomFilters isEmpty ifTrue: [^''].

	filterName _ (CustomMenu selections: self filterNames)
		startUpWithCaption: 'Filter to edit?'.
	filterName = nil ifTrue: [^''].
	^self editFilterNamed: filterName filterExpr: (CustomFilters at: filterName)! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 14:21'!
editFilterNamed: filterName filterExpr: oldExpr

	| newDefinition |
	newDefinition _ FillInTheBlank
		request:
'Enter a filter definition where "m" is the message being testing. The expression can send
"fromHas:", "toHas:", "ccHas:", "subjectHas:", "participantHas:", or "textHas:" to m to test for
inclusion of a string--or one of an array of strings--in a field. It can also test m''s time
and/or date and can combine several tests with logical operators. Examples:
 
     m fromHas: ''johnm''                       -- messages from johnm
     m participantHas: ''johnm''                -- messages from, to, or cc-ing johnm
     m textHas: #(squeak smalltalk java)      -- messages with any of these words
     m subjectHas: #(0 1 2 3 4 5 6 7 8 9)       -- numbers in lists treated as strings
 
NOTE: "textHas:" is very slow, since it must read the message from disk.'
		initialAnswer: oldExpr.
	newDefinition isEmpty ifTrue: [^''].
	CustomFilters at: filterName put: newDefinition.
	CustomFiltersCompiled at: filterName put: (self class makeFilterFor: newDefinition).
	^filterName! !

!Celeste methodsFor: 'filtering' stamp: 'ls 2/10/2001 14:18'!
filterNames
	"return a sorted list of custom filter names"
	^CustomFilters keys asSortedArray! !

!Celeste class methodsFor: 'filters' stamp: 'ls 2/10/2001 10:16'!
compileAllCustomFilters
	"recompile all custom filters"
	CustomFiltersCompiled := Dictionary new.
	CustomFilters keysAndValuesDo: [ :filterName :filter |
		CustomFiltersCompiled at: filterName put: (self makeFilterFor: filter) ].! !

!Celeste class methodsFor: 'filters' stamp: 'ls 2/10/2001 10:15'!
makeFilterFor: filterExpr
	"compile a given custom filter"
	^Compiler evaluate: '[ :m | ', filterExpr, ']'.

! !

!CelesteComposition methodsFor: 'private' stamp: 'ls 2/10/2001 13:57'!
breakLines: aString  atWidth: width
	"break lines in the given string into shorter lines"
	| result start end atAttachment |

	result _ WriteStream on: (String new: (aString size * 50 // 49)).

	atAttachment _ false.
	aString asString linesDo: [ :line | 
		(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! !

!CelesteComposition methodsFor: 'private' stamp: 'ls 2/10/2001 14:08'!
breakLinesInMessage: message
	"reformat long lines in the specified message into shorter ones"
	message body  mainType = 'text' ifTrue: [
		"it's a single-part text message.  reformat the text"
		| newBodyText |
		newBodyText := self breakLines: message bodyText  atWidth: 72.
		message body: (MIMEDocument contentType: message body contentType content: newBodyText).

		^self ].

	message body isMultipart ifTrue: [
		"multipart message; process the top-level parts.  HACK: the parts are modified in place"
		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. ].! !

!CelesteComposition methodsFor: 'access' stamp: 'ls 2/10/2001 14:07'!
submit
	| message |
	"submit the message"
	textEditor
		ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]].
	message := MailMessage from: messageText asString.
	self breakLinesInMessage: message.
	celeste queueMessageWithText: message text.

	morphicWindow ifNotNil: [morphicWindow delete].
	mvcWindow ifNotNil: [mvcWindow controller close]! !

!CelesteComposition methodsFor: 'interface' stamp: 'ls 2/10/2001 13:29'!
addAttachment
	| file fileResult fileName |
	textEditor
		ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]].

	(fileResult _ StandardFileMenu oldFile)
		ifNotNil: 
			[fileName _ fileResult directory fullNameFor: fileResult name.
			file _ FileStream readOnlyFileNamed: fileName.
			file ifNotNil: [file binary. self messageText: ((MailMessage from: self messageText asString)
						addAttachmentFrom: file withName: fileResult name; text)]] ! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'ls 2/10/2001 16:35'!
mailOut
	"File out the receiver, to a file whose name is a function of the           
	change-set name and either of the date & time or chosen to have a
	unique numeric tag, depending on the preference
	'sequentialChangeSetRevertableFileNames'."

	| subjectPrefix slips message compressBuffer compressStream data compressedStream compressTarget |
	(Smalltalk includesKey: #Celeste)
		ifFalse: [^ self notify: 'no mail reader present'].

	subjectPrefix _ self chooseSubjectPrefixForEmail.

	self checkForConversionMethods.
	Cursor write showWhile: [
		"prepare the message"
		message := MailMessage empty.
		message setField: 'from' toString: Celeste userName.
		message setField: 'to' toString: 'squeak@cs.uiuc.edu'.
		message setField: 'subject' toString: (subjectPrefix, name). 

		message body: (MIMEDocument contentType: 'text/plain' content: (String streamContents: [ :str |
			str nextPutAll: 'from preamble:';
				cr;
				cr.
				self fileOutPreambleOn: str ])).

		"Prepare the gzipped data"
		data _ data _ WriteStream on: String new.
		data header.
		self fileOutPreambleOn: data.
		self fileOutOn: data.
		self fileOutPostscriptOn: data.
		data trailer.
		data _ ReadStream on: data contents.
		compressBuffer _ ByteArray new: 1000.
		compressStream _ GZipWriteStream on: (compressTarget _ WriteStream on: (ByteArray new: 1000)).
		[data atEnd]
			whileFalse: [compressStream nextPutAll: (data nextInto: compressBuffer)].
		compressStream close.
		compressedStream _ ReadStream on: compressTarget contents asString.

		message addAttachmentFrom: compressedStream withName: (name, '.cs.gz').

		CelesteComposition
			openForCeleste: Celeste current 
			initialText: message text. ].

	Preferences suppressCheckForSlips ifTrue: [^ self].
	slips _ self checkForSlips.
	(slips size > 0 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?'])
		ifTrue: [Smalltalk browseMessageList: slips name: 'Possible slips in ' , name]! !

!Character methodsFor: 'object fileIn' stamp: 'tk 2/16/2001 14:52'!
objectForDataStream: refStrm
	"I am being collected for inclusion in a segment.  Do not include Characters!!  Let them be in outPointers."

	refStrm insideASegment
		ifFalse: ["Normal use" ^ self]
		ifTrue: ["recording objects to go into an ImageSegment"			
			"remove it from references.  Do not trace."
			refStrm references removeKey: self ifAbsent: [].
			^ nil]
! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'hmm 2/2/2001 15:27'!
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.
				lastCharacter _ nil.
				characterPoint _ nextLeftMargin @ destY.
				lastIndex _ lastIndex + 1.
				self lastCharacterExtentSetX: 0.
				^ true].
		lastCharacter _ CR.
		characterPoint _ destX @ destY.
		self lastCharacterExtentSetX: rightMargin - destX.
		^true! !

!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'hmm 2/2/2001 14:59'!
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."
	textStyle alignment = Justified ifTrue:
		[self lastCharacterExtentSetX:
			(lastCharacterExtent x + 	(line justifiedPadFor: (spaceCount + 1))).
		^ 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]].
	(textStyle alignment ~= Justified or: [leadingTab])
		ifTrue:	[self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX
					leftMargin: leftMargin rightMargin: rightMargin) -
						currentX]
		ifFalse:	[self lastCharacterExtentSetX:  (((currentX + (textStyle tabWidth -
						(line justifiedTabDeltaFor: spaceCount))) -
							currentX) max: 0)].
	^ true! !

!CharacterBlockScanner methodsFor: 'private' stamp: 'hmm 2/1/2001 16:20'!
buildCharacterBlockIn: para
	| lineIndex runLength lineStop done stopCondition |
	"handle nullText"
	(para numberOfLines = 0 or: [text size = 0])
		ifTrue:	[^ CharacterBlock new stringIndex: 1  "like being off end of string"
					text: para text
					topLeft: (para leftMarginForDisplayForLine: 1)
								@ para compositionRectangle top
					extent: 0 @ textStyle lineGrid].
	"find the line"
	lineIndex _ para lineIndexOfTop: characterPoint y.
	destY _ para topAtLineIndex: lineIndex.
	line _ para lines at: lineIndex.
	rightMargin _ para rightMarginForDisplay.

	(lineIndex = para numberOfLines and:
		[(destY + line lineHeight) < characterPoint y])
			ifTrue:	["if beyond lastLine, force search to last character"
					self characterPointSetX: rightMargin]
			ifFalse:	[characterPoint y < (para compositionRectangle) top
						ifTrue: ["force search to first line"
								characterPoint _ (para compositionRectangle) topLeft].
					characterPoint x > rightMargin
						ifTrue:	[self characterPointSetX: rightMargin]].
	destX _ (leftMargin _ para leftMarginForDisplayForLine: lineIndex).
	nextLeftMargin_ para leftMarginForDisplayForLine: lineIndex+1.
	lastIndex _ line first.

	self setStopConditions.		"also sets font"
	runLength _ (text runLengthFor: line first).
	characterIndex == nil
		ifTrue:	[lineStop _ line last  "characterBlockAtPoint"]
		ifFalse:	[lineStop _ characterIndex  "characterBlockForIndex"].
	(runStopIndex _ lastIndex + (runLength - 1)) > lineStop
		ifTrue:	[runStopIndex _ lineStop].
	lastCharacterExtent _ 0 @ line lineHeight.
	spaceCount _ 0. done  _ false.
	self handleIndentation.

	[done]
	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: (font widthOf: (text at: lastIndex)).
	(self perform: stopCondition) ifTrue:
		[characterIndex == nil
			ifTrue: ["characterBlockAtPoint"
					^ CharacterBlock new stringIndex: lastIndex text: text
						topLeft: characterPoint + (font descentKern @ 0)
						extent: lastCharacterExtent]
			ifFalse: ["characterBlockForIndex"
					^ CharacterBlock new stringIndex: lastIndex text: text
						topLeft: characterPoint + ((font descentKern) - kern @ 0)
						extent: lastCharacterExtent]]]! !

!CharacterBlockScanner methodsFor: 'scanning' stamp: 'hmm 2/2/2001 15:07'!
indentationLevel: anInteger
	super indentationLevel: anInteger.
	nextLeftMargin _ leftMargin.
	indentationLevel timesRepeat: [
		nextLeftMargin _ textStyle nextTabXFrom: nextLeftMargin
					leftMargin: leftMargin
					rightMargin: rightMargin]! !

!CharacterScanner methodsFor: 'scanning' stamp: 'hmm 7/15/2000 22:40'!
handleIndentation
	self indentationLevel timesRepeat: [
		self plainTab]! !

!CharacterScanner methodsFor: 'scanning' stamp: 'hmm 7/15/2000 22:41'!
plainTab
	"This is the basic method of adjusting destX for a tab."
	destX _ (textStyle 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: 'scanning' stamp: 'hmm 7/14/2000 16:07'!
scanCharactersFrom: 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 |
	<primitive: 103>
	lastIndex _ startIndex.
	[lastIndex <= stopIndex]
		whileTrue: 
			[char _ (sourceString at: lastIndex).
			ascii _ char asciiValue + 1.
			(stops at: ascii) == nil ifFalse: [^stops at: ascii].
			"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."
			nextDestX _ destX + (font widthOf: char).
			nextDestX > rightX ifTrue: [^stops at: CrossedX].
			destX _ nextDestX + kernDelta.
			lastIndex _ lastIndex + 1].
	lastIndex _ stopIndex.
	^stops at: EndOfRun! !

!ChineseCheckers methodsFor: 'drag and drop' stamp: 'ajh 2/15/2001 21:11'!
acceptDroppingMorph: aPiece event: evt

	| dropLoc |
	dropLoc _ self boardLocAt: evt cursorPoint.
	dropLoc = aPiece boardLoc ifTrue:  "Null move"
		[^ aPiece rejectDropMorphEvent: evt].
	(plannedMove _ (self allMovesFrom: aPiece boardLoc)
				detect: [:move | move last = dropLoc]
				ifNone: [nil])
		ifNil: [^ aPiece rejectDropMorphEvent: evt.   "Not a valid move"].

	super acceptDroppingMorph: aPiece event: evt.
	movePhase _ 1.  "Start the animation if any."
! !

!CipherPanel methodsFor: 'initialization' stamp: 'nk 2/16/2001 13:54'!
encodedQuote: aString
	"World addMorph: CipherPanel new"

	| morph prev |
	aString isEmpty ifTrue: [ ^self ].

	(letterMorphs == nil or: [self isClean]) ifFalse:
		[(self confirm: 'Are you sure you want to discard all typing?')
			ifFalse: [^ self]].
	haveTypedHere _ false.
	quote _ aString asUppercase.
	prev _ nil.
	originalMorphs _ quote asArray collectWithIndex:
		[:c :i | WordGameLetterMorph new plain indexInQuote: i id1: nil;
						setLetter: (quote at: i)].
	letterMorphs _ OrderedCollection new.
	decodingMorphs _ quote asArray collectWithIndex:
		[:c :i | (quote at: i) isLetter
		ifTrue:
			[morph _ WordGameLetterMorph new underlined indexInQuote: i id1: nil.
			morph on: #mouseDown send: #mouseDownEvent:letterMorph: to: self.
			morph on: #keyStroke send: #keyStrokeEvent:letterMorph: to: self.
			letterMorphs addLast: morph.
			morph predecessor: prev.
			prev ifNotNil: [prev successor: morph].
			prev _ morph]
		ifFalse:
			[WordGameLetterMorph new plain indexInQuote: i id1: nil; setLetter: (quote at: i)]].
	self color: originalMorphs first color.
	self extent: 500@500
! !

!CipherPanel methodsFor: 'initialization' stamp: 'di 2/14/2001 13:50'!
extent: newExtent 
	"Lay out with word wrap, alternating bewteen decoded and encoded lines."
	"Currently not tolerant of narrow (less than a word) margins"

	| w h relLoc topLeft thisWord i m corner row firstWord |
	self removeAllMorphs.
	w _ originalMorphs first width - 1.  h _ originalMorphs first height * 2 + 10.
	topLeft _ self position + self borderWidth + (0@10).
	thisWord _ OrderedCollection new.
	i _ 1.  firstWord _ true.  relLoc _ 0@0.  corner _ topLeft.
	[i <= originalMorphs size] whileTrue:
		[m _ originalMorphs at: i.
		thisWord addLast: ((decodingMorphs at: i) position: topLeft + relLoc).
		thisWord addLast: (m position: topLeft + relLoc + (0@m height)).
		(m letter = Character space or: [i = originalMorphs size])
			ifTrue: [self addAllMorphs: thisWord.
					corner _ corner max: thisWord last bounds bottomRight.
					thisWord reset.  firstWord _ false].
		relLoc _ relLoc + (w@0).
		(relLoc x + w) > newExtent x
			ifTrue: [firstWord
						ifTrue: ["No spaces -- force a line break"
								thisWord removeLast; removeLast.
								self addAllMorphs: thisWord.
								corner _ corner max: thisWord last bounds bottomRight]
						ifFalse: [i _ i - (thisWord size//2) + 1].
					thisWord reset.  firstWord _ true.
					relLoc _ 0@(relLoc y + h)]
			ifFalse: [i _ i + 1]].
	row _ self buttonRow. row fullBounds.
	self addMorph: row.
	super extent: (corner - topLeft) + (self borderWidth * 2) + (0@row height+10).
	row align: row bounds bottomCenter with: self bounds bottomCenter - (0@2).! !

!CipherPanel methodsFor: 'menu' stamp: 'di 10/4/2000 10:55'!
addMenuItemsTo: aMenu hand: aHandMorph

	aMenu add: 'show cipher help' target: self action: #showHelpWindow.
	aMenu add: 'show cipher hints' target: self action: #showHintsWindow.
	aMenu add: 'clear cipher typing' target: self action: #clearTyping.
	aMenu add: 'enter a new cipher' target: self action: #enterANewCipher.
	aMenu add: 'quote from Squeak' target: self action: #squeakCipher.
! !

!CipherPanel methodsFor: 'menu' stamp: 'di 10/4/2000 10:54'!
buttonRow

	| row aButton |
	row _ AlignmentMorph newRow
		color: self color;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	aButton _ SimpleButtonMorph new target: self.
	aButton color: Color transparent; borderWidth: 1; borderColor: Color black.

	#('show help' 'show hints' 'clear typing' 'enter a new cipher' 'quote from Squeak')
	with: 
	#(showHelpWindow showHintsWindow clearTyping enterANewCipher squeakCipher)
	do: [:label :selector |
		aButton _ aButton fullCopy.
		aButton actionSelector: selector.
		aButton label: label.
		row addMorphBack: aButton.
		row addTransparentSpacerOfSize: (3 @ 0)].

	^ row
! !

!CipherPanel methodsFor: 'menu' stamp: 'di 10/4/2000 11:00'!
enterANewCipher
	self clearTyping; encodedQuote:
		(FillInTheBlank request: 'Type a cipher text to work on here below...')! !

!CipherPanel methodsFor: 'menu' stamp: 'di 10/4/2000 10:48'!
squeakCipher
	self encodedQuote: (CipherPanel encode: (CipherPanel randomComment))! !

!CipherPanel class methodsFor: 'as yet unclassified' stamp: 'di 10/4/2000 10:42'!
encode: aString
	"CipherPanel encode: 'Now is the time for all good men to come to the aid of their country.'"

	| dict repeat |
	dict _ Dictionary new.
	repeat _ true.
	[repeat] whileTrue:
		[repeat _ false.
		($A to: $Z) with: ($A to: $Z) shuffled do:
			[:a :b | a = b ifTrue: [repeat _ true].
			dict at: a put: b]].
	^ aString asUppercase collect: [:a | dict at: a ifAbsent: [a]]! !

!CipherPanel class methodsFor: 'as yet unclassified' stamp: 'di 10/4/2000 10:43'!
randomComment   "CipherPanel randomComment"
	"Generate cryptic puzzles from method comments in the system"
	| c s | s _ 'none'.
	[s = 'none'] whileTrue:
		[s _ ((c _ Smalltalk allClasses atRandom) selectors
					collect: [:sel | (c firstCommentAt: sel) asString])
		 			detect: [:str | str size between: 100 and: 200] ifNone: ['none']].
	^ s! !

!CipherPanel class methodsFor: 'as yet unclassified' stamp: 'di 10/4/2000 10:45'!
tedsHack  
	"Generate cryptic puzzles from method comments in the system"
	(self newFromQuote: (self encode: (self randomComment))) openInWorld

"CipherPanel tedsHack"! !

!ClassBuilder methodsFor: 'private' stamp: 'di 2/12/2001 22:06'!
fixGlobalReferences 
	"Fix all the references to globals which are now outdated.
	Care must be taken that we do not accidentally 'fix' dangerous stuff."
	| oldClasses newClasses condition any |
	classMap == nil ifTrue:[^self].
	(self retryWithGC: [condition _ classMap anySatisfy: [:any0 | any _ any0. any0 _ nil. any notNil and:[any
isObsolete]]. any_nil. condition]
		until:[:obsRef| obsRef = false])
		ifFalse:[^self]. "GC cleaned up the remaining refs"
	"Collect the old and the new refs"
	oldClasses _ OrderedCollection new.
	newClasses _ OrderedCollection new.
	classMap keysAndValuesDo:[:new :old|
		old == nil ifFalse:[
			newClasses add: new.
			oldClasses add: old]].
	oldClasses isEmpty ifTrue:[^self]. "GC cleaned up the rest"

	"Now fix all the known dangerous pointers to old classes by creating
	copies of those still needed. Dangerous pointers should come only
	from obsolete subclasses (where the superclass must be preserved)."
	self fixObsoleteReferencesTo: oldClasses.

	"After this has been done fix the remaining references"
	progress == nil ifFalse:[progress value: 'Fixing references to
globals'].
	"Forward all old refs to the new ones"
	(oldClasses asArray) elementsForwardIdentityTo: (newClasses asArray).
	"Done"! !

!ClassDescription methodsFor: 'initialize-release' stamp: 'di 2/12/2001 22:06'!
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."
	"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 |

	Smalltalk garbageCollect.	"ensure that allInstances is correct"
	oldInstances _ oldClass allInstances asArray.
	self updateInstances: oldInstances from: oldClass isMeta: self isMeta.
	"Now fix up instances in segments that are out on the disk."
	ImageSegment allSubInstancesDo: [:seg |
		seg segUpdateInstancesOf: oldClass toBe: self isMeta: self isMeta].
	oldInstances _ nil.
	Smalltalk garbageCollect.	"ensure that old instances are gone"


"	| 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.
	"
! !

!ClassOrganizer methodsFor: 'accessing' stamp: 'JW 2/15/2001 07:40'!
classComment
	globalComment
		ifNil: [^ ''].
	^ globalComment text ifNil: ['']! !

!Clipboard methodsFor: 'accessing' stamp: 'RAA 2/6/2001 11:18'!
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."

	| s |
	s _ self primitiveClipboardText.
	(s isEmpty or: [s = contents asString])
		ifTrue: [^ contents]
		ifFalse: [^ s asText]! !

!Clipboard methodsFor: 'accessing' stamp: 'RAA 2/6/2001 11:21'!
clipboardText: text
	"Set text currently on the clipboard.  Also export to OS"
	contents _ text.
	self noteRecentClipping: text asText.
	self primitiveClipboardText: text asString! !

!CodeLoader methodsFor: 'installing' stamp: 'ar 2/6/2001 19:11'!
installSegment: reqEntry
	"Install the previously loaded segment"
	| contentStream contents trusted |
	contentStream _ reqEntry value contentStream.
	contentStream ifNil:[^self error:'No content to install: ', reqEntry key printString].
	trusted _ SecurityManager default positionToSecureContentsOf: contentStream.
	trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[
		(contentStream respondsTo: #close) ifTrue:[contentStream close].
		^self error:'Insecure content encountered: ', reqEntry key printString]].
	contents _ contentStream upToEnd unzipped.
	(contentStream respondsTo: #close) ifTrue:[contentStream close].
	^(RWBinaryOrTextStream with: contents) reset fileInObjectAndCode install.! !

!CodeLoader methodsFor: 'installing' stamp: 'ar 2/6/2001 19:13'!
installSourceFile: aStream
	"Install the previously loaded source file"
	| contents trusted |
	aStream ifNil:[^self error:'No content to install'].
	trusted _ SecurityManager default positionToSecureContentsOf: aStream.
	trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[
		(aStream respondsTo: #close) ifTrue:[aStream close].
			^self error:'Insecure content encountered']].
	contents _ aStream upToEnd unzipped.
	(aStream respondsTo: #close) ifTrue:[aStream close].
	^(RWBinaryOrTextStream with: contents) reset fileIn! !

!CodeLoader class methodsFor: 'utilities' stamp: 'ar 2/6/2001 19:22'!
signFile: fileName renameAs: destFile key: privateKey dsa: dsa
	"Sign the given file using the private key."
	| in out |
	in _ FileStream readOnlyFileNamed: fileName.	in binary.
	out _ FileStream newFileNamed: destFile.			out binary.
	[in atEnd] whileFalse:[out nextPutAll: (in next: 4096)].
	in close.	out close.
	FileDirectory splitName: destFile to:[:path :file|
		SecurityManager default signFile: file directory: (FileDirectory on: path).
	].
! !

!CodeLoader class methodsFor: 'utilities' stamp: 'ar 2/6/2001 19:17'!
verifySignedFileNamed: aFileName
	"CodeLoader verifySignedFileNamed: 'signed\dummy1.dsq' "

	| secured signedFileStream |
	signedFileStream _ FileStream fileNamed: aFileName.
	secured _ SecurityManager default positionToSecureContentsOf: signedFileStream.
	signedFileStream close.
	Transcript show: aFileName , ' verified: '; show: secured printString; cr.

! !

!CompositionScanner methodsFor: 'scanning' stamp: 'hmm 2/9/2001 11:55'!
composeFrom: startIndex inRectangle: lineRectangle
	firstLine: firstLine leftSide: leftSide rightSide: rightSide
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength done 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"
	self setStopConditions.	"also sets font"
	runLength _ text runLengthFor: startIndex.
	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
	line _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
				rectangle: lineRectangle.
	spaceCount _ 0.
	self handleIndentation.
	leftMargin _ destX.
	line leftMargin: leftMargin.

	done _ false.
	[done]
		whileFalse: 
			[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
				in: text string rightX: rightMargin stopConditions: stopConditions
				kern: kern.
			"See setStopConditions for stopping conditions for composing."
			(self perform: stopCondition)
				ifTrue: [^ line lineHeight: lineHeight + textStyle leading
							baseline: baseline + textStyle leading]]! !

!CompositionScanner methodsFor: 'scanning' stamp: 'hmm 7/20/2000 18:24'!
composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: aParagraph 
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength done stopCondition |
	destX _ spaceX _ leftMargin _ aParagraph leftMarginForCompositionForLine: lineIndex.
	destY _ 0.
	rightMargin _ aParagraph rightMarginForComposition.
	leftMargin >= rightMargin ifTrue: [self error: 'No room between margins to compose'].
	lastIndex _ startIndex.	"scanning sets last index"
	lineHeight _ textStyle lineGrid.  "may be increased by setFont:..."
	baseline _ textStyle baseline.
	self setStopConditions.	"also sets font"
	self handleIndentation.
	runLength _ text runLengthFor: startIndex.
	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
	line _ TextLineInterval
		start: lastIndex
		stop: 0
		internalSpaces: 0
		paddingWidth: 0.
	spaceCount _ 0.
	done _ false.
	[done]
		whileFalse: 
			[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
				in: text string rightX: rightMargin stopConditions: stopConditions
				kern: kern.
			"See setStopConditions for stopping conditions for composing."
			(self perform: stopCondition)
				ifTrue: [^line lineHeight: lineHeight + textStyle leading
							baseline: baseline + textStyle leading]]! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'ar 1/9/2000 13:59'!
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."

	destX _ textStyle
				nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin.
	destX > rightMargin ifTrue:	[^self crossedX].
	lastIndex _ lastIndex + 1.
	^false
! !

!CompoundTileMorph methodsFor: 'miscellaneous' stamp: 'ar 2/6/2001 22:07'!
recompileScript
	"Pertains only when the test is outside a script?!!"
! !

!CompoundTileMorph methodsFor: 'testing' stamp: 'ar 2/7/2001 17:57'!
isTileEditor
	"Yes I am"
	^true! !

!Debugger methodsFor: 'context stack menu' stamp: 'nk 2/6/2001 19:34'!
where
	"Select the expression whose evaluation was interrupted."

	selectingPC _ true.
	self contextStackIndex: contextStackIndex oldContextWas: self selectedContext
! !

!DigitalSignatureAlgorithm methodsFor: 'initialization' stamp: 'ar 2/1/2001 20:18'!
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 + (Random new next * 16r7FFFFFFF) asInteger.  "a few additional bits randomness"
	k highBit > 512 ifTrue: [k _ k bitShift: k highBit - 512].
	self initRandom: k.
! !

!DisplayMedium methodsFor: 'displaying' stamp: 'hmm 9/16/2000 21:27'!
deferUpdatesIn: aRectangle while: aBlock
	"DisplayScreen overrides with something more involved..."
	^aBlock value! !

!DisplayScanner methodsFor: 'scanning' stamp: 'hmm 9/20/2000 12:54'!
displayLines: linesInterval in: aParagraph clippedBy: visibleRectangle
	"The central display routine. 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)."
	| runLength done stopCondition leftInRun startIndex string lastPos |
	"leftInRun is the # of characters left to scan in the current run;
		when 0, it is time to call 'self setStopConditions'"
	leftInRun _ 0.
	self initializeFromParagraph: aParagraph clippedBy: visibleRectangle.
	ignoreColorChanges _ false.
	paragraph _ aParagraph.
	foregroundColor _ paragraphColor _ aParagraph foregroundColor.
	backgroundColor _ aParagraph backgroundColor.
	aParagraph backgroundColor isTransparent
		ifTrue: [fillBlt _ nil]
		ifFalse: [fillBlt _ bitBlt copy.  "Blt to fill spaces, tabs, margins"
				fillBlt sourceForm: nil; sourceOrigin: 0@0.
				fillBlt fillColor: aParagraph backgroundColor].
	rightMargin _ aParagraph rightMarginForDisplay.
	lineY _ aParagraph topAtLineIndex: linesInterval first.
	bitBlt destForm deferUpdatesIn: visibleRectangle while: [
		linesInterval do: 
			[:lineIndex | 
			leftMargin _ aParagraph leftMarginForDisplayForLine: lineIndex.
			destX _ (runX _ leftMargin).
			line _ aParagraph lines at: lineIndex.
			lineHeight _ line lineHeight.
			fillBlt == nil ifFalse:
				[fillBlt destX: visibleRectangle left destY: lineY
					width: visibleRectangle width height: lineHeight; copyBits].
			lastIndex _ line first.
			leftInRun <= 0
				ifTrue: [self setStopConditions.  "also sets the font"
						leftInRun _ text runLengthFor: line first].
			destY _ lineY + line baseline - font ascent.  "Should have happened in setFont"
			runLength _ leftInRun.
			runStopIndex _ lastIndex + (runLength - 1) min: line last.
			leftInRun _ leftInRun - (runStopIndex - lastIndex + 1).
			spaceCount _ 0.
			done _ false.
			string _ text string.
			self handleIndentation.
			[done] whileFalse:[
				startIndex _ lastIndex.
				lastPos _ destX@destY.
				stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
							in: string rightX: rightMargin stopConditions: stopConditions
							kern: kern.
				lastIndex >= startIndex ifTrue:[
					font displayString: string on: bitBlt 
						from: startIndex to: lastIndex at: lastPos kern: kern].
				"see setStopConditions for stopping conditions for displaying."
				done _ self perform: stopCondition].
			fillBlt == nil ifFalse:
				[fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits].
			lineY _ lineY + lineHeight]]! !

!DisplayScanner methodsFor: 'private' stamp: 'hmm 9/16/2000 21:29'!
initializeFromParagraph: aParagraph clippedBy: clippingRectangle

	super initializeFromParagraph: aParagraph clippedBy: clippingRectangle.
	bitBlt _ BitBlt current toForm: aParagraph destinationForm.
	bitBlt sourceX: 0; width: 0.	"Init BitBlt so that the first call to a primitive will not fail"
	bitBlt combinationRule: Form paint.
	bitBlt colorMap:
		(Bitmap with: 0      "Assumes 1-bit deep fonts"
				with: (aParagraph foregroundColor pixelValueForDepth: bitBlt destForm depth)).
	bitBlt clipRect: clippingRectangle.
! !

!DisplayScanner 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"
! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'hmm 7/16/2000 08:23'!
plainTab
	| oldX |
	oldX _ destX.
	super plainTab.
	fillBlt == nil ifFalse:
		[fillBlt destX: oldX destY: destY width: destX - oldX height: font height; copyBits]! !

!DisplayScanner methodsFor: 'stop conditions' stamp: 'hmm 7/16/2000 08:23'!
tab
	self plainTab.
	lastIndex _ lastIndex + 1.
	^ false! !

!DisplayScanner methodsFor: 'quick print' stamp: 'hmm 9/20/2000 11:44'!
drawString: aString at: aPoint
	"Draw the given string."

	destX _ aPoint x asInteger.
	destY _ aPoint y asInteger.
	lastIndex _ 1.
	self scanCharactersFrom: 1 to: aString size in: aString
		rightX: bitBlt clipX + bitBlt clipWidth + font maxWidth
		stopConditions: stopConditions kern: kern.
	font displayString: aString on: bitBlt from: 1 to: lastIndex at: aPoint kern: kern.! !

!DisplayScanner methodsFor: 'quick print' stamp: 'hmm 2/1/2001 16:24'!
stringWidth: aString
	"Answer the width of the given string."
	destX _ destY _ 0.
	aString ifNil: [^ 0].
	lastIndex _ 1.		"else the prim will fail"
	self scanCharactersFrom: 1 to: aString size in: aString
		rightX: 99999	"virtual infinity"
		stopConditions: stopConditions
		kern: kern.
	^ destX
"
	(1 to: 10) collect: [:i | QuickPrint new stringWidth: (String new: i withAll: $A)]
"! !

!DisplayScreen methodsFor: 'other' stamp: 'hmm 6/18/2000 19:16'!
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 methodsFor: 'other' stamp: 'hmm 2/2/2001 10:14'!
deferUpdatesIn: aRectangle while: aBlock
	| result |
	(self deferUpdates: true) ifTrue: [^aBlock value].
	result _ aBlock value.
	self deferUpdates: false.
	self forceToScreen: aRectangle.
	^result! !

!DisplayScreen methodsFor: 'other' stamp: 'ar 2/14/2001 00:01'!
getCurrentMorphicWorld

        ^RequestCurrentWorldNotification signal ifNil: [
                (self morphicWorldAt: Sensor peekPosition) ifNil: [
                        self getOuterMorphicWorld
                ].
        ]

! !

!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 class methodsFor: 'snapshots' stamp: 'ar 2/5/2001 17:24'!
actualScreenDepth
	<primitive: 'primitiveScreenDepth'>
	^ Display depth! !

This class defines the necessary primitives for dropping files from the OS onto Squeak.

Implementation notes:
The drop support is really a two phase process. The first thing the OS code needs to do is to signal an event of type EventTypeDragDropFiles to Squeak. This event needs to include the following information (see sq.h for the definition of sqDragDropFilesEvent):
* dragType:
		DragEnter - dragging mouse entered Squeak window
		DragMove - dragging mouse moved within Squeak window
		DragLeave - dragging mouse left Squeak window
		DragDrop - dropped files onto Squeak window
* numFiles:
		The number of files in the drop operation.
* x, y, modifiers:
		Associated mouse state.

When these events are received, the primitives implemented by this plugin come into play. The two primitives can be used to either receive a list of file names or to receive a list of (read-only) file handles. Because drag and drop operations are intended to work in a restricted (plugin) environment, certain security precautions need to be taken:
* Access to the contents of the files (e.g., the file streams) must only be granted after a drop occured. Simply dragging the file over the Squeak window is not enough to grant access.
* Access to the contents of the files after a drop is allowed to bypass the file sandbox and create a read-only file stream directly.
* Access to the names of files can be granted even if the files are only dragged over Squeak (but not dropped). This is so that appropriate user feedback can be given.

If somehow possible, the support code should track the location of the drag-and-drop operation and generate appropriate DragMove type events. While not important right now, it will allow us to integrate OS DnD operations with Morphic DnD operation in a seemless manner.
!
!EToyGenericDialogMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/6/2001 14:10'!
genericTextFieldNamed: aString

	| newField |

	newField _ ShowEmptyTextMorph new
		beAllFont: self myFont;
		extent: 300@20;
		contentsWrapped: ''.
	namedFields at: aString put: newField.
	^newField
! !

!EToyVocabulary methodsFor: 'initialization' stamp: 'jla 2/4/2001 19:24'!
initialize
	"Initialize the receiver (automatically called when instances are created via 'new')"

	|   classes aMethodCategory selector selectors categorySymbols |
	super initialize.
	self vocabularyName: #eToy.
	self documentation: '"EToy" is a vocabulary that provides the equivalent of the 1997-2000 etoy prototype'.
	categorySymbols _ Set new.
	classes _ Smalltalk allImplementorsOf: #additionsToViewerCategories.
	classes do:
		[:anItem |
		MessageSet parse: anItem toClassAndSelector:
			[:aClass :aSelector |
		categorySymbols addAll: aClass soleInstance basicNew categoriesForViewer]].

	categorySymbols asOrderedCollection do:
		[:aCategorySymbol |
			aMethodCategory _ ElementCategory new categoryName: aCategorySymbol..
				classes _ (Smalltalk allImplementorsOf: #additionsToViewerCategories) collect:
					[:anItem | MessageSet parse: anItem toClassAndSelector: [:aMetaClass :aSelector | aMetaClass soleInstance]].

			selectors _ Set new.
			classes do:
				[:aClass |
					 (aClass additionsToViewerCategory: aCategorySymbol) do:
						[:anElement |
							anElement first == #command
								ifTrue:
									[selectors add: (selector _ anElement second).
									(methodInterfaces includesKey: selector) ifFalse:
										[methodInterfaces at: selector put: (MethodInterface new initializeFromEToyCommandSpec:  anElement category: aCategorySymbol)]]
								ifFalse:  "#slot format"
									[selectors add: (selector _ anElement seventh).  "the getter"
									selectors add: (anElement at: 9) "the setter".
									(methodInterfaces includesKey: selector) ifFalse:
										[self addGetterAndSetterInterfacesFromOldSlotSpec: anElement]]]].
			(selectors copyWithout: #unused) asSortedArray do:
				[:aSelector |
					aMethodCategory elementAt: aSelector put: (methodInterfaces at: aSelector)].
				 
			self addCategory: aMethodCategory].

	#(scripts 'instance variables') do: [:sym | self addCategoryNamed: sym].
	self setCategoryDocumentationStrings! !

!Encoder methodsFor: 'encoding' stamp: 'RAA 2/5/2001 10:44'!
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 isUppercase ifTrue:
			[globalSourceRanges addLast: { name. range. false }]. ].

	(varNode isTemp and: [varNode scope < 0]) ifTrue: [
		OutOfScopeNotification signal ifFalse: [ ^self notify: 'out of scope'].
	].
	^ varNode! !

!EventSensor methodsFor: 'accessing' stamp: 'ar 2/7/2001 17:13'!
flushEvents
	eventQueue ifNotNil:[eventQueue flush].! !

!EventSensor methodsFor: 'accessing' stamp: 'RAA 2/10/2001 23:16'!
nextEventFromQueue
	"Return the next event from the receiver."
	eventQueue isEmpty ifTrue:[inputSemaphore signal].
	EventPollFrequency _ 500.	"since Squeak is taking the event, reset to normal delay"
	eventQueue isEmpty
		ifTrue:[^nil]
		ifFalse:[^eventQueue next]! !

!EventSensor methodsFor: 'accessing' stamp: 'ar 2/14/2001 00:03'!
peekButtons
	inputSemaphore signal.
	^mouseButtons! !

!EventSensor methodsFor: 'accessing' stamp: 'ar 2/8/2001 21:45'!
peekMousePt
	^mousePosition! !

!EventSensor methodsFor: 'accessing' stamp: 'ar 2/14/2001 00:01'!
peekPosition
	inputSemaphore signal. "get latest state"
	^mousePosition! !

!EventSensor methodsFor: 'private-I/O' stamp: 'RAA 2/10/2001 23:16'!
ioProcess
	"Run the i/o process"
	| eventBuffer type |
	eventBuffer _ Array new: 8.
	[true] whileTrue:[
		[self primGetNextEvent: eventBuffer.
		type _ eventBuffer at: 1.
		type = EventTypeNone] whileFalse:[self processEvent: eventBuffer].
		inputSemaphore waitTimeoutMSecs: EventPollFrequency.
	].
! !

!EventSensor methodsFor: 'private' stamp: 'ar 12/5/2000 13:49'!
primKbdNext
	inputSemaphore signal.
	eventQueue ifNotNil:[eventQueue flush].
	keyboardBuffer isEmpty
		ifTrue:[^nil]
		ifFalse:[^keyboardBuffer next]! !

!EventSensor methodsFor: 'private' stamp: 'ar 12/5/2000 13:50'!
primKbdPeek
	inputSemaphore signal.
	eventQueue ifNotNil:[eventQueue flush].
	^keyboardBuffer peek! !

!EventSensor methodsFor: 'private' stamp: 'ar 12/5/2000 13:50'!
primMouseButtons
	inputSemaphore signal.
	eventQueue ifNotNil:[eventQueue flush].
	^mouseButtons! !

!EventSensor methodsFor: 'private' stamp: 'ar 12/5/2000 13:50'!
primMousePt
	inputSemaphore signal.
	eventQueue ifNotNil:[eventQueue flush].
	^mousePosition! !

!EventSensor methodsFor: 'NOTES' stamp: 'RAA 2/10/2001 23:16'!
higherPerformanceNotes

"
This is mostly a Mac issue, but may have some effect on other platforms. These changes do not take effect until you set the preference #higherPerformance to true. The impact of setting this pref to true may be higher performance for this Squeak image, but lower performance for other applications/processes that may be running concurrently. Experiment with your particular configuration/desires and decide for yourself.

-- 10 Feb 2001 -- removed item #1 since other changes in event handling made it moot --
1. In order to reduce the amount of time lost (perhaps 20 to 30% in some cases) to background applications on the Mac, change the strategy used to poll for UI events. Every time we poll the OS for UI events, increase the delay until the next check. Every time Squeak actually requests an event from EventSensor, reset the delay to its normal value (20 ms). This means that a long-running evaluation started in the UI process will receive less competition from background apps (and less overhead even if it is the only app), but normal UI-intensive operations will happen as they do now. What is lost by this change is some sensitivity to mouse events that occur while Squeak is busy over long periods. My thought is that if Squeak is so occupied for a period of seconds, these events are much less useful and perhaps even harmful.

2. Reduce the minimum morphic cycle time (MinCycleLapse) so that the frame rate (and, hence, running of #step methods) can proceed at greater than 50 frames per second. This can be quite beneficial to things like simulations that are run via #step.
"! !

!EventSensor class methodsFor: 'class initialization' stamp: 'RAA 2/10/2001 23:15'!
initialize
	"EventSensor initialize"
	self initializeEventSensorConstants.

	EventPollFrequency _ 500.
	"Note: The above is important. Most systems will not
	notify the VM about the occurance of events asynchronously.
	Therefore, we have to go check for ourselves every now and then."! !

!FFIPlugin class methodsFor: 'C support code' stamp: 'JMM 2/6/2001 10:55'!
sqMacFFIPPCFile
^'/****************************************************************************
*   PROJECT: Squeak foreign function interface
*   FILE:    sqMacFFIPPC.c
*   CONTENT: Mac/PPC specific support for the foreign function interface
*
*   AUTHOR:  Andreas Raab (ar)
*   ADDRESS: Walt Disney Imagineering, Glendale, CA
*   EMAIL:   Andreas.Raab@disney.com
*   RCSID:   $Id$
*
*   NOTES:
*
*****************************************************************************/
#include "sq.h"
#include "sqFFI.h"

/* note: LONGLONG is usually declared by universal headers */
#ifndef LONGLONG
#define LONGLONG long long
#endif

extern struct VirtualMachine *interpreterProxy;
#define primitiveFail() interpreterProxy->primitiveFail();


#define GP_MAX_REGS 8
#define FP_MAX_REGS 13

/* Values passed in GPR3-GPR10 */
static int GPRegs[8];
/* Nr of GPRegs used so far */
static int gpRegCount = 0;
/* Values passed in FPR1-FPR13 */
static double FPRegs[13];
/* Nr of FPRegs used so far */
static int fpRegCount = 0;

/* Max stack size */
#define FFI_MAX_STACK 512
/* The stack used to assemble the arguments for a call */
static int   ffiStack[FFI_MAX_STACK];
/* The stack pointer while filling the stack */
static int   ffiStackIndex = 0;
/* The area for temporarily allocated strings */
static char *ffiTempStrings[FFI_MAX_STACK];
/* The number of temporarily allocated strings */
static int   ffiTempStringCount = 0;

/* The return values for calls */
static int      intReturnValue;
static LONGLONG longReturnValue;
static double   floatReturnValue;
static int *structReturnValue = NULL;

/**************************************************************/
#define ARG_CHECK() if(gpRegCount >= GP_MAX_REGS && ffiStackIndex >= FFI_MAX_STACK) return primitiveFail();
#define ARG_PUSH(value) { \
	ARG_CHECK(); \
	if(gpRegCount < GP_MAX_REGS) GPRegs[gpRegCount++] = value; \
	ffiStack[ffiStackIndex++] = value; \
}

/*****************************************************************************/
/*****************************************************************************/

/*  ffiInitialize:
	Announce that the VM is about to do an external function call. */
int ffiInitialize(void)
{
	ffiStackIndex = 0;
	gpRegCount = 0;
	fpRegCount = 0;
	floatReturnValue = 0.0;
	return 1;
}

/*  ffiSupportsCallingConvention:
	Return true if the support code supports the given calling convention. */
int ffiSupportsCallingConvention(int callType)
{
	if(callType == FFICallTypeCDecl) return 1;
	if(callType == FFICallTypeApi) return 1;
	return 0;
}

int ffiAlloc(int byteSize)
{
	return (int) malloc(byteSize);
}

int ffiFree(int ptr)
{
	if(ptr) free((void*)ptr);
	return 1;
}

/*****************************************************************************/
/*****************************************************************************/

int ffiPushSignedChar(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushUnsignedChar(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushSignedByte(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushUnsignedByte(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushSignedShort(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushUnsignedShort(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushSignedInt(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushUnsignedInt(int value) 
{ 
	ARG_PUSH(value); 
	return 1; 
}

int ffiPushSignedLongLong(int low, int high)
{
	ARG_PUSH(high);
	ARG_PUSH(low);
	return 1;
}

int ffiPushUnsignedLongLong(int low, int high) 
{ 
	ARG_PUSH(high); 
	ARG_PUSH(low); 
	return 1; 
}

int ffiPushSingleFloat(double value)
{
	float floatValue = (float) value;
	if(fpRegCount < FP_MAX_REGS) {
		/* Still space in FPRegs - so we use the more accurate double value */
		FPRegs[fpRegCount++] = value;
	}
	/* Note: Even for args that are passed in FPRegs 
	   we pass the actual 32bit value in either GPRegs
	   or stack frame for varargs calls. */
	ARG_PUSH(*(int*)(&floatValue));
	return 1;
}

int ffiPushDoubleFloat(double value)
{
	if(fpRegCount < FP_MAX_REGS) {
		/* Still space in FPRegs */
		FPRegs[fpRegCount++] = value;
	}
	/* Note: Even for args that are passed in FPRegs 
	   we pass the actual 64bit value in either GPRegs
	   or stack frame for varargs calls. */
	ARG_PUSH(((int*)(&value))[1]);
	ARG_PUSH(((int*)(&value))[0]);
	return 1;
}

int ffiPushStructureOfLength(int pointer, int *structSpec, int specSize)
{
	int i, typeSpec;
	int *data = (int*) pointer;

	for(i = 0; i<specSize; i++) {
		typeSpec = structSpec[i];
		if(typeSpec & FFIFlagPointer) {
			ARG_PUSH(*data);
			data++;
		} else if(typeSpec & FFIFlagStructure) {
			/* embedded structure */
		} else {
			/* atomic type */
			int atomicType = (typeSpec & FFIAtomicTypeMask) >> FFIAtomicTypeShift;
			switch(atomicType) {
				case FFITypeUnsignedChar:
				case FFITypeUnsignedByte:
					ffiPushUnsignedByte(*(unsigned char*)data);
					break;
				case FFITypeSignedChar:
				case FFITypeSignedByte:
					ffiPushSignedByte(*(signed char*)data);
					break;
				case FFITypeUnsignedShort:
					ffiPushUnsignedShort(*(unsigned short*)data);
					break;
				case FFITypeSignedShort:
					ffiPushSignedShort(*(signed short*)data);
					break;
				case FFITypeUnsignedInt:
					ffiPushUnsignedInt(*(unsigned int*)data);
					break;
				case FFITypeSignedInt:
					ffiPushSignedInt(*(signed int*)data);
					break;
				case FFITypeUnsignedLongLong:
					ffiPushUnsignedLongLong( ((unsigned int*)data)[1], ((unsigned int*)data)[0]);
					break;
				case FFITypeSignedLongLong:
					ffiPushSignedLongLong( ((signed int*)data)[1], ((signed int*)data)[0]);
					break;
				case FFITypeSingleFloat:
					ffiPushSingleFloat( *(float*)data);
					break;
				case FFITypeDoubleFloat:
					{ double fArg;
					  ((int*)&fArg)[0] = ((int*)data)[0];
					  ((int*)&fArg)[1] = ((int*)data)[1];
					  ffiPushDoubleFloat(fArg);
					}
					break;
				default:
					return primitiveFail();
			}
			data = (int*) ((int)data + (typeSpec & FFIStructSizeMask));
		}
	}
	return 1;
}

int ffiPushPointer(int pointer)
{
	ARG_PUSH(pointer);
	return 1;
}

int ffiPushStringOfLength(int srcIndex, int length)
{
	char *ptr;
	ARG_CHECK(); /* fail before allocating */
	ptr = (char*) malloc(length+1);
	if(!!ptr) return primitiveFail();
	memcpy(ptr, (void*)srcIndex, length);
	ptr[length] = 0;
	ffiTempStrings[ffiTempStringCount++] = ptr;
	ARG_PUSH((int)ptr);
	return 1;
}

/*****************************************************************************/
/*****************************************************************************/

/*  ffiCanReturn:
	Return true if the support code can return the given type. */
int ffiCanReturn(int *structSpec, int specSize)
{
	int header = *structSpec;
	if(header & FFIFlagPointer) return 1;
	if(header & FFIFlagStructure) {
		/* structs are always returned as pointers to hidden structures */
		int structSize = header & FFIStructSizeMask;
		structReturnValue = malloc(structSize);
		if(!!structReturnValue) return 0;
		ARG_PUSH((int)structReturnValue);
	}
	return 1;
}

/*  ffiReturnFloatValue:
	Return the value from a previous ffi call with float return type. */
double ffiReturnFloatValue(void)
{
	return floatReturnValue;
}

/*  ffiLongLongResultLow:
	Return the low 32bit from the 64bit result of a call to an external function */
int ffiLongLongResultLow(void)
{
	return ((int*) &longReturnValue)[1];
}

/*  ffiLongLongResultHigh:
	Return the high 32bit from the 64bit result of a call to an external function */
int ffiLongLongResultHigh(void)
{
	return ((int*) &longReturnValue)[0];
}

/*  ffiStoreStructure:
	Store the structure result of a previous ffi call into the given address. */
int ffiStoreStructure(int address, int structSize)
{
	if(structReturnValue) {
		memcpy((void*)address, (void*)structReturnValue, structSize);
	} else {
		memcpy((void*)address, (void*)&intReturnValue, structSize);
  	}
  	return 1;
}

/*  ffiCleanup:
	Cleanup after a foreign function call has completed.
	The generic support code only frees the temporarily
	allocated strings. */
int ffiCleanup(void)
{
	int i;
	for(i=0; i<ffiTempStringCount; i++)
		free(ffiTempStrings[i]);
	ffiTempStringCount = 0;
	if(structReturnValue) {
		free(structReturnValue);
		structReturnValue = NULL;
	}
	return 1;
}


/*****************************************************************************/
/*****************************************************************************/
asm int ffiCallAddressOf(int);

#if TARGET_CPU_PPC
asm int ffiCallAddressOf(int addr) {
	/* Save link register */
	mflr r0
	stw r0, 8(SP)

	/* get stack index and preserve it for copying stuff later */
	lwz r4, ffiStackIndex(RTOC)

	/* compute frame size */
	rlwinm r5, r4, 2, 0, 29  /* ffiStackIndex words to bytes (e.g., "slwi r5, r4, 2") */
	addi r5, r5, 24 /* linkage area */
	neg  r5, r5     /* stack goes down */

	/* adjust stack frame */
	stwux SP, SP, r5

	/* load the stack frame area */
	/* note: r4 == ffiStackIndex */
	addi r5, SP, 24         /* dst = SP + linkage area */
	lwz r6, ffiStack(RTOC)  /* src = ffiStack */
	li r7, 0                /* i = 0 */
	b nextItem
copyItem:
	rlwinm r8, r7, 2, 0, 29 /* r8 = i << 2 (e.g., "slwi r8, r7, 2") */
	lwzx r0, r6, r8         /* r0 = ffiStack[r8] */
	addi r7, r7, 1          /* i = i + 1 */
	stwx r0, r5, r8         /* dst[r8] = r0 */
nextItem:
	cmpw r7, r4             /* i < ffiStackIndex ? */
	blt copyItem

	/* Keep addr in GPR0 so we can load all regs beforehand */
	mr r0, r3

	/* load all the floating point registers */
	lwz r3, fpRegCount
	lwz r12, FPRegs(RTOC)
	cmpwi r3, 0     /* skip all fpregs if no FP values used */
	blt _0_fpregs
	cmpwi r3, 8
	blt _7_fpregs   /* skip last N fpregs if unused */
_all_fpregs:
	lfd  fp8, 56(r12)
	lfd  fp9, 64(r12)
	lfd fp10, 72(r12)
	lfd fp11, 80(r12)
	lfd fp12, 88(r12)
	lfd fp13, 96(r12)
_7_fpregs:
	lfd  fp1,  0(r12)
	lfd  fp2,  8(r12)
	lfd  fp3, 16(r12)
	lfd  fp4, 24(r12)
	lfd  fp5, 32(r12)
	lfd  fp6, 40(r12)
	lfd  fp7, 48(r12)
_0_fpregs:

	/* load all the general purpose registers */
	lwz  r3, gpRegCount
	lwz  r12, GPRegs(RTOC)
	cmpwi r3, 4
	blt _4_gpregs    /* skip last four gpregs if unused */
_all_gpregs:
	lwz  r7, 16(r12)
	lwz  r8, 20(r12)
	lwz  r9, 24(r12)
	lwz r10, 28(r12)
_4_gpregs:
	lwz  r3,  0(r12)
	lwz  r4,  4(r12)
	lwz  r5,  8(r12)
	lwz  r6, 12(r12)
_0_gpregs:

	/* go calling out */
	mr r12, r0      /* tvector into GPR12 */
	/* Note: The code below is nearly identical to to what''s described in
		"MacOS Runtime Architectures"
		Chapter 2, Listing 2-2, pp. 2-11
	*/
	lwz r0, 0(r12)  /* get entry point */
	stw r2, 20(SP)  /* save GPR2 */
	mtctr r0        /* move entry point into count register */
	lwz r2, 4(r12)  /* new base pointer */
	bctrl           /* jump through count register and link */
	lwz r2, 20(SP)  /* restore GPR2 */
	lwz SP, 0(SP)   /* restore frame */

	/* store the result of the call */
	stw r3, intReturnValue(RTOC)
	lwz r12, longReturnValue(RTOC)
	stw r3, 0(r12)
	stw r4, 4(r12)
	stfd fp1, floatReturnValue(RTOC)

	/* and get out of here */
	lwz r0, 8(SP)
	mtlr r0
	blr
}
#else
asm int ffiCallAddressOf(int addr) {
}
#endif

int ffiCallAddressOfWithPointerReturn(int fn, int callType)
{
	return ffiCallAddressOf(fn);
}
int ffiCallAddressOfWithStructReturn(int fn, int callType, int* structSpec, int specSize)
{
	return ffiCallAddressOf(fn);
}

int ffiCallAddressOfWithReturnType(int fn, int callType, int typeSpec)
{
	return ffiCallAddressOf(fn);
}

/*****************************************************************************/
/*****************************************************************************/
/*****************************************************************************/
/************ Test functions for the foreign function interface **************/
/*****************************************************************************/
/*****************************************************************************/
/*****************************************************************************/
#ifndef NO_FFI_TEST
typedef struct ffiTestPoint2 {
	int x;
	int y;
} ffiTestPoint2;

typedef struct ffiTestPoint4 {
	int x;
	int y;
	int z;
	int w;
} ffiTestPoint4;

#pragma export on
EXPORT(char) ffiTestChars(char c1, char c2, char c3, char c4);
EXPORT(short) ffiTestShorts(short c1, short c2, short c3, short c4);
EXPORT(int) ffiTestInts(int c1, int c2, int c3, int c4);
EXPORT(float) ffiTestFloats(float f1, float f2);
EXPORT(double) ffiTestDoubles(double d1, double d2);
EXPORT(char *) ffiPrintString(char *string);
EXPORT(ffiTestPoint2) ffiTestStruct64(ffiTestPoint2 pt1, ffiTestPoint2 pt2);
EXPORT(ffiTestPoint4) ffiTestStructBig(ffiTestPoint4 pt1, ffiTestPoint4 pt2);
EXPORT(ffiTestPoint4*) ffiTestPointers(ffiTestPoint4 *pt1, ffiTestPoint4 *pt2);
EXPORT(LONGLONG) ffiTestLongLong(LONGLONG i1, LONGLONG i2);
#pragma export off


/* test passing characters */
EXPORT(char) ffiTestChars(char c1, char c2, char c3, char c4) {
	printf("4 characters came in as\nc1 = %c (%x)\nc2 = %c (%x)\nc3 = %c (%x)\nc4 = %c (%x)\n", c1, c1, c2, c2, c3, c3, c4, c4);
	return ''C'';
}

/* test passing shorts */
EXPORT(short) ffiTestShorts(short c1, short c2, short c3, short c4) {
	printf("4 shorts came in as\ns1 = %d (%x)\ns2 = %d (%x)\ns3 = %d (%x)\ns4 = %d (%x)\n", c1, c1, c2, c2, c3, c3, c4, c4);
	return -42;
}

/* test passing ints */
EXPORT(int) ffiTestInts(int c1, int c2, int c3, int c4) {
	printf("4 ints came in as\ni1 = %d (%x)\ni2 = %d (%x)\ni3 = %d (%x)\ni4 = %d (%x)\n", c1, c1, c2, c2, c3, c3, c4, c4);
	return 42;
}

/* test passing and returning floats */
EXPORT(float) ffiTestFloats(float f1, float f2) {
	printf("The two floats are %f and %f\n", f1, f2);
	return (float) (f1 + f2);
}

/* test passing and returning doubles */
EXPORT(double) ffiTestDoubles(double d1, double d2) {
	printf("The two floats are %f and %f\n", (float)d1, (float)d2);
	return d1+d2;
}

/* test passing and returning strings */
EXPORT(char*) ffiPrintString(char *string) {
	printf("%s\n", string);
	return string;
}

/* test passing and returning 64bit structures */
EXPORT(ffiTestPoint2) ffiTestStruct64(ffiTestPoint2 pt1, ffiTestPoint2 pt2) {
	ffiTestPoint2 result;
	printf("pt1.x = %d\npt1.y = %d\npt2.x = %d\npt2.y = %d\n",
			pt1.x, pt1.y, pt2.x, pt2.y);
	result.x = pt1.x + pt2.x;
	result.y = pt1.y + pt2.y;
	return result;
}

/* test passing and returning large structures */
EXPORT(ffiTestPoint4) ffiTestStructBig(ffiTestPoint4 pt1, ffiTestPoint4 pt2) {
	ffiTestPoint4 result;
	printf("pt1.x = %d\npt1.y = %d\npt1.z = %d\npt1.w = %d\n",
			pt1.x, pt1.y, pt1.z, pt1.w);
	printf("pt2.x = %d\npt2.y = %d\npt2.z = %d\npt2.w = %d\n",
			pt2.x, pt2.y, pt2.z, pt2.w);
	result.x = pt1.x + pt2.x;
	result.y = pt1.y + pt2.y;
	result.z = pt1.z + pt2.z;
	result.w = pt1.w + pt2.w;
	return result;
}

/* test passing and returning pointers */
EXPORT(ffiTestPoint4*) ffiTestPointers(ffiTestPoint4 *pt1, ffiTestPoint4 *pt2) {
	ffiTestPoint4 *result;
	printf("pt1.x = %d\npt1.y = %d\npt1.z = %d\npt1.w = %d\n",
			pt1->x, pt1->y, pt1->z, pt1->w);
	printf("pt2.x = %d\npt2.y = %d\npt2.z = %d\npt2.w = %d\n",
			pt2->x, pt2->y, pt2->z, pt2->w);
	result = (ffiTestPoint4*) malloc(sizeof(ffiTestPoint4));
	result->x = pt1->x + pt2->x;
	result->y = pt1->y + pt2->y;
	result->z = pt1->z + pt2->z;
	result->w = pt1->w + pt2->w;
	return result;
}

/* test passing and returning longlongs */
EXPORT(LONGLONG) ffiTestLongLong(LONGLONG i1, LONGLONG i2) {
	return i1 + i2;
}

#endif /* NO_FFI_TEST */
'! !

!FXBltSimulation methodsFor: 'inner loop' stamp: 'ar 2/10/2001 00:21'!
copyLoopPixels
	"This version of the inner loop maps source pixels and dest pixels one at a time. This is the most general (and slowest) version which must also keep track of source and dest paint mode by itself."
	| nPix srcShift dstShift destWord srcIndex dstIndex nLines sourceWord lastSrcPix sourcePix srcMask dstMask srcMapped lastDstPix destPix dstMapped resultMapped resultPix srcPaint dstPaint paintMode mergeFn |
	self inline: false.
	mergeFn _ opTable at: combinationRule+1.
	srcPaint _ srcKeyMode.
	dstPaint _ dstKeyMode.
	paintMode _ srcPaint | dstPaint.

	"Additional inits"
	srcMask _ maskTable at: sourceDepth.
	dstMask _ maskTable at: destDepth.
	sourceIndex _ srcIndex _ sourceBits + (sy * sourcePitch) + ((sx // sourcePPW) *4).
	dstIndex _ destIndex.

	"Precomputed shifts for pickSourcePixels"
	srcShift _ ((sx bitAnd: sourcePPW - 1) * sourceDepth).
	dstShift _ ((dx bitAnd: destPPW - 1) * destDepth).
	sourceMSB ifTrue:[srcShift _ 32 - sourceDepth - srcShift].
	destMSB ifTrue:[dstShift _ 32 - destDepth - dstShift].

	srcBitShift _ srcShift.
	dstBitShift _ dstShift.

	noSourceMap 
		ifTrue:[pixelDepth _ sourceDepth]
		ifFalse:[pixelDepth _ 32].
	destMask _ -1.
	nLines _ bbH.
	["this is the vertical loop"
		sourceWord _ self srcLongAt: srcIndex.
		destWord _ self dstLongAt: dstIndex.
		"Prefetch first source pixel"
		lastSrcPix _ sourcePix _ sourceWord >> srcShift bitAnd: srcMask.
		srcMapped _ self mapSourcePixel: sourcePix.
		"Prefetch first dest pixel"
		lastDstPix _ destPix _ destWord >> dstShift bitAnd: dstMask.
		dstMapped _ self mapDestPixel: destPix.
		nPix _ bbW.
		["this is the horizontal loop"
			(paintMode) ifTrue:[
				((srcPaint and:[sourcePix = sourceAlphaKey])
					or:[dstPaint and:[destPix ~= destAlphaKey]])
						ifTrue:[resultMapped _ dstMapped]
						ifFalse:[	resultMapped _ self merge: srcMapped with: dstMapped function: mergeFn].
			] ifFalse:[
				resultMapped _ self merge: srcMapped with: dstMapped function: mergeFn.
			].
			(noColorMap and:[resultMapped = dstMapped]) ifFalse:[
				resultPix _ self mapPixel: resultMapped.
				destWord _ destWord bitAnd: (dstMask << dstShift) bitInvert32.
				destWord _ destWord bitOr: (resultPix bitAnd: dstMask) << dstShift.
			].
			sourceMSB ifTrue:[
				"Adjust source if at pixel boundary"
				(srcShift _ srcShift - sourceDepth) < 0 ifTrue:
					[srcShift _ srcShift + 32.
					sourceWord _ self srcLongAt: (srcIndex _ srcIndex + 4)].
			] ifFalse:[
				"Adjust source if at pixel boundary"
				(srcShift _ srcShift + sourceDepth) > 31 ifTrue:
					[srcShift _ srcShift - 32.
					sourceWord _ self srcLongAt: (srcIndex _ srcIndex + 4)].
			].
			destMSB ifTrue:[
				"Adjust dest if at pixel boundary"
				(dstShift _ dstShift - destDepth) < 0 ifTrue:
					[dstShift _ dstShift + 32.
					self dstLongAt: dstIndex put: destWord.
					destWord _ self dstLongAt: (dstIndex _ dstIndex + 4)].
			] ifFalse:[
				"Adjust dest if at pixel boundary"
				(dstShift _ dstShift + destDepth) > 31 ifTrue:
					[dstShift _ dstShift - 32.
					self dstLongAt: dstIndex put: destWord.
					destWord _ self dstLongAt: (dstIndex _ dstIndex + 4)].
			].
		(nPix _ nPix - 1) = 0] whileFalse:[
			"Fetch next source/dest pixel"
			sourcePix _ sourceWord >> srcShift bitAnd: srcMask.
			lastSrcPix = sourcePix ifFalse:[
				srcMapped _ self mapSourcePixel: sourcePix.
				lastSrcPix _ sourcePix].
			destPix _ destWord >> dstShift bitAnd: dstMask.
			lastDstPix = destPix ifFalse:[
				dstMapped _ self mapDestPixel: destPix.
				lastDstPix _ destPix]
		].
	(nLines _ nLines - 1) = 0] whileFalse:[
		"Store last destWord"
		self dstLongAt: dstIndex put: destWord.
		"Advance sourceIndex, destIndex"
		srcIndex _ sourceIndex _ sourceIndex + sourcePitch.
		dstIndex _ destIndex _ destIndex + destPitch.
		srcShift _ srcBitShift.
		dstShift _ dstBitShift.
	].
	dstIndex <= (destIndex + destPitch + 4) ifTrue:[
		"Store final destWord but not beyound range"
		self dstLongAt: dstIndex put: destWord.
	].

! !

!FXBltSimulation class methodsFor: 'translation' stamp: 'hg 2/2/2001 14:36'!
declareCVarsIn: aCCodeGenerator
	aCCodeGenerator
		var: 'colorMap' declareC:'int *colorMap';
		var: 'cmShiftTable' declareC:'int *cmShiftTable';
		var: 'cmMaskTable' declareC:'int *cmMaskTable';
		var: 'sourceMap' declareC:'int *sourceMap';
		var: 'smShiftTable' declareC:'int *smShiftTable';
		var: 'smMaskTable' declareC:'int *smMaskTable';
		var: 'destMap' declareC:'int *destMap';
		var: 'dmShiftTable' declareC:'int *dmShiftTable';
		var: 'dmMaskTable' declareC:'int *dmMaskTable';
		var: 'warpQuad' declareC:'int warpQuad[8]';
		var: 'tallyMap' declareC:'int *tallyMap'.
	aCCodeGenerator var: 'opTable'
		declareC: 'int opTable[' , OpTableSize printString , ']'.
	aCCodeGenerator var: 'maskTable'
		declareC:'int maskTable[33] = {
0, 1, 3, 0, 15, 31, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 65535,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1
}'.
	aCCodeGenerator var: 'ditherMatrix4x4'
		declareC:'const int ditherMatrix4x4[16] = {
0,	8,	2,	10,
12,	4,	14,	6,
3,	11,	1,	9,
15,	7,	13,	5
}'.
	aCCodeGenerator var: 'ditherThresholds16'
		declareC:'const int ditherThresholds16[8] = { 0, 2, 4, 6, 8, 12, 14, 16 }'.
	aCCodeGenerator var: 'ditherValues16'
		declareC:'const int ditherValues16[32] = {
0, 0, 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
}'.

	aCCodeGenerator var: 'warpBitShiftTable'
		declareC:'int warpBitShiftTable[32]'.! !

!FXBltSimulator methodsFor: 'as yet unclassified' stamp: 'hg 2/2/2001 15:55'!
initBBOpTable
	opTable _ OpTable.
	maskTable _ Array new: 32.
	#(1 2 4 5 8 16 32) do:[:i| maskTable at: i put: (1 << i)-1].
	self initializeDitherTables.
	warpBitShiftTable _ CArrayAccessor on: (Array new: 32).
	cmCache _ CArrayAccessor on: (Array new: ColorCacheSize*2).
	warpQuad _ CArrayAccessor on: (Array new: 8).! !

!FileDirectory methodsFor: 'enumeration' stamp: 'ar 2/6/2001 15:48'!
localName
	"Return the local name of this directory."

	^FileDirectory localNameFor: pathName! !

!FileDirectory methodsFor: 'file directory' stamp: 'ar 2/6/2001 15:48'!
assureExistance
	"Make sure the current directory exists. If necessary, create all parts inbetween"
	^self containingDirectory assureExistanceOfPath: self localName! !

!FileDirectory methodsFor: 'file directory' stamp: 'ar 2/6/2001 15:50'!
assureExistanceOfPath: localPath
	"Make sure the local directory exists. If necessary, create all parts inbetween"
	(self directoryNames includes: localPath) ifTrue:[^self]. "exists"
	"otherwise check parent first and then create local dir"
	self containingDirectory assureExistanceOfPath: self localName.
	self createDirectory: localPath.! !

!FileDirectory class methodsFor: 'name utilities' stamp: 'ar 2/12/2001 15:45'!
startUp
	"Establish the platform-specific FileDirectory subclass. Do any platform-specific startup."
	self setDefaultDirectoryFrom: Smalltalk imageName.
	Preferences startInUntrustedDirectory 
		ifTrue:[	self setDefaultDirectory: SecurityManager default untrustedUserDirectory.
				"Make sure we have a place to go to"
				DefaultDirectory assureExistance].
	Smalltalk openSourceFiles.
! !

!FileDirectory class methodsFor: 'system start up' stamp: 'ar 2/12/2001 15:30'!
openChanges: changesName forImage: imageName
	"Initialize the default directory to the image directory and open the  
	sources and changes files, if possible. Look for the changes file in  
	image directory. Look for the system sources (or an alias to it) first in  
	the VM directory, then in the image directory. Open the changes and  
	sources files and install them in SourceFiles."
	| changes fd |
	"look for the changes file or an alias to it in the image directory"
	fd _ FileDirectory on: (FileDirectory dirPathFor: imageName).
	(fd fileExists: changesName)
		ifTrue: [changes _ fd oldFileNamed: changesName].
	changes ifNotNil:[^changes].
	"look for the changes in the current directory"
	fd _ DefaultDirectory.
	(fd fileExists: changesName)
		ifTrue: [changes _ fd oldFileNamed: changesName].
	changes ifNotNil:[^changes].
	"look for read-only changes in the image directory"
	fd _ FileDirectory on: (FileDirectory dirPathFor: imageName).
	(fd fileExists: changesName)
		ifTrue: [changes _ fd readOnlyFileNamed: changesName].
	changes ifNotNil:[^changes].
	"look for read-only changes in the current directory"
	fd _ DefaultDirectory.
	(fd fileExists: changesName)
		ifTrue: [changes _ fd readOnlyFileNamed: changesName].
	^changes
! !

!FileDirectory class methodsFor: 'system start up' stamp: 'ar 2/12/2001 15:23'!
openSources: sourcesName andChanges: changesName forImage: imageName 
	"Initialize the default directory to the image directory and open the  
	sources and changes files, if possible. Look for the changes file in  
	image directory. Look for the system sources (or an alias to it) first in  
	the VM directory, then in the image directory. Open the changes and  
	sources files and install them in SourceFiles."
	"Note: SourcesName and imageName are full paths; changesName is a  
	local name."
	| sources changes msg wmsg |
	msg _ 'Squeak cannot locate &fileRef.

Please check that the file is named properly and is in the
same directory as this image.  
Further explanation can found
in the startup window, ''How Squeak Finds Source Code''.'.
	wmsg _ 'Squeak 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.'.

	sources _ self openSources: sourcesName forImage: imageName.
	changes _ self openChanges: changesName forImage: imageName.
	((sources == nil or: [sources atEnd])
		and: [Preferences valueOfFlag: #warnIfNoSourcesFile])
		ifTrue: 
			[PopUpMenu notify: (msg copyReplaceAll: '&fileRef' with: 'the sources file named ' , sourcesName).
			Smalltalk platformName = 'Mac OS'
				ifTrue: [PopUpMenu notify: 'Make sure the sources file is not an Alias.']].
	(changes == nil and: [Preferences valueOfFlag: #warnIfNoChangesFile])
		ifTrue: [PopUpMenu notify: (msg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)].
	(Preferences valueOfFlag: #warnIfNoChangesFile) ifTrue: [
		changes isReadOnly ifTrue:[
			PopUpMenu notify: 
				(wmsg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)].
		((changes next: 200) includesSubString: String crlf) ifTrue: [
			PopUpMenu notify: 'The changes file named ' , changesName, '
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.']].
	SourceFiles _ Array with: sources with: changes! !

!FileDirectory class methodsFor: 'system start up' stamp: 'ar 2/12/2001 15:19'!
openSources: fullSourcesName forImage: imageName 
	"Initialize the default directory to the image directory and open the  
	sources and changes files, if possible. Look for the changes file in  
	image directory. Look for the system sources (or an alias to it) first in  
	the VM directory, then in the image directory. Open the changes and  
	sources files and install them in SourceFiles."
	| sources fd sourcesName |
	sourcesName _ FileDirectory localNameFor: fullSourcesName.
	"look for the sources file or an alias to it in the VM's directory"
	fd _ FileDirectory on: Smalltalk vmPath.
	(fd fileExists: sourcesName)
		ifTrue: [sources _ fd readOnlyFileNamed: sourcesName].
	sources ifNotNil:[^sources].
	"look for the sources file or an alias to it in the image directory"
	fd _ FileDirectory on: (FileDirectory dirPathFor: imageName).
	(fd fileExists: sourcesName)
		ifTrue: [sources _ fd readOnlyFileNamed: sourcesName].
	sources ifNotNil:[^sources].
	"look for the sources in the current directory"
	fd _ DefaultDirectory.
	(fd fileExists: sourcesName)
		ifTrue: [sources _ fd readOnlyFileNamed: sourcesName].
	^sources
! !

!FileDirectory class methodsFor: 'system start up' stamp: 'ar 2/12/2001 15:39'!
setDefaultDirectory: directoryName
	"Initialize the default directory to the directory supplied. This method is called when the image starts up."
	| dirName |
	DirectoryClass _ self activeDirectoryClass.
	dirName _ directoryName.
	[dirName endsWith: self slash] whileTrue:[
		dirName _ dirName copyFrom: 1 to: dirName size - self slash size.
	].
	DefaultDirectory _ self on: dirName.! !

!FileDirectoryWrapper methodsFor: 'as yet unclassified' stamp: 'ar 2/12/2001 16:20'!
contents

	^((model directoryNamesFor: item) sortBy: [ :a :b | a caseInsensitiveLessOrEqual: b]) collect: [ :n | 
		FileDirectoryWrapper with: (item directoryNamed: n) name: n model: self
	]
! !

!FileDirectoryWrapper methodsFor: 'as yet unclassified' stamp: 'ar 2/12/2001 16:22'!
directoryNamesFor: anItem
	^model directoryNamesFor: anItem! !

!FileList methodsFor: 'file list menu' stamp: 'sw 2/16/2001 16:22'!
fileSelectedMenu: aMenu
	"Fill the menu with items appropriate for the selected file type, or for all file types if the shift key is down"

	| firstItems secondItems thirdItems n1 n2 n3 |
	firstItems _ self itemsForFileEnding:
		(Sensor leftShiftDown
			ifFalse:
				[self fileNameSuffix asLowercase]
			ifTrue:
				['*']).

	secondItems _ self itemsForAnyFile.
	thirdItems _ self itemsForNoFile.
	n1 _ firstItems first size.
	n2 _ n1 + secondItems first size.
	n3 _ n2 + thirdItems first size.
	^ aMenu
		labels: firstItems first , secondItems first , thirdItems first , #('more...')
		lines: firstItems second
				, (Array with: n1 with: n2)
				, (thirdItems second collect: [:n | n + n2])
				, (Array with: n3)
		selections: firstItems third , secondItems third , thirdItems third , #(offerAllFileOptions)! !

!FileList2 methodsFor: 'as yet unclassified' stamp: 'ar 2/12/2001 16:20'!
directoryNamesFor: item
	"item may be file directory or server directory"
	| entries |
	entries _ item directoryNames.
	dirSelectionBlock ifNotNil:[entries _ entries select: dirSelectionBlock].
	^entries! !

!FileList2 methodsFor: 'as yet unclassified' stamp: 'ar 2/12/2001 16:12'!
initialDirectoryList

	| dir nameToShow dirList |
	dirList _ (FileDirectory on: '') directoryNames collect: [ :each |
		FileDirectoryWrapper with: (FileDirectory on: each) name: each model: self].
	dirList isEmpty ifTrue:[
		dirList _ Array with: (FileDirectoryWrapper 
			with: FileDirectory default 
			name: FileDirectory default localName 
			model: self)].
	dirList _ dirList,(
		ServerDirectory serverNames collect: [ :n | 
			dir _ ServerDirectory serverNamed: n.
			nameToShow _ n.
			(dir directoryWrapperClass with: dir name: nameToShow model: self)
				balloonText: dir realUrl
		]
	).
	^dirList! !

!FileList2 methodsFor: 'as yet unclassified' stamp: 'RAA 2/17/2001 12:25'!
limitedSuperSwikiDirectoryList

	| dir nameToShow dirList |

	dirList _ OrderedCollection new.
	ServerDirectory serverNames do: [ :n | 
		dir _ ServerDirectory serverNamed: n.
		(dir isKindOf: SuperSwikiServer) ifTrue: [
			nameToShow _ n.
			dirList add: ((dir directoryWrapperClass with: dir name: nameToShow model: self)
				balloonText: dir realUrl)
		].
	].

	{Project current squeakletDirectory} do: [ :each |
		dirList add: (FileDirectoryWrapper with: each name: each localName model: self)
	].
	^dirList! !

!FileList2 methodsFor: 'as yet unclassified' stamp: 'RAA 2/17/2001 12:48'!
limitedSuperSwikiPublishDirectoryList

	| dir nameToShow dirList |

	dirList _ OrderedCollection new.
	ServerDirectory serverNames do: [ :n | 
		dir _ ServerDirectory serverNamed: n.
		(dir isKindOf: SuperSwikiServer) ifTrue: [
			nameToShow _ n.
			dirList add: ((dir directoryWrapperClass with: dir name: nameToShow model: self)
				balloonText: dir realUrl)
		].
	].
	^dirList! !

!FileList2 methodsFor: 'as yet unclassified' stamp: 'RAA 2/17/2001 12:18'!
morphicDirectoryTreePane

	^self morphicDirectoryTreePaneFiltered: #initialDirectoryList
! !

!FileList2 methodsFor: 'as yet unclassified' stamp: 'RAA 2/17/2001 12:17'!
morphicDirectoryTreePaneFiltered: aSymbol

	^(SimpleHierarchicalListMorph 
		on: self
		list: aSymbol
		selected: #getSelectedDirectory
		changeSelected: #setSelectedDirectoryTo:
		menu: nil
		keystroke: nil) autoDeselect: false
		
! !

!FileList2 class methodsFor: 'blue ui' stamp: 'RAA 2/17/2001 12:26'!
morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol

	| window aFileList buttons treePane textColor1 fileListPane pane2a pane2b |

	window _ AlignmentMorphBob1 newColumn.
	window hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	textColor1 _ Color r: 0.742 g: 0.839 b: 1.0.
	aFileList _ self new directory: FileDirectory default.
	aFileList 
		optionalButtonSpecs: self specsForProjectLoader;
		fileSelectionBlock: self projectOnlySelectionBlock;
		"dirSelectionBlock: self hideSqueakletDirectoryBlock;"
		modalView: window.
	window
		setProperty: #FileList toValue: aFileList;
		wrapCentering: #center; cellPositioning: #topCenter;
		borderWidth: 4;
		borderColor: (Color r: 0.355 g: 0.516 b: 1.0);
		useRoundedCorners.
	buttons _ #('OK' 'Cancel') collect: [ :each |
		self blueButtonText: each textColor: textColor1 inWindow: window
	].
	(treePane _ aFileList morphicDirectoryTreePaneFiltered: aSymbol)
		extent: 250@300; 
		retractable: false;
		borderWidth: 0.
	fileListPane _ aFileList morphicFileListPane 
		extent: 350@300; 
		retractable: false;
		borderWidth: 0.
	window
		addARow: {
			window fancyText: 'Load A Project' ofSize: 21 color: textColor1
		};
		addARowCentered: {
			buttons first. 
			(Morph new extent: 30@5) color: Color transparent. 
			buttons second
		};
		addARow: {
			window fancyText: 'Please select a project' ofSize: 21 color: Color blue
		};
		addARow: {
			(window inAColumn: {(pane2a _ window inARow: {window inAColumn: {treePane}}) 
				useRoundedCorners; layoutInset: 6}) layoutInset: 10.
			(window inAColumn: {(pane2b _ window inARow: {window inAColumn: {fileListPane}}) 
				useRoundedCorners; layoutInset: 6}) layoutInset: 10.
		}.
	window fullBounds.
	window fillWithRamp: self blueRamp1 oriented: 0.65.
	pane2a fillWithRamp: self blueRamp3 oriented: (0.7 @ 0.35).
	pane2b fillWithRamp: self blueRamp3 oriented: (0.7 @ 0.35).
	buttons do: [ :each |
		each fillWithRamp: self blueRamp2 oriented: (0.75 @ 0).
	].
	buttons first 
		on: #mouseUp 
		send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit])
		to: aFileList.
	buttons second on: #mouseUp send: #cancelHit to: aFileList.
	aFileList postOpen.
	window position: aWorld topLeft + (aWorld extent - window extent // 2).
	^ window openInWorld: aWorld.! !

!FileList2 class methodsFor: 'blue ui' stamp: 'RAA 2/17/2001 13:03'!
morphicViewProjectSaverFor: aProject
"
(FileList2 morphicViewProjectSaverFor: Project current) openInWorld
"
	| window aFileList buttons treePane pane2 textColor1 option |

	textColor1 _ Color r: 0.742 g: 0.839 b: 1.0.
	aFileList _ self new directory: FileDirectory default.
	aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock.
	window _ AlignmentMorphBob1 newColumn.
	window hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	aFileList modalView: window.
	window
		setProperty: #FileList toValue: aFileList;
		wrapCentering: #center; cellPositioning: #topCenter;
		borderWidth: 4;
		borderColor: (Color r: 0.355 g: 0.516 b: 1.0);
		useRoundedCorners.
	buttons _ #( ('OK' okHit) ('Cancel' cancelHit) ) collect: [ :each |
		(self blueButtonText: each first textColor: textColor1 inWindow: window)
			on: #mouseUp send: each second to: aFileList
	].
	option _ aProject world 
		valueOfProperty: #SuperSwikiPublishOptions 
		ifAbsent: [#initialDirectoryList].
	aProject world removeProperty: #SuperSwikiPublishOptions.
	(treePane _ aFileList morphicDirectoryTreePaneFiltered: option) 
		extent: 350@300; 
		retractable: false;
		borderWidth: 0.
	window
		addARowCentered: {
			window fancyText: 'Publish This Project' ofSize: 21 color: textColor1
		};
		addARowCentered: {
			buttons first. 
			(Morph new extent: 30@5) color: Color transparent. 
			buttons second
		};
		addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4};
		addARowCentered: {
			window fancyText: 'Please select a folder' ofSize: 21 color: Color blue
		};
		addARow: {
			(
				window inAColumn: {
					(pane2 _ window inARow: {window inAColumn: {treePane}}) 
						useRoundedCorners; layoutInset: 6
				}
			) layoutInset: 10
		}.
	window fullBounds.
	window fillWithRamp: self blueRamp1 oriented: 0.65.
	pane2 fillWithRamp: self blueRamp3 oriented: (0.7 @ 0.35).
	buttons do: [ :each |
		each fillWithRamp: self blueRamp2 oriented: (0.75 @ 0).
	].
	window setProperty: #morphicLayerNumber toValue: 11.
	aFileList postOpen.
	^ window ! !

!FilePlugin methodsFor: 'file primitives' stamp: 'ar 2/5/2001 18:09'!
primitiveFileDelete

	| namePointer nameIndex nameSize |
	self var: 'nameIndex' type: 'char *'.
	self export: true.
	namePointer _ interpreterProxy stackValue: 0.
	(interpreterProxy isBytes: namePointer) 
		ifFalse:[^interpreterProxy primitiveFail].
	nameIndex _ interpreterProxy firstIndexableField: namePointer.
	nameSize _ interpreterProxy byteSizeOf: namePointer.
	(self ioCanDeleteFile: nameIndex OfSize: nameSize)
		ifFalse:[^interpreterProxy primitiveFail].
	self sqFileDeleteName: (self cCoerce: nameIndex to: 'int') Size: nameSize.
	interpreterProxy failed 
		ifFalse:[interpreterProxy pop: 1. "pop name, leave rcvr on stack" ].
! !

!FilePlugin methodsFor: 'file primitives' stamp: 'ar 2/6/2001 17:53'!
primitiveFileFlush
	| file |
	self var: 'file' declareC: 'SQFile *file'.
	self export: true.
	file _ self fileValueOf: (interpreterProxy stackValue: 0).
	interpreterProxy failed ifFalse:[self sqFileFlush: file].
	interpreterProxy failed ifFalse: [interpreterProxy pop: 1].! !

!FilePlugin methodsFor: 'file primitives' stamp: 'ar 2/5/2001 18:09'!
primitiveFileOpen

	| writeFlag namePointer filePointer file nameIndex nameSize |
	self var: 'file' declareC: 'SQFile *file'.
	self var: 'nameIndex' type:'char *'.
	self export: true.
	writeFlag _ interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
	namePointer _ interpreterProxy stackValue: 1.
	(interpreterProxy isBytes: namePointer) 
		ifFalse:[^interpreterProxy primitiveFail].
	filePointer _ interpreterProxy 
					instantiateClass: (interpreterProxy classByteArray)
					indexableSize: self fileRecordSize.
	file _ self fileValueOf: filePointer.
	nameIndex _ interpreterProxy firstIndexableField: namePointer.
	nameSize _ interpreterProxy byteSizeOf: namePointer.
	(self ioCanOpenFile: nameIndex OfSize: nameSize Writable: writeFlag)
		ifFalse:[^interpreterProxy primitiveFail].
	interpreterProxy failed ifFalse:[
		self cCode: 'sqFileOpen(file, (int)nameIndex, nameSize, writeFlag)'.
	].
	interpreterProxy failed ifFalse:[
		interpreterProxy pop: 3.  "rcvr, name, writeFlag"
		interpreterProxy push: filePointer.
	].! !

!FilePlugin methodsFor: 'file primitives' stamp: 'ar 2/5/2001 18:10'!
primitiveFileRename

	| oldNamePointer newNamePointer oldNameIndex oldNameSize newNameIndex newNameSize |
	self var: 'oldNameIndex' type: 'char *'.
	self var: 'newNameIndex' type: 'char *'.
	self export: true.
	newNamePointer _ interpreterProxy stackValue: 0.
	oldNamePointer _ interpreterProxy stackValue: 1.
	((interpreterProxy isBytes: newNamePointer) and:[
		(interpreterProxy isBytes: oldNamePointer)])
			ifFalse:[^interpreterProxy primitiveFail].

	new