multifun.c

clips源代码

     }

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/
   if (EnvArgTypeCheck(theEnv,"replace-member$",1,MULTIFIELD,&resultValue) == FALSE)
     {
      SetEvaluationError(theEnv,TRUE);
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   if (!EnvRtnUnknown(theEnv,2,&replVal))
     {
      SetEvaluationError(theEnv,TRUE);
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }
   if (GetType(replVal) == MULTIFIELD)
     replLen = GetDOLength(replVal);

   /*=====================================================
     For the value (or values from multifield ) specified,
     replace all occurrences of those values with all
     values specified
     ===================================================== */
   delSize = (sizeof(DATA_OBJECT) * (argCnt-2));
   delVals = (DATA_OBJECT_PTR) gm2(theEnv,delSize);
   for (i = 3 ; i <= argCnt ; i++)
     {
      if (!EnvRtnUnknown(theEnv,i,&delVals[i-3]))
        {
         rm(theEnv,(void *) delVals,delSize);
         SetEvaluationError(theEnv,TRUE);
         EnvSetMultifieldErrorValue(theEnv,returnValue);
         return;
        }
     }
   minkp = NULL;
   while (FindDOsInSegment(delVals,argCnt-2,&resultValue,&j,&k,minkp,minkp ? 1 : 0))
     {
      if (ReplaceMultiValueField(theEnv,&tmpVal,&resultValue,j,k,
                                 &replVal,"replace-member$") == FALSE)
        {
         rm(theEnv,(void *) delVals,delSize);
         SetEvaluationError(theEnv,TRUE);
         EnvSetMultifieldErrorValue(theEnv,returnValue);
         return;
        }
      GenCopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal);
      mink[0] = 1L;
      mink[1] = j + replLen - 1L;
      minkp = mink;
     }
   rm(theEnv,(void *) delVals,delSize);
   GenCopyMemory(DATA_OBJECT,1,returnValue,&resultValue);
  }

/****************************************/
/* InsertFunction: H/L access routine   */
/*   for the insert$ function.          */
/****************************************/
globle void InsertFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT value1, value2, value3;
   EXPRESSION *fieldarg;

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/

   if ((EnvArgTypeCheck(theEnv,"insert$",1,MULTIFIELD,&value1) == FALSE) ||
       (EnvArgTypeCheck(theEnv,"insert$",2,INTEGER,&value2) == FALSE))
     {
      SetEvaluationError(theEnv,TRUE);
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   /*=============================*/
   /* Create the insertion value. */
   /*=============================*/

   fieldarg = GetFirstArgument()->nextArg->nextArg;
   if (fieldarg->nextArg != NULL)
     StoreInMultifield(theEnv,&value3,fieldarg,TRUE);
   else
     EvaluateExpression(theEnv,fieldarg,&value3);

   /*===========================================*/
   /* Insert the value in the multifield value. */
   /*===========================================*/

   if (InsertMultiValueField(theEnv,returnValue,&value1,(long) DOToLong(value2), /* TBD */
                             &value3,"insert$") == FALSE)
     {
      SetEvaluationError(theEnv,TRUE);
      EnvSetMultifieldErrorValue(theEnv,returnValue);
     }
  }

/*****************************************/
/* ExplodeFunction: H/L access routine   */
/*   for the explode$ function.          */
/*****************************************/
globle void ExplodeFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT value;
   struct multifield *theMultifield;
   unsigned long end;

   /*=====================================*/
   /* Explode$ expects a single argument. */
   /*=====================================*/

   if (EnvArgCountCheck(theEnv,"explode$",EXACTLY,1) == -1)
     {
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   /*==================================*/
   /* The argument should be a string. */
   /*==================================*/

   if (EnvArgTypeCheck(theEnv,"explode$",1,STRING,&value) == FALSE)
     {
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   /*=====================================*/
   /* Convert the string to a multifield. */
   /*=====================================*/

   theMultifield = StringToMultifield(theEnv,DOToString(value));
   if (theMultifield == NULL)
     {
      theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L);
      end = 0;
     }
   else
     { end = GetMFLength(theMultifield); }

   /*========================*/
   /* Return the multifield. */
   /*========================*/

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,end);
   SetpValue(returnValue,(void *) theMultifield);
   return;
  }

/*****************************************/
/* ImplodeFunction: H/L access routine   */
/*   for the implode$ function.          */
/*****************************************/
globle void *ImplodeFunction(
  void *theEnv)
  {
   DATA_OBJECT value;

   /*=====================================*/
   /* Implode$ expects a single argument. */
   /*=====================================*/

   if (EnvArgCountCheck(theEnv,"implode$",EXACTLY,1) == -1)
     { return(EnvAddSymbol(theEnv,"")); }

   /*======================================*/
   /* The argument should be a multifield. */
   /*======================================*/

   if (EnvArgTypeCheck(theEnv,"implode$",1,MULTIFIELD,&value) == FALSE)
     { return(EnvAddSymbol(theEnv,"")); }

   /*====================*/
   /* Return the string. */
   /*====================*/

   return(ImplodeMultifield(theEnv,&value));
  }

/****************************************/
/* SubseqFunction: H/L access routine   */
/*   for the subseq$ function.          */
/****************************************/
globle void SubseqFunction(
  void *theEnv,
  DATA_OBJECT_PTR sub_value)
  {
   DATA_OBJECT value;
   struct multifield *theList;
   long long offset, start, end, length; /* 6.04 Bug Fix */

   /*===================================*/
   /* Get the segment to be subdivided. */
   /*===================================*/

   if (EnvArgTypeCheck(theEnv,"subseq$",1,MULTIFIELD,&value) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   theList = (struct multifield *) DOToPointer(value);
   offset = GetDOBegin(value);
   length = GetDOLength(value);

   /*=============================================*/
   /* Get range arguments. If they are not within */
   /* appropriate ranges, return a null segment.  */
   /*=============================================*/

   if (EnvArgTypeCheck(theEnv,"subseq$",2,INTEGER,&value) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   start = DOToLong(value);

   if (EnvArgTypeCheck(theEnv,"subseq$",3,INTEGER,&value) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   end = DOToLong(value);

   if ((end < 1) || (end < start))
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }

   /*===================================================*/
   /* Adjust lengths  to conform to segment boundaries. */
   /*===================================================*/

   if (start > length)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   if (end > length) end = length;
   if (start < 1) start = 1;

   /*=========================*/
   /* Return the new segment. */
   /*=========================*/

   SetpType(sub_value,MULTIFIELD);
   SetpValue(sub_value,theList);
   SetpDOEnd(sub_value,offset + end - 1);
   SetpDOBegin(sub_value,offset + start - 1);
  }

/******************************************/
/* MVSubseqFunction: H/L access routine   */
/*   for the mv-subseq function.          */
/******************************************/
globle void MVSubseqFunction(
  void *theEnv,
  DATA_OBJECT_PTR sub_value)
  {
   DATA_OBJECT value;
   struct multifield *theList;
   long long offset, start, end, length; /* 6.04 Bug Fix */

   /*=============================================*/
   /* Get range arguments. If they are not within */
   /* appropriate ranges, return a null segment.  */
   /*=============================================*/

   if (EnvArgTypeCheck(theEnv,"mv-subseq",1,INTEGER,&value) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   start = DOToLong(value);

   if (EnvArgTypeCheck(theEnv,"mv-subseq",2,INTEGER,&value) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   end = DOToLong(value);

   if ((end < 1) || (end < start))
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }

   /*===================================*/
   /* Get the segment to be subdivided. */
   /*===================================*/

   if (EnvArgTypeCheck(theEnv,"mv-subseq",3,MULTIFIELD,&value) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   theList = (struct multifield *) DOToPointer(value);
   offset = GetDOBegin(value);

   /*===================================================*/
   /* Adjust lengths  to conform to segment boundaries. */
   /*===================================================*/

   length = GetDOLength(value);
   if (start > length)
     {
      EnvSetMultifieldErrorValue(theEnv,sub_value);
      return;
     }
   if (end > length) end = length;
   if (start < 1) start = 1;

   /*=========================*/
   /* Return the new segment. */
   /*=========================*/

   SetpType(sub_value,MULTIFIELD);
   SetpValue(sub_value,theList);
   SetpDOEnd(sub_value,offset + end - 1);
   SetpDOBegin(sub_value,offset + start - 1);
  }

/***************************************/
/* FirstFunction: H/L access routine   */
/*   for the first$ function.          */
/***************************************/
globle void FirstFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT theValue;
   struct multifield *theList;

   /*===================================*/
   /* Get the segment to be subdivided. */
   /*===================================*/

   if (EnvArgTypeCheck(theEnv,"first$",1,MULTIFIELD,&theValue) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   theList = (struct multifield *) DOToPointer(theValue);

   /*=========================*/
   /* Return the new segment. */
   /*=========================*/

   SetpType(returnValue,MULTIFIELD);
   SetpValue(returnValue,theList);
   if (GetDOEnd(theValue) >= GetDOBegin(theValue))
     { SetpDOEnd(returnValue,GetDOBegin(theValue)); }
   else
     { SetpDOEnd(returnValue,GetDOEnd(theValue)); }
   SetpDOBegin(returnValue,GetDOBegin(theValue));
  }

/**************************************/
/* RestFunction: H/L access routine   */
/*   for the rest$ function.          */
/**************************************/
globle void RestFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT theValue;
   struct multifield *theList;

   /*===================================*/
   /* Get the segment to be subdivided. */
   /*===================================*/

   if (EnvArgTypeCheck(theEnv,"rest$",1,MULTIFIELD,&theValue) == FALSE)
     {
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;