int_procs.c

LastWave

    
    /* Deleting former version of the function if not anonymous */
    sc = GetProc(name);  
    if (sc != NULL) {
      if (sc->flagSP) {
        Printf("  ... redefining script command '%s'\n",sc->name);
        RemoveSProc(sc);
        Free(sc->name);
        sprintf(str4,"<%p>",(void *) sc);
        sc->name = CopyStr(str4);
        DeleteProc(sc);
      }
      else {
        Printf("  ... overloading C-Proc '%s'\n",sc->name);
        sc->flagStillExist = NO;
      }
    }
    Free(c->name);
    c->name = CopyStr(name);
  	AddElemHashTable(procHashTable,(AHASHELEM) c);
  	
  	SetResultValue(c);

  }
  
  else Errorf("Unknown action '%s'",action);
}
	

/***********************************************************************************
 *
 *  Managing the Commands
 *
 ***********************************************************************************/


/*
 * 'help' field
 */

static char *helpDoc = "{} {Gets the help of a proc as a listv}";

static void * GetHelpProcV(VALUE val, void **arg)
{
  LISTV lv,lv1;
  LWPROC c = (LWPROC) val;
  char **list,**list1;
  
  /* Documentation */
  if (val == NULL) return(helpDoc);

  lv = TNewListv();

  if (c->description != NULL) {
    for(list= c->description;*list != NULL;list++) {
	  if (ParseWordList_(*list,NULL,&list1) == NO) return(NULL);
	  lv1 = TNewListv();
	  for(;*list1 != NULL;list1++) {
	    AppendStr2Listv(lv1,*list1);
	  }
	  AppendValue2Listv(lv,(VALUE) lv1);
	} 
  }
  
  ARG_G_SetResValue(arg,lv);
  return(listvType);
}

static char *shelpDoc = "{[= <helpString>]} {Sets/Gets the help of a proc as a string}";

static void * GetSHelpProcV(VALUE val, void **arg)
{
  char *str;
  LWPROC c = (LWPROC) val;
  
  /* Documentation */
  if (val == NULL) return(shelpDoc);

  if (c->description) str = List2Str(c->description," ");
  else str = CopyStr("");
  TempStr(str);
  
  return(GetStrField(str,arg));
}

static void * SetSHelpProcV(VALUE val, void **arg)
{
  LWPROC c = (LWPROC) val;
  char **list;
  char *str;
  
  /* doc */
  if (val == NULL) return(shelpDoc);

  if (c->description) str = List2Str(c->description,"");
  else str = CopyStr("");
  
  if (SetStrField(&str,arg) == NULL) return(NULL);
  TempStr(str);
    
  if (ParseWordList_(str,NULL,&list)==NO) return(NULL);
  
  if (c->description) DeleteList(c->description);
  
  c->description = CopyList(list);

  return(strType);
}

/*
 * 'file' field
 */

static char *fileDoc = "{} {Gets the filename of a proc}";

static void * GetFileProcV(VALUE val, void **arg)
{
  LWPROC c;
  
  /* Documentation */
  if (val == NULL) return(fileDoc);
 
  c = (LWPROC) val;
  if (c->flagSP == NO) return(GetStrField("",arg));
  return(GetStrField(c->p.sp->filename,arg));
}

/*
 * 'package' field
 */

static char *packDoc = "{} {Gets the package name of a proc}";

static void * GetPackageProcV(VALUE val, void **arg)
{
  LWPROC c;
  
  /* Documentation */
  if (val == NULL) return(packDoc);
 
  c = (LWPROC) val;
  return(GetStrField(c->package,arg));
}

/*
 * 'script' field
 */

static char *scriptDoc = "{} {Gets the script of a proc}";

static void * GetScriptProcV(VALUE val, void **arg)
{
  LWPROC c;
  
  /* Documentation */
  if (val == NULL) return(scriptDoc);
 
  c = (LWPROC) val;
  if (c->flagSP == NO) {
    ARG_G_SetResValue(arg,nullValue);
    return(nullType);
  }
  ARG_G_SetResValue(arg,c->p.sp->script);
  return(scriptType);
}

/*
 * 'name' field
 */

static char *nameDoc = "{[= <name>]} {Gets/Sets the name of a proc}";

static void * GetNameProcV(VALUE val, void **arg)
{
  LWPROC c;
  
  /* Documentation */
  if (val == NULL) return(nameDoc);
 
  c = (LWPROC) val;
  return(GetStrField(c->name,arg));
}


/* The type of a command */
char *procType = "&proc";


/*
 * The field list
 */
struct field fieldsProc[] = {
  "help", GetHelpProcV, NULL, NULL, NULL,
  "shelp", GetSHelpProcV, SetSHelpProcV, NULL, NULL,
  "file", GetFileProcV, NULL, NULL, NULL,
  "package", GetPackageProcV, NULL, NULL, NULL,
  "script", GetScriptProcV, NULL, NULL, NULL,
  "name", GetNameProcV, NULL, NULL, NULL,
  NULL, NULL, NULL, NULL, NULL
};



static char *ToStrProc(LWPROC val,char flagShort)
{
  static char str[100];
  
  sprintf(str,"%%%s",val->name);
  return(str);
}


static void PrintInfoProc(VALUE val)
{
  LWPROC c = (LWPROC) val;
  
     if (c->flagSP) Printf("   Script procedure '%s'\n",c->name);
      else Printf("   C-procedure '%s'\n",c->name);
      if (!(c->flagSP)) Printf("   procTable =  %s\n",c->procTable->name);
      Printf("   package =  %s\n",c->package);
}

/*
 * The type structure for LWPROC
 */

TypeStruct tsProc = {

  "{{{&proc} {Corresponds to procedures. The object corresponding to a defined procedure anmed 'name' can be obtained using the \
syntax %name. One can build anonymous procedure usinng the syntax %{arg1 ... argN}`my script`}}}",              /* Documentation */

  &procType,       /* The basic (unique) type name */
  NULL,     /* The GetType function */                       
  
  DeleteProc,     /* The Delete function */
  NewProc,     /* The new function */

  NULL,       /* The copy function */
  NULL,       /* The clear function */
  
  ToStrProc,       /* String conversion */
  NULL,  /* The Print function : print the object when print is called */
  PrintInfoProc,   /* The PrintInfo function : called by 'info' */

  NULL,              /* The NumExtract function : used to deal with syntax like 10a */
   
  fieldsProc,      /* The list of fields */
};



/* 
 * Clean the fields of a Proc except the 'name' field 
 */
 
void CleanProc(LWPROC c)
{
  int i;
  
  if (c->description != NULL) DeleteList(c->description);
  c->flagTrace = NO;
  if (c->package) Free(c->package);
  c->package = NULL;
  c->flagStillExist = YES;
  
  /* Case of a cc (Do not delete the ccommand strcuture !) */
  if (c->flagSP == NO) c->p.cp = NULL;

  /* Case of a sc */
  else {
    if (c->p.sp->filename != NULL) Free(c->p.sp->filename);
    if (c->p.sp->script != NULL) DeleteScript(c->p.sp->script);
    if (c->p.sp->varList != NULL) {
      for (i=0;c->p.sp->varList[i] != NULL;i++) {
        Free(c->p.sp->varList[i]);  
        if (c->p.sp->varDefList[i] != NULL) Free(c->p.sp->varDefList[i]);  
      }
      Free(c->p.sp->varList);
      Free(c->p.sp->varDefList);
      Free(c->p.sp->varTypeList);    
    }
  
    c->p.sp->varList = c->p.sp->varTypeList = c->p.sp->varDefList = NULL;

    #ifdef DEBUGALLOC
    DebugType = "SProc";
    #endif
    Free(c->p.sp);
    c->p.sp = NULL;
  }
}

/* Delete a command */
void DeleteProc(LWPROC c)
{
  LWPROC c1;
  char flagSP = c->flagSP;

  /* remove a reference */
  c->nRef--;
  if (c->nRef>0) return;

  if (flagSP == YES && c->flagStillExist) {  
    c1 = (LWPROC) GetElemHashTable(procHashTable,c->name);
    if (c1 != NULL) RemoveSProc(c);
  }

  /* Clean it */
  CleanProc(c);
  
  /* clean it a little more (in a case of a sc) */
  if (flagSP == YES) {
    if (c->name != NULL) Free(c->name);
  }

  #ifdef DEBUGALLOC
  DebugType = "Proc";
  #endif

  Free(c);
}




/* Allocation of an Proc */
LWPROC NewProc(void)
{
  LWPROC c;
  
#ifdef DEBUGALLOC
DebugType = "Proc";
#endif


  c = (LWPROC) Malloc(sizeof(LWProc));
  InitValue(c,&tsProc);

  c->name = NULL;
  c->flagStillExist = YES;
  c->flagTrace = NO;
  c->package = NULL;
  c->description = NULL;
  c->package = NULL;
  c->flagSP = NO;
  c->p.sp = NULL;
  c->procTable = NULL;

  return(c);
}

  

/***********************************************************************************
 *
 *  Sourcing a file
 *
 ***********************************************************************************/

/*
 * The default source directories
 */
#define MaxNumSourceDirectories 1000
static char *sourceDirectories[MaxNumSourceDirectories];
static int  nSourceDirectories = 0;
 
void InitSourceDirs(char *dir)
{
  SetPackageDir(dir);
  AddSourceDir(dir);
}

/*
 * Add a source directories
 */

void AddSourceDir(char *dir)
{
  int i;
  
  for (i=0;i<nSourceDirectories;i++) {
    if (!strcmp(dir, sourceDirectories[i])) return;
  }
  
  if (nSourceDirectories == MaxNumSourceDirectories) 
    Errorf("AddSourceDir() : Sorry too many directories already loaded");
  
  sourceDirectories[nSourceDirectories] = CopyStr(dir);
  nSourceDirectories++;
}

/*
 * Set the source directories
 */
void C_SetSourceDirs(char **argv)
{
  LISTV lv;
  int i;
  
  argv = ParseArgv(argv,tLISTV_,NULL,&lv,0);
    
  /* If no arguments then we just return the directories */ 
  if (lv == NULL) {
    lv = TNewListv();
    for (i=0;i<nSourceDirectories;i++) AppendStr2Listv(lv,sourceDirectories[i]);
    SetResultValue(lv);  
    return;
  }
  
  /*
   * Otherwise we set the source directories 
   */
      
  /* We first delete former directories if any */
  while (nSourceDirectories != 0) {
    Free(sourceDirectories[nSourceDirectories-1]);
    nSourceDirectories--;
  }
    
  for (i=0;i<lv->length;i++) AddSourceDir(GetListvNthStr(lv,i));
}

void C_ChooseStartupScriptDir(char **argv)
{
  char dir[1000];
  char * ans = XXChooseFileDialog("Please select a script directory in which there is a startup file",1); 
  FILE *f;
  sprintf(dir,"%s/%s",_LWUserDataDir_,"scriptDir");
  f = FOpen(dir,"w");
  strcpy(_LWScriptDir_,ans);
  fprintf(f,"%s",_LWScriptDir_);
  FClose(f);
}

/*
 * Let's source a file 
 */
 
#define MaxSourceLength 30000

char Source(char **filenameList)
{
  char theFilename[400],*oldFile,*str;
  char theSource[MaxSourceLength+1];
  FILE *stream;
  int i,n;
  char flagPackageFile;  
  SCRIPT script;
  char flagFirst,*filename;
  
  flagFirst = YES;
  while(*filenameList) {

    filename = *filenameList;
    
    /* Get the associated packageName if any */
    flagPackageFile = NO;
    if (toplevelCur->packageName == NULL) {
      str = filename;
      while(*str == '.') str++;
      while(*str && *str != '.') str++;
      if (*str == '.') {
        if (!strcmp(str,".pkg")) {
          *str = '\0';
          toplevelCur->packageName = CopyStr(filename);
          flagPackageFile = YES;
          *str = '.';
        }
      }
    }  
       
    for (i=0;i<nSourceDirectories;i++) {
      theFilename[0] = '\0';
      if (strcmp(".",sourceDirectories[i])) {
        strcat(theFilename,sourceDirectories[i]);
        strcat(theFilename,"/");
      }
      strcat(theFilename,filename);
      stream = FOpen(theFilename,"r");
      if (stream!=NULL) break;
    }
  
    if (stream == NULL) {
      SetErrorf("I could not find the '%s' source file",filename);
      if (flagPackageFile) {
        Free(toplevelCur->packageName);
        toplevelCur->packageName = NULL;
      }
      return(NO);
    }
  
    /* So now we have to read the source file */  
    if (flagFirst) Printf("[sourcing %s",filename);
    else Printf(" %s",filename);
    if (filenameList[1] == NULL) Printf("]\n");
    
    n = fread(theSource,sizeof(char),MaxSourceLength,stream);
    theSource[n] = '\0';
  
    if (!feof(stream)) {
      Errorf("C_Source() : Sorry, file to source '%s' is too big (should be less than %d characters)",theFilename,MaxSourceLength);
    }
  
    oldFile = toplevelCur->sourceFilename;
  
    toplevelCur->sourceFilename = theFilename;

    str = theSource;
    ParseStrScript(&str,&script);
    EvalScript(script,NO);
    
    SetResultStr(theFilename);  

    toplevelCur->sourceFilename = oldFile;
    
    if (flagPackageFile) {
      Free(toplevelCur->packageName);
      toplevelCur->packageName = NULL;
    }

    FClose(stream);
    
    filenameList++;
    flagFirst = NO;
  }
 
  return(YES);
}


void C_Source(char **argv)
{
  if (Source(argv) == NO) Errorf1("");
}
 
/*
 *
 *
 */
 
void InitProcs(void)
{
  InitCProcs();
  InitSProcs();
}