This is SqApplication.m in view mode; [Download] [Up]
/******************************************************************************
FILE
SqApplication.m
DESCRIPTION
NeXTstep user Interface for Squeak.
AUTHOR
<PJB> Pascal J. Bourguignon
MODIFICATIONS
1998/06/12 <PJB> Creation.
LEGAL
Copyright Pascal J. Bourguignon 1998 - 1998
This program is free software; you can redistribute it and/or
modify it under the terms of the version 2 of the GNU General Public
License as published by the Free Software Foundation.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
hereafter for more details.
******************************************************************************/
#import "SqApplication.h"
#import <unistd.h>
#import <defaults/defaults.h>
#import "sq.h"
#import "SqButton.h"
#import "SqCmdKeyWindow.h"
#import "SqView.h"
#import "SqViewMegaPixel.h"
#import "Version.h"
//#define debug(a) a
#define debug(a)
#undef DEBUG_WINDOWDEPTH
static inline int minimum(int a,int b)
{
return((a)<(b)?(a):(b));
}//minimum;
extern BOOL _NXGetBooleanAppDefault(const char* defaultName);
extern int _NXGetIntegerAppDefault(const char* defaultName);
extern void handle_signal(int sig);
extern void initListener(id anObj);
extern void workSpaceFeedBack(id anImage);
typedef struct {
@defs(Window)
} WindowStruct;
typedef struct {
@defs(Application)
} ApplicationStruct;
static id whoIsResponsible(Application* anApp,SEL message)
{
ApplicationStruct* s=(ApplicationStruct*)anApp;
if((s->delegate!=0)&&([s->delegate respondsTo:message])){
return(s->delegate);
}
if([anApp respondsTo:message]){
return(anApp);
}else{
return(0);
}
}//whoIsResponsible;
//---------------------------------------------------------------------------//
@interface Application(Private)
-(void)_initServicesMenu;
-(id)appPowerOffIn:(int)msec andSave:(BOOL)doSave;
@end // Application.
//---------------------------------------------------------------------------//
@interface Menu(Private)
+(void)_restoreTornOffMenus;
@end // Menu.
//---------------------------------------------------------------------------//
@interface NXHelpPanel(Private)
+(void)_setCtrlAltForHelpDesired;
@end // NXHelpPanel.
//---------------------------------------------------------------------------//
@implementation SqApplication
// Object methods:
-(id)init
{
self=[super init];
if(self!=0){
startSqueak=NO;
terminateFromSqueak=NO;
squeakVersionString[0]='\0';
}
return(self);
}//init;
// NXNibNotification methods:
-awakeFromNib
{
[versionTextField setStringValue:[self versionString]];
return(self);
}//awakeFromNib;
// Application methods:
-sendEvent:(NXEvent*)event
{
if(startSqueak){
startSqueak=NO;
/* FIRST EVENT */
debug(fprintf(stderr,"SqApplication processing "\
"first event started.\n");)
[super sendEvent:event];
debug(fprintf(stderr,"SqApplication processing "\
"first event done.\n");)
//NXResetErrorData();
NX_DURING
interpret(); /* HAS ITS OWN EVENT LOOP. */
NX_HANDLER
fprintf(stderr,"An exception is catched in [%s %s]: "
"code=%d data1=0x%x data2=0x%x\n",
"SqApplication",sel_getName(_cmd),NXLocalHandler.code,
(unsigned int)NXLocalHandler.data1,
(unsigned int)NXLocalHandler.data2);
NX_ENDHANDLER
/* LAST EVENT */
NXResetUserAbort();
if(_freelist!=0){
if([_freelist count]!=0){
[_freelist freeObjects];
}
}
if(keyWindow!=0){
if(!((WindowStruct*)keyWindow)
->wFlags2._haveFreeCursorRects){
[keyWindow resetCursorRects];
}
}
if(0!=NXGetOrPeekEvent(DPS_ALLCONTEXTS,¤tEvent,
NX_ALLEVENTS,0.0,NX_BASETHRESHOLD,0)){
appFlags._RESERVED&=(~32);
[super sendEvent:event];
}else{
appFlags._RESERVED&=(~32);
}
debug(fprintf(stderr,"SqApplication processing "\
"first event completed.\n");)
running=NO;
return(self);
}else{
return([super sendEvent:event]);
}
}//sendEvent:;
// Application delegate methods:
-appWillInit:sender
{
/* check the interpreter's size assumptions for basic data types */
if (sizeof(int) != 4){
NXRunAlertPanel("Fatal error",
"This application has been compiled with a C compiler "
"whose integers are not 32 bits.\n"
"Squeak cannot work when thus compiled.",
"Quit",NULL,NULL);
[self squeakTerminate];
}
if (sizeof(double) != 8){
NXRunAlertPanel("Fatal error",
"This application has been compiled with a C compiler "
"whose double are not 64 bits.\n"
"Squeak cannot work when thus compiled.",
"Quit",NULL,NULL);
[self squeakTerminate];
}
if (sizeof(time_t) != 4){
NXRunAlertPanel("Fatal error",
"This application has been compiled with a C compiler "
"whose time_t's are not 32 bits.\n"
"Squeak cannot work when thus compiled.",
"Quit",NULL,NULL);
[self squeakTerminate];
}
board=0;
boardData=0;
boardLength=0;
boardChangeCount=0;
boardReadTypesCount=0;
boardWriteTypesCount=0;
specialAttribute[0]='\0';
gettimeofday(&startUpTime,0);
sqFileInit();
joystickInit();
preferences=[[SqPreference alloc]init];
stackCacheEntries=[preferences stackCacheEntries];
contextCacheEntries=stackCacheEntries;
/* read the image file and allocate memory for Squeak heap */
{
FILE* imageFile=fopen([preferences imagePath],"r");
while(imageFile==NULL){
NXRunAlertPanel("Bad Squeak image file",
"I cannot find the Squeak image file '%s'.\n\n"
"Please select a new Squeak image file in my panel "
"of preferences.\n",
"Preference Panel",NULL,NULL,[preferences imagePath]);
[preferences runModalDialog];
imageFile=fopen([preferences imagePath],"r");
}
readImageFromFileHeapSize(imageFile,[preferences heapSize]);
fclose(imageFile);
}
return(self);
}//appWillInit:;
-appDidInit:sender
{
NXRect defaultContentRect={
{10,10},{512,342}}; // Original Macintosh Screen Size.
NXEvent event;
event.type=NX_APPDEFINED;
event.location.x=0;
event.location.y=0;
event.time=0;
event.flags=0;
event.window=0;
event.data.compound.reserved=0;
event.data.compound.subtype=0;
event.data.compound.misc.L[0]=0;
event.data.compound.misc.L[1]=0;
event.ctxt=0;
DPSPostEvent(&event,TRUE);
if([SqViewMegaPixel
thereIsTheSlightestChanceOfHavingAMegaPixelDisplay]){
view=[[SqViewMegaPixel alloc]initFrame:0];
}else{
view=[[SqView alloc]initFrame:0];
}
[view setAutosizing:NX_WIDTHSIZABLE|NX_HEIGHTSIZABLE];
[view setClipping:NO];
plainWindow=[[SqCmdKeyWindow alloc]
initContent:&defaultContentRect
style:NX_PLAINSTYLE
backing:NX_BUFFERED
buttonMask:0
defer:NO];
[plainWindow setDelegate:view];
[plainWindow setEventMask:NX_KEYDOWNMASK|NX_KEYUPMASK
|NX_FLAGSCHANGEDMASK|NX_LMOUSEDOWNMASK|NX_LMOUSEUPMASK
|NX_RMOUSEDOWNMASK|NX_RMOUSEUPMASK
|NX_MOUSEENTEREDMASK|NX_MOUSEEXITEDMASK|NX_CURSORUPDATEMASK];
PScurrentwindowlevel([plainWindow windowNum],&originalLevel);
titledWindow=[[SqCmdKeyWindow alloc]
initContent:&defaultContentRect
style:NX_RESIZEBARSTYLE // NX_TITLEDSTYLE
backing:NX_BUFFERED
buttonMask:NX_MINIATURIZEBUTTONMASK
defer:NO];
[titledWindow setFrameAutosaveName:"SqueakScreen"];
[titledWindow setTitle:[preferences imagePath]];
[titledWindow setDelegate:view];
[titledWindow setEventMask:NX_KEYDOWNMASK|NX_KEYUPMASK
|NX_FLAGSCHANGEDMASK|NX_LMOUSEDOWNMASK|NX_LMOUSEUPMASK
|NX_RMOUSEDOWNMASK|NX_RMOUSEUPMASK
|NX_MOUSEENTEREDMASK|NX_MOUSEEXITEDMASK|NX_CURSORUPDATEMASK];
[titledWindow setMinSize:&(defaultContentRect.size)];
{// Let's center the window, if it's in the default position.
NXRect defaultFrame;
NXRect currentFrame;
const NXScreen* screen;
defaultFrame.origin.x=defaultContentRect.origin.x-1;
defaultFrame.origin.y=defaultContentRect.origin.y-9;
defaultFrame.size.width=defaultContentRect.size.width+2;
defaultFrame.size.height=defaultContentRect.size.height+32;
[titledWindow getFrame:¤tFrame andScreen:&screen];
if((currentFrame.origin.x==defaultFrame.origin.x)
&&(currentFrame.origin.y==defaultFrame.origin.y)
&&(currentFrame.size.width==defaultFrame.size.width)
&&(currentFrame.size.height==defaultFrame.size.height)){
[titledWindow
moveTo:(screen->screenBounds.origin.x+
(screen->screenBounds.size.width
-currentFrame.size.width)/2)
:(screen->screenBounds.origin.y+
(screen->screenBounds.size.height
-currentFrame.size.height)/2)];
}
}
[self setSqueakScreen];
[view appDidInit:sender];
[preferences setRedButton: [view redButton]];
[preferences setYellowButton:[view yellowButton]];
[preferences setBlueButton: [view blueButton]];
[[view redButton] takeFromString:[preferences redButtonString]];
[[view yellowButton] takeFromString:[preferences yellowButtonString]];
[[view blueButton] takeFromString:[preferences blueButtonString]];
#ifdef DEBUG_WINDOWDEPTH
{
static NXWindowDepth limit[4]={NX_TwoBitGrayDepth,
NX_EightBitGrayDepth,
NX_TwelveBitRGBDepth,
NX_TwentyFourBitRGBDepth};
const char* limitStr;
int limitIndex;
limitStr=NXGetDefaultValue([NXApp appName],"NXWindowDepth");
sscanf(limitStr,"%d",&limitIndex);
if((limitIndex<0)||(limitIndex>3)){
limitIndex=0;
}
[[view window]setDepthLimit:limit[limitIndex]];
}
#endif
[self removeCommandKeysEquivalentsFromMenus];
startSqueak=YES;
return(self);
}//appDidInit:;
-(void)removeCommandKeysEquivalentsFromTheMenu:(Menu*)menu
{
Matrix* items=[menu itemList];
int c=[items cellCount];
int i=0;
while(i<c){
MenuCell* cell=[items cellAt:i:0];
if([cell hasSubmenu]){
[self removeCommandKeysEquivalentsFromTheMenu:[cell target]];
}
switch([cell keyEquivalent]){
case 'h':
case 'q':
break;
default:
[cell setKeyEquivalent:0];
}
i++;
}
[menu sizeToFit];
}//removeCommandKeysEquivalentsFromTheMenu:;
-(void)removeCommandKeysEquivalentsFromMenus
{
[MenuCell useUserKeyEquivalents:NO];
[self removeCommandKeysEquivalentsFromTheMenu:[self mainMenu]];
}//removeCommandKeysEquivalentsFromMenus;
-appDidUnhide:sender
{
[view redisplayAfterUnhide];
return(self);
}//appDidUnhide:;
-appWillTerminate:sender
{
if(terminateFromSqueak
||(NX_ALERTDEFAULT==NXRunAlertPanel([NXApp appName],
"Warning: Quitting this way you loose any unsaved changes "
"to your image!\n"
"Better quit from within the Smalltalk environment.",
// We cannot insert \n in these button titles, because they're
// not taken into account by NXRunAlertPanel.
"Quit anyway, I know what I'm doing!",
"Oops, cancel that!",NULL))){
return(self);
}else{
[view redisplayAfterUnhide];
return(0);
}
}//appWillTerminate:;
// SqApplication methods:
-(void)squeakTerminate
{
terminateFromSqueak=YES;
[self terminate:self];
}//squeakTerminate;
-(const char*)versionString
{
return(VERSION);
}//versionString;
-(const char*)squeakVersionString
{
if(squeakVersionString[0]=='\0'){
extern int vm_serial;
extern char *vm_date,*vm_version,*cc_version,*ux_version;
extern char *up_version;
sprintf(squeakVersionString,"%s/%d #%d %s %s\n%s %s\n%s\n",
vm_version,CURRENT_VERSION,vm_serial,
vm_date,cc_version,ux_version,
[NXApp versionString],
up_version);
}
return(squeakVersionString);
}//squeakVersionString;
-openPreferences:sender
{
[preferences openDialog];
return(self);
}//openPreferences:;
-(SqPreference*)preferences
{
return(preferences);
}//preferences;
-(void)prepareFullScreen:(BOOL)fullScreen noTitle:(BOOL)noTitle
{
if(fullScreen){
const NXScreen* screen=[titledWindow screen];
[view removeFromSuperview];
[plainWindow placeWindow:&(screen->screenBounds)];
[plainWindow setContentView:view];
//[[plainWindow contentView]addSubview:view];
PSsetwindowlevel(NX_MAINMENULEVEL+1,[plainWindow windowNum]);
[plainWindow makeKeyAndOrderFront:self];
[titledWindow orderOut:self];
}else{
if(noTitle){
const NXScreen* screen;
NXRect frame;
[titledWindow getFrame:&frame andScreen:&screen];
frame.origin.x++; frame.size.width-=2;
frame.origin.y+=9; frame.size.height-=32;
[view removeFromSuperview];
[plainWindow placeWindow:&frame screen:screen];
[plainWindow setContentView:view];
//[[plainWindow contentView]addSubview:view];
[plainWindow makeKeyAndOrderFront:self];
[titledWindow orderOut:self];
}else{
[view removeFromSuperview];
[titledWindow setContentView:view];
//[[titledWindow contentView]addSubview:view];
[titledWindow makeKeyAndOrderFront:self];
[plainWindow orderOut:self];
}
PSsetwindowlevel(originalLevel,[plainWindow windowNum]);
}
[[view window] makeFirstResponder:view];
[[view window] reenableDisplay];
[[view window] displayBorder];
//[[view window] makeKeyAndOrderFront:self];
}//prepareFullScreen:noTitle:;
-(void)setSqueakScreen
{
[self prepareFullScreen:[preferences fullScreen]
noTitle:[preferences noTitle]];
[view updateWholeDisplay];
}//setSqueakScreen;
@end // SqApplication.
//---------------------------------------------------------------------------//
@implementation SqApplication(APIforSqueak)
/* display,mouse,keyboard,time i/o */
-(int)ioBeep
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
NXBeep();
return(0);
}//ioBeep;
-(int)ioExit
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
[self squeakTerminate];
return(0);
}//ioExit;
-(int)ioMicroMSecs
{
// We have this comment in the unix implementation:
// /* already have millisecond resolution */
// return ioMSecs();
// So, may be that means that ioMicroMSecs expects milliseconds too?!
return([self ioMSecs]);
}//ioMicroMSecs;
-(int)ioMSecs
{
struct timeval now;
gettimeofday(&now,0);
now.tv_usec-=startUpTime.tv_usec;
if(now.tv_usec<0){
now.tv_usec+=1000000;
now.tv_sec-=1;
}
now.tv_sec-=startUpTime.tv_sec;
return((now.tv_usec/1000+now.tv_sec* 1000)&0x1fffffff);
}//ioMSecs;
-(int)ioSeconds
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
struct timeval tv;
gettimeofday(&tv,0);
return(convertToSqueakTime(tv.tv_sec
+localtime(&tv.tv_sec)->tm_gmtoff));
}//ioSeconds;
-(int)ioProcessEvents
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
BOOL thereIsAnEvent;
aioPollForIO(0,0); /* quick check for asynchronous socket i/o */
NX_DURING
thereIsAnEvent=YES;
while(thereIsAnEvent){
NXResetUserAbort();
if(_freelist!=0){
if([_freelist count]!=0){
[_freelist freeObjects];
}
}
if(0!=NXGetOrPeekEvent(DPS_ALLCONTEXTS,¤tEvent,
NX_ALLEVENTS,0.0,NX_BASETHRESHOLD,0)){
appFlags._RESERVED&=(~32);
[super sendEvent:¤tEvent];
if(keyWindow!=0){
if(!((WindowStruct*)keyWindow)
->wFlags2._haveFreeCursorRects){
[keyWindow resetCursorRects];
}
}
}else{
appFlags._RESERVED&=(~32);
thereIsAnEvent=NO;
}
//NXResetErrorData();
}
NX_HANDLER
[self makeWindowsPerform:@selector(_resetDisableCounts)
inOrder:NO];
if(3006==NXLocalHandler.code){
id responsable=whoIsResponsible(self,
@selector(app:powerOffIn:andSave:));
if(responsable!=0){
[responsable app:self
powerOffIn:((int*)NXLocalHandler.data1)[0]
andSave:((int*)NXLocalHandler.data1)[1]];
}else{
responsable=whoIsResponsible(self,
@selector(appPowerOffIn:andSave:));
if(responsable!=0){
[responsable
appPowerOffIn:((int*)NXLocalHandler.data1)[0]
andSave:((int*)NXLocalHandler.data1)[1]];
}
}
}else if(3021!=NXLocalHandler.code){
_NXTopLevelErrorHandler(&NXLocalHandler);
}
PSshowcursor();
NX_ENDHANDLER
return(0);
}//ioProcessEvents;
-(int)ioRelinquishProcessorForMicroseconds:(int)microSeconds
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
// double timeout=(double)microSeconds/1000000.0;
[self ioProcessEvents];
return(microSeconds);
}//ioRelinquishProcessorForMicroseconds:;
/* image file and VM path names */
-(int)imageNameSize
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
return(strlen([preferences imagePath]));
}//imageNameSize;
-(int)imageNameGet:(int)sqImageNameIndex Length:(int)length
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
const char* imageName=[preferences imagePath];
char* dest=((char*)sqImageNameIndex);
int destLength=minimum(strlen(imageName),length);
int i;
for(i=0;i<destLength;i++){
dest[i]=imageName[i];
}
return(destLength);
}//imageNameGet:Length:;
-(int)imageNamePut:(int)sqImageNameIndex Length:(int)length
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
const char* name=((const char*)sqImageNameIndex);
int i;
int imageNameLength;
char imageName[MAXPATHLEN+1];
imageNameLength=minimum(MAXPATHLEN,length);
for(i=0;i<imageNameLength;i++){
imageName[i]=name[i];
}
imageName[i]='\0';
[preferences setImagePath:imageName];
[[view window]setTitle:imageName];
return(imageNameLength);
}//imageNamePut:Length:;
-(int)vmPathSize
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
int vmPathLength;
const char* imagePath=[preferences imagePath];
const char* p=strrchr(imagePath,'/');
if(p!=0){
vmPathLength=p-imagePath+1;
}else{
// It's a file in the current directory ('./').
vmPathLength=2;
}
return(vmPathLength);
}//vmPathSize;
-(int)vmPathGet:(int)sqVMPathIndex Length:(int)length
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
char* dest=((char*)sqVMPathIndex);
int destLength=minimum([self vmPathSize],length);
const char* imagePath=[preferences imagePath];
if(strrchr(imagePath,'/')!=0){
int i;
for(i=0;i<destLength;i++){
dest[i]=imagePath[i];
}
}else{
// if there's no '/' in the image path then it's a file
// in the current directory.
dest[0]='.';
dest[1]='/';
}
return(destLength);
}//vmPathGet:Length:;
/* clipboard (cut/copy/paste) */
inline void st2ux(char* string,int length)
{
if(string==0){
return;
}
while(length>0){
length--;
if((*string)=='\r'){
(*string)='\n';
}
string++;
}
}//st2ux;
inline void ux2st(char* string,int length)
{
if(string==0){
return;
}
while(length>0){
length--;
if((*string)=='\n'){
(*string)='\r';
}
string++;
}
}//ux2st;
-(void)getClipboard
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
int currentChangeCount;
NX_DURING
if(board==0){
board=[Pasteboard newName:NXGeneralPboard];
boardReadTypesCount=0;
boardReadTypes[boardReadTypesCount++]=NXAsciiPboardType;
boardReadTypes[boardReadTypesCount++]=NXTabularTextPboardType;
boardReadTypes[boardReadTypesCount++]=NXRTFPboardType;
boardReadTypes[boardReadTypesCount++]=NXPostScriptPboardType;
boardReadTypes[boardReadTypesCount++]=NXFilenamePboardType;
}
currentChangeCount=[board changeCount];
if(boardChangeCount!=currentChangeCount){
const char* type;
if(boardData!=0){
[board deallocatePasteboardData:boardData
length:boardLength];
}
type=[board findAvailableTypeFrom:boardReadTypes
num:boardReadTypesCount];
if(((type!=0)
&&[board readType:type data:&boardData length:&boardLength])){
ux2st(boardData,boardLength);
}else{
boardData=0;
boardLength=0;
}
boardChangeCount=currentChangeCount;
}
NX_HANDLER
fprintf(stderr,"An exception is catched in [%s %s]: "
"code=%d data1=0x%x data2=0x%x\n",
"SqApplication",sel_getName(_cmd),NXLocalHandler.code,
(unsigned int)NXLocalHandler.data1,
(unsigned int)NXLocalHandler.data2);
NX_ENDHANDLER
}//getClipboard;
-(int)clipboardSize
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
[self getClipboard];
return(boardLength);
}//clipboardSize;
-(int)clipboardRead:(int)count
Into:(int)byteArrayIndex At:(int)startIndex
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
char* dest=((char*)byteArrayIndex)+startIndex;
int destLength;
int i;
[self getClipboard];
destLength=minimum(boardLength,count);
for(i=0;i<destLength;i++){
dest[i]=boardData[i];
}
return(destLength);
}//clipboardRead:Into:At:;
-(int)clipboardWrite:(int)count
From:(int)byteArrayIndex At:(int)startIndex
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
const char* data=((const char*)byteArrayIndex)+startIndex;
char* uxData=0;
int i;
NX_DURING
if(board==0){
board=[Pasteboard newName:NXGeneralPboard];
boardWriteTypesCount=0;
boardWriteTypes[boardWriteTypesCount++]=NXAsciiPboardType;
}
boardChangeCount=[board declareTypes:boardWriteTypes
num:boardWriteTypesCount owner:self];
// We don't know if we can modify the byteArray in line so:
uxData=(char*)malloc(sizeof(char)*count);
for(i=0;i<count;i++){
uxData[i]=data[i];
}
st2ux(uxData,count);
[board writeType:NXAsciiPboardType data:uxData length:count];
free(uxData);
NX_HANDLER
fprintf(stderr,"An exception is catched in [%s %s]: "
"code=%d data1=0x%x data2=0x%x\n",
"SqApplication",sel_getName(_cmd),NXLocalHandler.code,
(unsigned int)NXLocalHandler.data1,
(unsigned int)NXLocalHandler.data2);
if(uxData!=0){
free(uxData);
}
NX_ENDHANDLER
return(0);
}//clipboardWrite:From:At:;
/*** Profiling ***/
-(int)clearProfile
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
return(0);
}//clearProfile;
-(int)dumpProfile
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
return(0);
}//dumpProfile;
-(int)startProfiling
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
return(0);
}//startProfiling;
-(int)stopProfiling
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
return(0);
}//stopProfiling;
/*** Access to system attributes and command-line arguments ***/
-(const char*)specialAttribute:(int)id
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
switch(id){
case 1: /* Squeak PID */
sprintf(specialAttribute,"%d",getpid());
break;
default:
specialAttribute[0]='\0';
break;
}
return(specialAttribute);
}//specialAttribute;
-(int)attributeSize:(int)ident
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
if([preferences squeakArgc]<=ident+1){
return(0);
}
if(ident<0){
return(strlen([self specialAttribute:-ident]));
}else{
return(strlen([preferences squeakArgv][ident+1]));
}
}//attributeSize:;
-(int)getAttribute:(int)ident Into:(int)byteArrayIndex Length:(int)length
{
debug(int dummy=fprintf(stderr,"%s\n",(char*)_cmd);)
char* attribute=(char*)byteArrayIndex;
const char* argument;
if([preferences squeakArgc]<=ident+1){
return(0);
}
if(ident<0){
argument=[self specialAttribute:-ident];
}else{
argument=[preferences squeakArgv][ident+1];
}
while(length>0){
length--;
(*attribute)=(*argument);
attribute++;
argument++;
}
return(0);
}//getAttribute:Into:Length:;
@end // SqApplication(APIforSqueak).
//---------------------------------------------------------------------------//
/*** SqApplication.m / Thu Oct 1 05:50:44 GMT+0200 1998 / PJB ***/
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.