/*********************************************************************
NAME : SlotExistPCommand
DESCRIPTION : Determines if a slot is present in a class
INPUTS : None
RETURNS : TRUE if the slot exists, FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-existp <class> <slot> [inherit])
*********************************************************************/
globle int SlotExistPCommand(
void *theEnv)
{
DEFCLASS *cls;
SLOT_DESC *sd;
int inheritFlag = FALSE;
DATA_OBJECT dobj;
sd = CheckSlotExists(theEnv,"slot-existp",&cls,FALSE,TRUE);
if (sd == NULL)
return(FALSE);
if (EnvRtnArgCount(theEnv) == 3)
{
if (EnvArgTypeCheck(theEnv,"slot-existp",3,SYMBOL,&dobj) == FALSE)
return(FALSE);
if (strcmp(DOToString(dobj),"inherit") != 0)
{
ExpectedTypeError1(theEnv,"slot-existp",3,"keyword \"inherit\"");
SetEvaluationError(theEnv,TRUE);
return(FALSE);
}
inheritFlag = TRUE;
}
return((sd->cls == cls) ? TRUE : inheritFlag);
}
/**********************************************************************
NAME : SlotDefaultValueCommand
DESCRIPTION : Determines the default avlue for the specified slot
of the specified class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-default-value <class> <slot>)
**********************************************************************/
globle void SlotDefaultValueCommand(
void *theEnv,
DATA_OBJECT_PTR theValue)
{
DEFCLASS *theDefclass;
SLOT_DESC *sd;
SetpType(theValue,SYMBOL);
SetpValue(theValue,EnvFalseSymbol(theEnv));
sd = CheckSlotExists(theEnv,"slot-default-value",&theDefclass,TRUE,TRUE);
if (sd == NULL)
return;
if (sd->noDefault)
{
SetpType(theValue,SYMBOL);
SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));
return;
}
if (sd->dynamicDefault)
EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,
(EXPRESSION *) sd->defaultValue,
theValue,TRUE);
else
GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
}
/**********************************************************************
NAME : SlotDefaultValueCommand
DESCRIPTION : Determines the default avlue for the specified slot
of the specified class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-default-value <class> <slot>)
**********************************************************************/
void SlotDefaultValueCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *theDefclass;
SlotDescriptor *sd;
returnValue->lexemeValue = FalseSymbol(theEnv);
sd = CheckSlotExists(context,"slot-default-value",&theDefclass,true,true);
if (sd == NULL)
return;
if (sd->noDefault)
{
returnValue->lexemeValue = CreateSymbol(theEnv,"?NONE");
return;
}
if (sd->dynamicDefault)
EvaluateAndStoreInDataObject(theEnv,sd->multiple,
(Expression *) sd->defaultValue,
returnValue,true);
else
GenCopyMemory(UDFValue,1,returnValue,sd->defaultValue);
}
/*********************************************************************
NAME : SlotExistPCommand
DESCRIPTION : Determines if a slot is present in a class
INPUTS : None
RETURNS : True if the slot exists, false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-existp <class> <slot> [inherit])
*********************************************************************/
void SlotExistPCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *cls;
SlotDescriptor *sd;
bool inheritFlag = false;
UDFValue theArg;
sd = CheckSlotExists(context,"slot-existp",&cls,false,true);
if (sd == NULL)
{
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
if (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,SYMBOL_BIT,&theArg))
{ return; }
if (strcmp(theArg.lexemeValue->contents,"inherit") != 0)
{
UDFInvalidArgumentMessage(context,"keyword \"inherit\"");
SetEvaluationError(theEnv,true);
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
inheritFlag = true;
}
returnValue->lexemeValue = CreateBoolean(theEnv,((sd->cls == cls) ? true : inheritFlag));
}
/**********************************************************************
NAME : SlotDirectAccessPCommand
DESCRIPTION : Determines if an existing slot can be directly
referenced by the class - i.e., if the slot is
private, is the slot defined in the class
INPUTS : None
RETURNS : TRUE if the slot is private,
FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-direct-accessp <class> <slot>)
**********************************************************************/
globle intBool SlotDirectAccessPCommand(
void *theEnv)
{
DEFCLASS *theDefclass;
SLOT_DESC *sd;
sd = CheckSlotExists(theEnv,"slot-direct-accessp",&theDefclass,TRUE,TRUE);
if (sd == NULL)
return(FALSE);
return((sd->publicVisibility || (sd->cls == theDefclass)) ? TRUE : FALSE);
}
/**********************************************************************
NAME : SlotPublicPCommand
DESCRIPTION : Determines if an existing slot is publicly visible
for direct reference by subclasses
INPUTS : None
RETURNS : TRUE if the slot is public, FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-publicp <class> <slot>)
**********************************************************************/
globle intBool SlotPublicPCommand(
void *theEnv)
{
DEFCLASS *theDefclass;
SLOT_DESC *sd;
sd = CheckSlotExists(theEnv,"slot-publicp",&theDefclass,TRUE,FALSE);
if (sd == NULL)
return(FALSE);
return(sd->publicVisibility ? TRUE : FALSE);
}
/**********************************************************************
NAME : SlotInitablePCommand
DESCRIPTION : Determines if an existing slot can be initialized
via an init message-handler or slot-override
INPUTS : None
RETURNS : TRUE if the slot is writable, FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-initablep <class> <slot>)
**********************************************************************/
globle intBool SlotInitablePCommand(
void *theEnv)
{
DEFCLASS *theDefclass;
SLOT_DESC *sd;
sd = CheckSlotExists(theEnv,"slot-initablep",&theDefclass,TRUE,TRUE);
if (sd == NULL)
return(FALSE);
return((sd->noWrite && (sd->initializeOnly == 0)) ? FALSE : TRUE);
}
/**********************************************************************
NAME : SlotDirectAccessPCommand
DESCRIPTION : Determines if an existing slot can be directly
referenced by the class - i.e., if the slot is
private, is the slot defined in the class
INPUTS : None
RETURNS : True if the slot is private,
false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-direct-accessp <class> <slot>)
**********************************************************************/
void SlotDirectAccessPCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *theDefclass;
SlotDescriptor *sd;
sd = CheckSlotExists(context,"slot-direct-accessp",&theDefclass,true,true);
if (sd == NULL)
{ returnValue->lexemeValue = FalseSymbol(theEnv); }
else
{ returnValue->lexemeValue = CreateBoolean(theEnv,((sd->publicVisibility || (sd->cls == theDefclass)) ? true : false)); }
}
/**********************************************************************
NAME : SlotInitablePCommand
DESCRIPTION : Determines if an existing slot can be initialized
via an init message-handler or slot-override
INPUTS : None
RETURNS : True if the slot is writable, false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-initablep <class> <slot>)
**********************************************************************/
void SlotInitablePCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *theDefclass;
SlotDescriptor *sd;
sd = CheckSlotExists(context,"slot-initablep",&theDefclass,true,true);
if (sd == NULL)
{ returnValue->lexemeValue = FalseSymbol(theEnv); }
else
{ returnValue->lexemeValue = CreateBoolean(theEnv,(sd->noWrite && (sd->initializeOnly == 0)) ? false : true); }
}