Example #1
0
// osdir_list_start -- prepare to list a directory
int osdir_list_start(char *path)
{
   if (strlen(path) >= OSDIR_MAX_PATH - 2) {
      xlcerror("LISTDIR path too big", "return nil", NULL);
      return FALSE;
   }
   strcpy(osdir_path, path);
   strcat(osdir_path, "/*"); // make a pattern to match all files

   if (osdir_list_status != OSDIR_LIST_READY) {
      osdir_list_finish(); // close previously interrupted listing
   }

   hFind = FindFirstFile(osdir_path, &FindFileData); // get the "."
   if (hFind == INVALID_HANDLE_VALUE) {
      return FALSE;
   }
   if (FindNextFile(hFind, &FindFileData) == 0) {
      return FALSE; // get the ".."
   }

   osdir_list_status = OSDIR_LIST_STARTED;

   return TRUE;
}
Example #2
0
VOID stchck(V) {
  int dummy;
  int stackleft = STACKREPORT(dummy);

  if (stackleft < (stackwarn ?  MARGLO : marghi)) {
    stackwarn = TRUE;
    if (stackleft>MARGLO)
      xlcerror("use full stack",
	       "system stack is low, bytes left", cvfixnum(stackleft));
    else {
      xlabort("system stack overflow");
    }
  }
}
Example #3
0
/* xcerror - special form 'cerror' */
LVAL xcerror(void)
{
    LVAL cmsg,emsg,arg;

    /* get the correction message, the error message, and the argument */
    cmsg = xlgastring();
    emsg = xlgastring();
    arg = (moreargs() ? xlgetarg() : s_unbound);
    xllastarg();

    /* signal the error */
    xlcerror((char *) getstring(cmsg), (char *) getstring(emsg),arg);

    /* return nil */
    return (NIL);
}
Example #4
0
/* xlload - load a file of xlisp expressions */
int xlload(char *fname, int vflag, int pflag)
{
    char fullname[STRMAX+1];
    char *ptr;
    LVAL fptr,expr;
    XLCONTEXT cntxt;
    FILE *fp;
    int sts;

    /* protect some pointers */
    xlstkcheck(2);
    xlsave(fptr);
    xlsave(expr);

    /* space for copy + extension? */
    if (strlen(fname) > STRMAX - 4) goto toolong;
    strcpy(fullname,fname);
#ifdef WINDOWS
#ifdef WINGUI
    if (strcmp(fullname, "*") == 0) {
        if (sfn_valid) {
            strcpy(fullname, save_file_name);
        } else {
            strcpy(fullname, "*.*");
        }
    }
    if (strcmp(fullname, "*.*") == 0) {
        char *name = getfilename(NULL, "lsp", "r", "Load file");
        if (name) {
            strcpy(fullname, name);
            strcpy(save_file_name, name);
            sfn_valid = TRUE;
        } else {
            xlpopn(2);
            return FALSE;
        }
    }
#endif
    /* replace "/" with "\" so that (current-path) will work */
    for (ptr = fullname; *ptr; ptr++) {
        if (*ptr == '/') *ptr = '\\';
    }
#endif

    /* default the extension if there is room */
    if (needsextension(fullname)) {
        strcat(fullname,".lsp");
    }

    /* allocate a file node */
    fptr = cvfile(NULL);

    /* open the file */
    if ((fp = osaopen(fullname,"r")) == NULL) {
#ifdef UNIX
        if (fname[0] != '/') {
            char *paths = getenv("XLISPPATH");
            if (!paths || !*paths) {
                char msg[512];
                sprintf(msg, "\n%s\n%s\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLISPPATH in the environment.",
  "If you are using Nyquist, probably you should cd to the",
  "nyquist directory and type:",
  "    setenv XLISPPATH `pwd`/runtime:`pwd`/lib",
  "or set XLISPPATH in your .login or .cshrc file.");
                errputstr(msg);
            }
            /* make sure we got paths, and the list is not empty */
            while (paths && *paths) {
                char *ptr = fullname;
                /* skip over separator */
                while (*paths == ':') paths++;
                /* scan next directory into fullname */
                while (*paths && (*paths != ':')) {
                    if ((ptr - fullname) >= STRMAX) goto toolong;
                    *ptr++ = *paths++;
                }
                /* add "/" if needed */
                if (ptr[-1] != '/') *ptr++ = '/';
                /* append the file name */
                if ((ptr - fullname) + strlen(fname) + 4 > STRMAX) 
                    goto toolong;
                strcpy(ptr, fname);
                /* append the .lsp extension */
                if (needsextension(fullname)) {
                    strcat(fullname, ".lsp");
                }
                if (fp = osaopen(fullname, "r")) goto gotfile;
            }
        }
#endif
#ifdef WINDOWS
        /* is this a relative path? */
        if (fname[0] != '\\' && (strlen(fname) < 2 || fname[1] != ':')) {
#define paths_max 1024
            char paths[paths_max];
            char *p = paths;
            get_xlisp_path(paths, paths_max);
            /* make sure we got paths, and the list is not empty */
            if (!*p) {
                sprintf(paths, "\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLISPPATH in the Registry.",
  "You should follow the installation instructions. Enter an",
  "empty string if you really want no search path.");
                errputstr(paths);
                *p = 0;
            }
            while (*p) {
                    char *ptr = fullname;
                /* skiip over separator */
                while (*p == ',') p++;
                /* scan next directory into fullname */
                while (*p && (*p != ',')) {
                    if ((ptr - fullname) >= STRMAX) goto toolong;
                    *ptr++ = *p++;
                }
                /* add "\" if needed */
                if (ptr[-1] != '\\') *ptr++ = '\\';
                /* append the file name */
                if ((ptr - fullname) + strlen(fname) + 4 > STRMAX)
                    goto toolong;
                strcpy(ptr, fname);
                /* append the .lsp extension */
                if (needsextension(fullname)) {
                    strcat(fullname, ".lsp");
                }
                /* printf("Trying to open \"%s\"\n", fullname);	*/
                if (fp = osaopen(fullname, "r")) goto gotfile;
            }
        }
#endif
#ifdef MACINTOSH
        /* is this a relative path? I don't know how to do this
         * correctly, so we'll assume it's relative if there is no
         * embedded colon (:)
         */
        if (strchr(fname, ':') == NULL) {
#define paths_max 1024
            char paths[paths_max];
            char *p = paths;
            int prefs_found = false;
            get_xlisp_path(paths, paths_max, &prefs_found);
            /* make sure we got paths, and the list is not empty */
            if (!*p) {
                if (prefs_found) {
                    sprintf(paths, "\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLISPPATH in XLisp Preferences.",
  "You should probably delete XLisp Preferences and let XLisp",
  "create a new one for you.");
                } else {
                    sprintf(paths, "\n%s\n%s\n%s\n%s\n%s\n",
  "Warning: XLISP failed to find XLisp Preferences.",
  "You should manually locate and load the file runtime:init.lsp",
  "Nyquist will create an XLisp Preferences file to automatically",
  "find the file next time. You may edit XLisp Preferences to add",
  "additional search paths, using a comma as separator.");
                }
                errputstr(paths);
                *p = 0;
            }
            while (*p) {
                char *ptr = fullname;
                /* skiip over separator */
                while (*p == ',') p++;
                /* scan next directory into fullname */
                while (*p && (*p != ',')) {
                    if ((ptr - fullname) >= STRMAX) goto toolong;
                    *ptr++ = *p++;
                }
                /* add ":" if needed */
                if (ptr[-1] != ':') *ptr++ = ':';
                /* append the file name */
                if ((ptr - fullname) + strlen(fname) + 4 > STRMAX)
                    goto toolong;
                strcpy(ptr, fname);
                /* append the .lsp extension */
                if (needsextension(fullname)) {
                    strcat(fullname, ".lsp");
                }
                /* printf("Trying to open \"%s\"\n", fullname);	*/
                if (fp = osaopen(fullname, "r")) goto gotfile;
            }
        }
#endif
        xlpopn(2);
        return (FALSE);
    }
gotfile:
#ifdef MACINTOSH
    /* We found the file ok, call setup_preferences to create
     * XLisp Preferences file (this only happens if previous
     * attempt to find the file failed
     */
    setup_preferences(fullname);
#endif
    setfile(fptr,fp);
    setvalue(s_loadingfiles, cons(fptr, getvalue(s_loadingfiles)));
    setvalue(s_loadingfiles, cons(cvstring(fullname), getvalue(s_loadingfiles)));

    /* print the information line */
    if (vflag)
        { sprintf(buf,"; loading \"%s\"\n",fullname); stdputstr(buf); }

    /* read, evaluate and possibly print each expression in the file */
    xlbegin(&cntxt,CF_ERROR,s_true);
    if (setjmp(cntxt.c_jmpbuf))
        sts = FALSE;
    else {
        while (xlread(fptr,&expr,FALSE)) {
            expr = xleval(expr);
            if (pflag)
                stdprint(expr);
        }
        sts = TRUE;
    }
    xlend(&cntxt);

    /* close the file */
    osclose(getfile(fptr));
    setfile(fptr,NULL);
    if (consp(getvalue(s_loadingfiles)) && 
        consp(cdr(getvalue(s_loadingfiles))) &&
        car(cdr(getvalue(s_loadingfiles))) == fptr) {
        setvalue(s_loadingfiles, cdr(cdr(getvalue(s_loadingfiles))));
    }

    /* restore the stack */
    xlpopn(2);

    /* return status */
    return (sts);

toolong:
    xlcerror("ignore file", "file name too long", NIL);
    xlpopn(2);
    return FALSE;
}