Back to index

plt-scheme  4.2.1
Defines | Enumerations | Functions | Variables
file.c File Reference
#include "schpriv.h"
#include <sys/types.h>
#include <sys/stat.h>
#include <ctype.h>
#include <dirent.h>
#include <errno.h>

Go to the source code of this file.

Defines

#define UNIX_FN_SEP   '/'
#define IS_A_UNIX_SEP(x)   ((x) == '/')
#define IS_A_UNIX_PRIM_SEP(x)   IS_A_UNIX_SEP(x)
#define DOS_FN_SEP   '\\'
#define IS_A_DOS_SEP(x)   (((x) == '/') || ((x) == '\\'))
#define IS_A_DOS_PRIM_SEP(x)   ((x) == '\\')
#define IS_A_DOS_X_SEP(prim, x)   (prim ? IS_A_DOS_PRIM_SEP(x) : IS_A_DOS_SEP(x))
#define FN_SEP(kind)   ((kind == SCHEME_UNIX_PATH_KIND) ? UNIX_FN_SEP : DOS_FN_SEP)
#define IS_A_SEP(kind, x)   ((kind == SCHEME_UNIX_PATH_KIND) ? IS_A_UNIX_SEP(x) : IS_A_DOS_SEP(x))
#define IS_A_PRIM_SEP(kind, x)   ((kind == SCHEME_UNIX_PATH_KIND) ? IS_A_UNIX_PRIM_SEP(x) : IS_A_DOS_PRIM_SEP(x))
#define CURRENT_WD()   scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_DIRECTORY)
#define TO_PATH(x)   (SCHEME_GENERAL_PATHP(x) ? x : scheme_char_string_to_path(x))
#define WHEN_TILDE_IS_ABSOLUTE(x)   0
#define is_drive_letter(c)   (((unsigned char)c < 128) && isalpha((unsigned char)c))
#define IS_SPEC_CHAR(x)   (IS_A_DOS_SEP(x) || ((x) == '"') || ((x) == '|') || ((x) == ':') || ((x) == '<') || ((x) == '>'))
#define mz_getcwd   MSC_IZE(getcwd)
#define GETCWD_BUFSIZE   1024
#define IS_X_SEP(c)   (no_fw ? (c == '\\') : IS_A_DOS_SEP(c))
#define PATH_EXTRA_SPACE   4
#define PN_BUF_LEN   256
#define MAKE_SPLIT(x, y, z)   (*base_out = x, *id_out = z, y)
#define IS_A_SPLIT_SEP(x)   (((kind == SCHEME_WINDOWS_PATH_KIND) && no_slash_sep) ? (x == '\\') : IS_A_SEP(kind, x))
#define MOVE_ERRNO_FORMAT   "%e"
#define SL_NAME_MAX   2048
#define MKDIR_EXN_TYPE   "%e"

Enumerations

enum  {
  id_temp_dir, id_home_dir, id_doc_dir, id_desk_dir,
  id_pref_dir, id_pref_file, id_init_dir, id_init_file,
  id_sys_dir, id_addon_dir
}

Functions

void scheme_set_ignore_user_paths (int v)
static int check_dos_slashslash_drive (const char *next, int delta, int len, int *drive_end, int exact, int no_fw)
static int check_dos_slashslash_qm (const char *next, int len, int *drive_end, int *clean_start, int *add_sep)
static Scheme_Objectpath_p (int argc, Scheme_Object **argv)
static Scheme_Objectgeneral_path_p (int argc, Scheme_Object **argv)
static Scheme_Objectpath_to_string (int argc, Scheme_Object **argv)
static Scheme_Objectpath_to_bytes (int argc, Scheme_Object **argv)
static Scheme_Objectpath_element_to_bytes (int argc, Scheme_Object **argv)
static Scheme_Objectpath_element_to_string (int argc, Scheme_Object **argv)
static Scheme_Objectstring_to_path (int argc, Scheme_Object **argv)
static Scheme_Objectbytes_to_path (int argc, Scheme_Object **argv)
static Scheme_Objectbytes_to_path_element (int argc, Scheme_Object **argv)
static Scheme_Objectstring_to_path_element (int argc, Scheme_Object **argv)
static Scheme_Objectpath_kind (int argc, Scheme_Object **argv)
static Scheme_Objectplatform_path_kind (int argc, Scheme_Object **argv)
static Scheme_Objectfile_exists (int argc, Scheme_Object **argv)
static Scheme_Objectdirectory_exists (int argc, Scheme_Object **argv)
static Scheme_Objectlink_exists (int argc, Scheme_Object **argv)
static Scheme_Objectbuild_path_kind (int argc, Scheme_Object **argv)
static Scheme_Objectdelete_file (int argc, Scheme_Object **argv)
static Scheme_Objectrename_file (int argc, Scheme_Object **argv)
static Scheme_Objectcopy_file (int argc, Scheme_Object **argv)
static Scheme_Objectpath_to_directory_path (int argc, Scheme_Object *argv[])
static Scheme_Objectdirectory_list (int argc, Scheme_Object *argv[])
static Scheme_Objectfilesystem_root_list (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_directory (int argc, Scheme_Object *argv[])
static Scheme_Objectdelete_directory (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_link (int argc, Scheme_Object *argv[])
static Scheme_Objectsplit_path (int argc, Scheme_Object **argv)
static Scheme_Objectrelative_path_p (int argc, Scheme_Object **argv)
static Scheme_Objectabsolute_path_p (int argc, Scheme_Object **argv)
static Scheme_Objectcomplete_path_p (int argc, Scheme_Object **argv)
static Scheme_Objectpath_to_complete_path (int argc, Scheme_Object **argv)
static Scheme_Objectresolve_path (int argc, Scheme_Object *argv[])
static Scheme_Objectsimplify_path (int argc, Scheme_Object *argv[])
static Scheme_Objectcleanse_path (int argc, Scheme_Object *argv[])
static Scheme_Objectexpand_user_path (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_drive (int argc, Scheme_Object *argv[])
static Scheme_Objectfile_modify_seconds (int argc, Scheme_Object *argv[])
static Scheme_Objectfile_or_dir_permissions (int argc, Scheme_Object *argv[])
static Scheme_Objectfile_size (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_library_collection_paths (int argc, Scheme_Object *argv[])
static Scheme_Objectuse_compiled_kind (int, Scheme_Object *[])
static Scheme_Objectuse_user_paths (int, Scheme_Object *[])
static Scheme_Objectfind_system_path (int argc, Scheme_Object **argv)
static int has_null (const char *s, long l)
static void raise_null_error (const char *name, Scheme_Object *path, const char *mod)
static char * do_path_to_complete_path (char *filename, long ilen, const char *wrt, long wlen, int kind)
static Scheme_Objectdo_simplify_path (Scheme_Object *path, Scheme_Object *cycle_check, int skip, int use_filesystem, int force_rel_up, int kind)
static char * do_normal_path_seps (char *si, int *_len, int delta, int strip_trail, int kind, int *_did)
static char * remove_redundant_slashes (char *filename, int *l, int delta, int *expanded, int kind)
static Scheme_Objectdo_path_to_directory_path (char *s, long offset, long len, Scheme_Object *p, int just_check, int kind)
void scheme_init_file (Scheme_Env *env)
Scheme_Objectscheme_make_sized_offset_kind_path (char *chars, long d, long len, int copy, int kind)
Scheme_Objectscheme_make_sized_offset_path (char *chars, long d, long len, int copy)
static int is_special_filename (const char *_f, int offset, int len, int not_nul, int immediate)
static Scheme_Objectmake_protected_sized_offset_path (int protect, char *chars, long d, long len, int copy, int just_check, int kind)
Scheme_Objectmake_exposed_sized_offset_path (int already_protected, char *chars, long d, long len, int copy, int kind)
Scheme_Objectscheme_make_path (const char *chars)
Scheme_Objectscheme_make_sized_path (char *chars, long len, int copy)
Scheme_Objectscheme_make_path_without_copying (char *chars)
static Scheme_Objectappend_path (Scheme_Object *a, Scheme_Object *b)
Scheme_Objectscheme_char_string_to_path (Scheme_Object *p)
static Scheme_Objectdrop_rel_prefix (Scheme_Object *p)
Scheme_Objectscheme_path_to_char_string (Scheme_Object *p)
static Scheme_Objectis_path_element (Scheme_Object *p)
static Scheme_Objectdo_path_element_to_bytes (const char *name, int argc, Scheme_Object **argv)
static void check_path_ok (const char *who, Scheme_Object *p, Scheme_Object *o)
static int extract_path_kind (const char *who, int which, int argc, Scheme_Object **argv)
static Scheme_Objectdo_bytes_to_path_element (const char *name, Scheme_Object *s, int argc, Scheme_Object **argv)
char * scheme_os_getcwd (char *buf, int buflen, int *actlen, int noexn)
int scheme_os_setcwd (char *expanded, int noexn)
Scheme_Objectscheme_get_file_directory (const char *filename)
Scheme_Objectscheme_remove_current_directory_prefix (Scheme_Object *fn)
static int get_slashslash_qm_dot_ups_end (const char *s, int len, int *_lit_start)
static char * convert_to_backslashbackslash_qm (char *cleaned, int *_clen, char *str, int *_alloc, int len)
static char * get_drive_part (const char *wds, int wdlen)
char * scheme_getdrive ()
char * strip_trailing_spaces (const char *s, int *_len, int delta, int in_place)
static char * do_expand_filename (Scheme_Object *o, char *filename, int ilen, const char *errorin, int *expanded, int report_bad_user, int fullpath, int guards, int kind, int expand_user)
char * scheme_expand_filename (char *filename, int ilen, const char *errorin, int *expanded, int guards)
char * scheme_expand_user_filename (char *filename, int ilen, const char *errorin, int *expanded, int guards)
char * scheme_expand_string_filename (Scheme_Object *o, const char *errorin, int *expanded, int guards)
int scheme_file_exists (char *filename)
int scheme_directory_exists (char *dirname)
int scheme_is_regular_file (char *filename)
Scheme_Objectscheme_get_fd_identity (Scheme_Object *port, long fd)
static int path_is_simple_dir_without_sep (Scheme_Object *path)
Scheme_Objectscheme_path_to_directory_path (Scheme_Object *p)
char * scheme_normal_path_seps (char *si, int *_len, int delta)
static Scheme_Objectdo_build_path (int argc, Scheme_Object **argv, int idelta, int no_final_simplify, int kind)
Scheme_Objectscheme_build_path (int argc, Scheme_Object **argv)
static Scheme_Objectpath_to_directory_path (int argc, Scheme_Object **argv)
static Scheme_Objectdo_split_path (const char *path, int len, Scheme_Object **base_out, int *id_out, int *cleaned_slashes, int kind)
Scheme_Objectscheme_split_path (const char *path, int len, Scheme_Object **base_out, int *id_out, int kind)
int scheme_is_relative_path (const char *s, long len, int kind)
int scheme_is_complete_path (const char *s, long len, int kind)
Scheme_Objectscheme_path_to_complete_path (Scheme_Object *path, Scheme_Object *relto_path)
static char * filename_for_error (Scheme_Object *p)
static Scheme_Objectconvert_literal_relative (Scheme_Object *file)
static Scheme_Objectsimplify_qm_path (Scheme_Object *path)
static Scheme_Objectdo_directory_list (int break_ok, int argc, Scheme_Object *argv[])
char * scheme_find_completion (char *fn)
static Scheme_Objectexplode_path (Scheme_Object *p)
Scheme_Objectscheme_extract_relative_to (Scheme_Object *obj, Scheme_Object *dir)
static Scheme_Objectfile_modify_seconds (int argc, Scheme_Object **argv)
static Scheme_Objectcollpaths_gen_p (int argc, Scheme_Object **argv, int rel)
static Scheme_Objectcollpaths_p (int argc, Scheme_Object **argv)
Scheme_Objectscheme_current_library_collection_paths (int argc, Scheme_Object *argv[])
static Scheme_Objectcompiled_kind_p (int argc, Scheme_Object **argv)
Scheme_Objectscheme_get_run_cmd (void)
Scheme_Objectscheme_set_exec_cmd (char *s)
Scheme_Objectscheme_set_run_cmd (char *s)
char * scheme_get_exec_path (void)
void scheme_set_collects_path (Scheme_Object *p)
void scheme_set_original_dir (Scheme_Object *d)

Variables

MZ_DLLSPEC int scheme_ignore_user_paths
static Scheme_Objectup_symbol
static Scheme_Objectrelative_symbol
static Scheme_Objectsame_symbol
static Scheme_Objectread_symbol
static Scheme_Objectwrite_symbol
static Scheme_Objectexecute_symbol
static Scheme_Objecttemp_dir_symbol
static Scheme_Objecthome_dir_symbol
static Scheme_Objectpref_dir_symbol
static Scheme_Objectdoc_dir_symbol
static Scheme_Objectdesk_dir_symbol
static Scheme_Objectinit_dir_symbol
static Scheme_Objectinit_file_symbol
static Scheme_Objectsys_dir_symbol
static Scheme_Objectexec_file_symbol
static Scheme_Objectrun_file_symbol
static Scheme_Objectcollects_dir_symbol
static Scheme_Objectpref_file_symbol
static Scheme_Objectorig_dir_symbol
static Scheme_Objectaddon_dir_symbol
static Scheme_Objectexec_cmd
static Scheme_Objectrun_cmd
static Scheme_Objectcollects_path
static Scheme_Objectoriginal_pwd
static Scheme_Objectwindows_symbol
static Scheme_Objectunix_symbol
static char * special_filenames []

Define Documentation

Definition at line 134 of file file.c.

#define DOS_FN_SEP   '\\'

Definition at line 122 of file file.c.

#define FN_SEP (   kind)    ((kind == SCHEME_UNIX_PATH_KIND) ? UNIX_FN_SEP : DOS_FN_SEP)

Definition at line 127 of file file.c.

#define GETCWD_BUFSIZE   1024
#define IS_A_DOS_PRIM_SEP (   x)    ((x) == '\\')

Definition at line 124 of file file.c.

#define IS_A_DOS_SEP (   x)    (((x) == '/') || ((x) == '\\'))

Definition at line 123 of file file.c.

#define IS_A_DOS_X_SEP (   prim,
  x 
)    (prim ? IS_A_DOS_PRIM_SEP(x) : IS_A_DOS_SEP(x))

Definition at line 125 of file file.c.

#define IS_A_PRIM_SEP (   kind,
  x 
)    ((kind == SCHEME_UNIX_PATH_KIND) ? IS_A_UNIX_PRIM_SEP(x) : IS_A_DOS_PRIM_SEP(x))

Definition at line 129 of file file.c.

#define IS_A_SEP (   kind,
  x 
)    ((kind == SCHEME_UNIX_PATH_KIND) ? IS_A_UNIX_SEP(x) : IS_A_DOS_SEP(x))

Definition at line 128 of file file.c.

#define IS_A_SPLIT_SEP (   x)    (((kind == SCHEME_WINDOWS_PATH_KIND) && no_slash_sep) ? (x == '\\') : IS_A_SEP(kind, x))
#define IS_A_UNIX_PRIM_SEP (   x)    IS_A_UNIX_SEP(x)

Definition at line 120 of file file.c.

#define IS_A_UNIX_SEP (   x)    ((x) == '/')

Definition at line 119 of file file.c.

#define is_drive_letter (   c)    (((unsigned char)c < 128) && isalpha((unsigned char)c))

Definition at line 155 of file file.c.

#define IS_SPEC_CHAR (   x)    (IS_A_DOS_SEP(x) || ((x) == '"') || ((x) == '|') || ((x) == ':') || ((x) == '<') || ((x) == '>'))

Definition at line 541 of file file.c.

#define IS_X_SEP (   c)    (no_fw ? (c == '\\') : IS_A_DOS_SEP(c))
#define MAKE_SPLIT (   x,
  y,
 
)    (*base_out = x, *id_out = z, y)
#define MKDIR_EXN_TYPE   "%e"
#define MOVE_ERRNO_FORMAT   "%e"
#define mz_getcwd   MSC_IZE(getcwd)

Definition at line 1031 of file file.c.

#define PATH_EXTRA_SPACE   4

Definition at line 2573 of file file.c.

#define PN_BUF_LEN   256
#define SL_NAME_MAX   2048

Definition at line 136 of file file.c.

#define UNIX_FN_SEP   '/'

Definition at line 118 of file file.c.

#define WHEN_TILDE_IS_ABSOLUTE (   x)    0

Definition at line 147 of file file.c.


Enumeration Type Documentation

anonymous enum
Enumerator:
id_temp_dir 
id_home_dir 
id_doc_dir 
id_desk_dir 
id_pref_dir 
id_pref_file 
id_init_dir 
id_init_file 
id_sys_dir 
id_addon_dir 

Definition at line 5618 of file file.c.


Function Documentation

static Scheme_Object * absolute_path_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3896 of file file.c.

{
  char *s;
  int len;
  Scheme_Object *bs;

  if (!SCHEME_GENERAL_PATH_STRINGP(argv[0]))
    scheme_wrong_type("absolute-path?", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  bs = TO_PATH(argv[0]);

  s = SCHEME_PATH_VAL(bs);
  len = SCHEME_PATH_LEN(bs);

  if (has_null(s, len))
    return scheme_false;

  return (!scheme_is_relative_path(s, len, SCHEME_PATH_KIND(bs))
         ? scheme_true
         : scheme_false);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* append_path ( Scheme_Object a,
Scheme_Object b 
) [static]

Definition at line 703 of file file.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * build_path_kind ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3110 of file file.c.

{ 
  int kind;

  kind = extract_path_kind("build-path/convention-type", 0, argc, argv);
  return do_build_path(argc - 1, argv, 1, 0, kind);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * bytes_to_path ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 928 of file file.c.

{
  Scheme_Object *s;
  int kind;

  if (!SCHEME_BYTE_STRINGP(argv[0]))
    scheme_wrong_type("bytes->path", "byte string", 0, argc, argv);
  kind = extract_path_kind("bytes->path", 1, argc, argv);

  s = scheme_make_sized_byte_string(SCHEME_BYTE_STR_VAL(argv[0]),
                                SCHEME_BYTE_STRLEN_VAL(argv[0]),
                                SCHEME_MUTABLEP(argv[0]));
  s->type = kind;

  check_path_ok("bytes->path", s, argv[0]);

  return s;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * bytes_to_path_element ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 980 of file file.c.

{
  return do_bytes_to_path_element("bytes->path-element", argv[0], argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int check_dos_slashslash_drive ( const char *  next,
int  delta,
int  len,
int drive_end,
int  exact,
int  no_fw 
) [static]

Definition at line 1360 of file file.c.

{
  int j;
  int is_drive = 0;

  if (drive_end)
    *drive_end = len;

  if (!delta && check_dos_slashslash_qm(next, len, NULL, NULL, NULL))
    return 0;

#define IS_X_SEP(c) (no_fw ? (c == '\\') : IS_A_DOS_SEP(c))

  if (delta || (IS_A_DOS_SEP(next[0]) && IS_A_DOS_SEP(next[1]))) {
    /* Found two separators... */
    /* Check for a drive form: //x/y */
    j = delta ? delta : 2;
    if (!IS_X_SEP(next[j])) {
      /* Found non-sep; skip over more */
      for (; j < len; j++) {
       if (IS_X_SEP(next[j])) {
         /* Found sep again, so we have //x/: */
         j++;
         if (no_fw && (j < len) && IS_X_SEP(next[j]))
           j++; /* two backslashes ok in \\?\UNC mode */
         if ((j == (delta ? (delta + 2) : 4))
             && (next[j - 2] == '?')) {
           /* We have //?/, with up to 2 backslashes.
              This doesn't count as UNC, to avoid confusion with \\?\. */
         } else if ((j < len) && !IS_X_SEP(next[j])) {
           /* Found non-sep again; this is UNC */
           for (; j < len; j++) {
             if (IS_X_SEP(next[j])) {
              /* Found sep again. */
              if (drive_end)
                *drive_end = j;
              if (exact) {
                for (; j < len; j++) {
                  if (!IS_X_SEP(next[j])) {
                    /* Found non-sep again 
                      - not a drive (it's absolute path) */
                    break;
                  }
                }
              } else
                is_drive = 1;
              break;
             }
           }
           if (j >= len)
             is_drive = 1;
           break;
         }
         break;
       } else if (IS_A_DOS_SEP(next[j])) {
         /* Found / when only \ is allowed as separator */
         break;
       }
      }
    }
  }

  return is_drive;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int check_dos_slashslash_qm ( const char *  next,
int  len,
int drive_end,
int clean_start,
int add_sep 
) [static]

Definition at line 1231 of file file.c.

{
  if ((len >= 4)
      && (next[0] == '\\')
      && (next[1] == '\\')
      && (next[2] == '?')
      && (next[3] == '\\')) {
    int base;
    if (!drive_end && !clean_start && !add_sep)
      return 1;
    if (next[4] == '\\')
      base = 5;
    else
      base = 4;
    /* If there's two backslashes in a row at the end, count everything
       as the drive. There are two exceptions: two backslashes are ok
       at the end in the form \\?\C:\\, and \\?\\\ is \\?\ */
    if ((len > 5)
       && (next[len - 1] == '\\')
       && (next[len - 2] == '\\')) {
      if (len == 6) {
       /* \\?\ is the root */
      } else if ((len != 8)
         || !is_drive_letter(next[base])
         || (next[base+1] != ':')) {
       if (drive_end)
         *drive_end = len;
       if (clean_start)
         *clean_start = len;
       if (add_sep)
         *add_sep = len;
       return 1;
      }
    }
    /* If there's three backslashes in a row, count everything
       up to the slashes as the drive. */
    if (len > 6) {
      int i;
      for (i = len; --i > 5; ) {
       if ((next[i] == '\\')
           && (next[i-1] == '\\')
           && (next[i-2] == '\\')) {
         if (drive_end)
           *drive_end = i+1;
         if (clean_start)
           *clean_start = i+1;
         return 1;
       }
      }
    }

    if ((len > 6)
       && is_drive_letter(next[base])
       && next[base+1] == ':'
       && next[base+2] == '\\') {
      if (clean_start)
       *clean_start = base+2;
      if (drive_end) {
       if ((len > base+3) && next[base+3] == '\\')
         *drive_end = base+4;
       else
         *drive_end = base+3;
      }
    } else if ((len > base+3)
              && ((next[base] == 'U') || (next[base] == 'u'))
              && ((next[base+1] == 'N') || (next[base+1] == 'n'))
              && ((next[base+2] == 'C') || (next[base+2] == 'c'))
              && (next[base+3] == '\\')
              && check_dos_slashslash_drive(next, 
                                        (((len > (base+4)) && (next[base+4] == '\\'))
                                         ? base+5
                                         : base+4),
                                        len, drive_end, 0, 1)) {
      /* drive_end set by check_dos_slashslash_drive */
      if (clean_start)
       *clean_start = base+3;
    } else if ((base == 4) 
              && (len > 8)
              && (next[4] == 'R')
              && (next[5] == 'E')
              && ((next[6] == 'L') || (next[6] == 'D'))
              && (next[7] == '\\')
              && ((next[8] != '\\')
                 || (len > 9))) { 
      if (drive_end)
       *drive_end = ((next[6] == 'L') ? -1 : -2);
      if (clean_start)
       *clean_start = len; /* caller will have to use get_slashslash_qm_dot_ups_end */
    } else {
      if (drive_end)
       *drive_end = 4;
      if (clean_start) {
       if (((len == 5) && (next[4] == '\\'))
           || ((len == 6) && (next[4] == '\\') && (next[5] == '\\')))
         *clean_start = 3;
       else
         *clean_start = 4;
      }
      if (add_sep)
       *add_sep = 4;
    }
    return 1;
  }
  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void check_path_ok ( const char *  who,
Scheme_Object p,
Scheme_Object o 
) [static]

Definition at line 893 of file file.c.

{
  if (has_null(SCHEME_PATH_VAL(p), SCHEME_PATH_LEN(p))) {
    raise_null_error(who, o, "");
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * cleanse_path ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4579 of file file.c.

{
  char *filename;
  int expanded;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("cleanse-path", SCHEME_PATH_STRING_STR, 0, argc, argv);

  filename = do_expand_filename(argv[0],
                            NULL,
                            0,
                            "cleanse-path",
                            &expanded,
                            1, 0,
                            SCHEME_GUARD_FILE_EXISTS, 
                                SCHEME_PLATFORM_PATH_KIND,
                                0);
  
  if (!expanded && SCHEME_PATHP(argv[0]))
    return argv[0];
  else
    return scheme_make_sized_path(filename, strlen(filename), 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* collpaths_gen_p ( int  argc,
Scheme_Object **  argv,
int  rel 
) [static]

Definition at line 5520 of file file.c.

{
  Scheme_Object *v = argv[0];

  if (scheme_proper_list_length(v) < 0)
    return NULL;

  if (SCHEME_NULLP(v))
    return v;

  while (SCHEME_PAIRP(v)) {
    Scheme_Object *s;
    s = SCHEME_CAR(v);
    if (!SCHEME_PATH_STRINGP(s))
      return NULL;
    s = TO_PATH(s);
    if (rel && !scheme_is_relative_path(SCHEME_PATH_VAL(s),
                                   SCHEME_PATH_LEN(s),
                                        SCHEME_PLATFORM_PATH_KIND))
      return NULL;
    if (!rel && !scheme_is_complete_path(SCHEME_PATH_VAL(s),
                                    SCHEME_PATH_LEN(s),
                                         SCHEME_PLATFORM_PATH_KIND))
      return NULL;
    v = SCHEME_CDR(v);
  }

  if (!SCHEME_NULLP(v))
    return NULL;

  /* Convert to list of paths: */
  {
    Scheme_Object *last = NULL, *first = NULL, *p, *s;
    v = argv[0];
    while (SCHEME_PAIRP(v)) {
      s = SCHEME_CAR(v);
      s = TO_PATH(s);
      
      p = scheme_make_pair(s, scheme_null);
      if (!first)
       first = p;
      else
       SCHEME_CDR(last) = p;
      last = p;

      v = SCHEME_CDR(v);
    }

    return first;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* collpaths_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 5574 of file file.c.

{
  return collpaths_gen_p(argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* compiled_kind_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 5593 of file file.c.

{
  return collpaths_gen_p(argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * complete_path_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3874 of file file.c.

{
  char *s;
  int len;
  Scheme_Object *bs;

  if (!SCHEME_GENERAL_PATH_STRINGP(argv[0]))
    scheme_wrong_type("complete-path?", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  bs = TO_PATH(argv[0]);

  s = SCHEME_PATH_VAL(bs);
  len = SCHEME_PATH_LEN(bs);

  if (has_null(s, len))
    return scheme_false;

  return (scheme_is_complete_path(s, len, SCHEME_PATH_KIND(bs))
         ? scheme_true
         : scheme_false);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 3984 of file file.c.

{
  int ln;
  char *f;
  f = SCHEME_PATH_VAL(file);
  ln = SCHEME_PATH_LEN(file);
  if ((ln == 11) && !strcmp(f, "\\\\?\\REL\\\\.."))
    return up_symbol;
  else if ((ln == 10) && !strcmp(f, "\\\\?\\REL\\\\."))
    return same_symbol;
  return file;
}

Here is the caller graph for this function:

static char* convert_to_backslashbackslash_qm ( char *  cleaned,
int _clen,
char *  str,
int _alloc,
int  len 
) [static]

Definition at line 1484 of file file.c.

{
  int clen = *_clen, pos;
  int alloc = *_alloc;

  if (!str) {
    alloc = clen + 10;
    str = scheme_malloc_atomic(alloc);
  }

  {
    int cde = 0;
    if (!check_dos_slashslash_drive(cleaned, 0, clen, &cde, 0, 0))
      cde = 0;
    cleaned = remove_redundant_slashes(cleaned, &clen, cde, NULL, SCHEME_WINDOWS_PATH_KIND);
  }
  cleaned = do_normal_path_seps(cleaned, &clen, 0, 1, SCHEME_WINDOWS_PATH_KIND, NULL);
  if (scheme_is_relative_path(cleaned, clen, SCHEME_WINDOWS_PATH_KIND)) {
    memcpy(str, "\\\\?\\REL\\", 8);
    memcpy(str + 8, cleaned, clen);
    pos = clen + 8;
  } else {
    int plen, xdel = 0;
    if (cleaned[0] == '\\') {
      if (cleaned[1] == '\\') {
        /* UNC */
        xdel = 1;
        plen = 7;
        pos = 0; /* reset below */
      } else {
        /* Drive-relative absolute. */
        memcpy(str, "\\\\?\\RED\\", 8);
        memcpy(str + 8, cleaned, clen);
        pos = clen + 8;
        plen = 0;
      }
    } else {
      plen = 4;
      pos = 0; /* reset below */
    }
    if (plen) {
      memcpy(str, "\\\\?\\UNC", plen);
      memcpy(str + plen, cleaned + xdel, clen - xdel);
      pos = clen + plen - xdel;
    }
  }

  *_alloc = alloc;
  *_clen = pos;
  return str;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * copy_file ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3744 of file file.c.

{
  char *src, *dest, *reason = NULL;
  int pre_exists = 0;
  Scheme_Object *bss, *bsd;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("copy-file", SCHEME_PATH_STRING_STR, 0, argc, argv);
  if (!SCHEME_PATH_STRINGP(argv[1]))
    scheme_wrong_type("copy-file", SCHEME_PATH_STRING_STR, 1, argc, argv);

  bss = argv[0];
  bsd = argv[1];

  src = scheme_expand_string_filename(bss,
                                  "copy-file",
                                  NULL,
                                  SCHEME_GUARD_FILE_READ);
  dest = scheme_expand_string_filename(bsd,
                                   "copy-file",
                                   NULL, 
                                   SCHEME_GUARD_FILE_WRITE | SCHEME_GUARD_FILE_DELETE);

#ifdef UNIX_FILE_SYSTEM
  {
# define COPY_BUFFER_SIZE 2048
    FILE *s, *d;
    char b[COPY_BUFFER_SIZE];
    long len;
    int ok;
    struct stat buf;


    do {
      ok = stat(src, &buf);
    } while ((ok == -1) && (errno == EINTR));

    if (ok || S_ISDIR(buf.st_mode)) {
      reason = "source file does not exist";
      goto failed;
    }

    do {
      ok = stat(dest, &buf);
    } while ((ok == -1) && (errno == EINTR));

    if (!ok) {
      reason = "destination already exists";
      pre_exists = 1;
      goto failed;
    }

    s = fopen(src, "rb");
    if (!s) {
      reason = "cannot open source file";
      goto failed;
    }

    d = fopen(dest, "wb");
    if (!d) {
      fclose(s);
      reason = "cannot open destination file";
      goto failed;
    }
    
    ok = 1;
    while ((len = fread(b, 1, COPY_BUFFER_SIZE, s))) {
      if (fwrite(b, 1, len, d) != len) {
       ok = 0;
       break;
      }
    }
    if (!feof(s))
      ok = 0;

    fclose(s);
    fclose(d);

    if (ok) {
      while (1) {
       if (!chmod(dest, buf.st_mode))
         return scheme_void;
       else if (errno != EINTR)
         break;
      }
      reason = "cannot set destination's mode";
    } else
      reason = "read or write failed";
  }
 failed:
#endif
#ifdef DOS_FILE_SYSTEM
  if (CopyFileW(WIDE_PATH_COPY(src), WIDE_PATH(dest), TRUE))
    return scheme_void;
  
  reason = "copy failed";
  if (GetLastError() == ERROR_ALREADY_EXISTS)
    pre_exists = 1;
#endif

  scheme_raise_exn(pre_exists ? MZEXN_FAIL_FILESYSTEM_EXISTS : MZEXN_FAIL_FILESYSTEM, 
                 "copy-file: %s; cannot copy: %q to: %q",
                 reason,
                 filename_for_error(argv[0]),
                 filename_for_error(argv[1]));
  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_drive ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4565 of file file.c.

{
#ifdef DOS_FILE_SYSTEM
  char *drive;

  drive = scheme_getdrive();

  return scheme_make_sized_path(drive, strlen(drive), 0);
#else
  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED, "current-drive: not supported");
  return NULL;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * current_library_collection_paths ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5583 of file file.c.

{
  return scheme_param_config("current-library-collection-paths", 
                          scheme_make_integer(MZCONFIG_COLLECTION_PATHS),
                          argc, argv,
                          -1, collpaths_p, "list of complete paths and strings", 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * delete_directory ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5076 of file file.c.

{
#ifdef NO_RMDIR
  return scheme_false;
#else
# ifdef DOS_FILE_SYSTEM
  int tried_cwd = 0;
# endif
  char *filename;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("delete-directory", SCHEME_PATH_STRING_STR, 0, argc, argv);

  filename = scheme_expand_string_filename(argv[0],
                                      "delete-directory",
                                      NULL,
                                      SCHEME_GUARD_FILE_DELETE);

  while (1) {
    if (!MSC_W_IZE(rmdir)(MSC_WIDE_PATH(filename)))
      return scheme_void;
# ifdef DOS_FILE_SYSTEM
    else if ((errno == EACCES) && !tried_cwd) {
      /* Maybe we're using the target directory. Try a real setcwd. */
      Scheme_Object *tcd;
      tcd = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_DIRECTORY);
      scheme_os_setcwd(SCHEME_PATH_VAL(tcd), 0);
      tried_cwd = 1;
    }
# endif
    else if (errno != EINTR)
      break;
  }

  scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                 "delete-directory: cannot delete directory: %q (%e)",
                 filename_for_error(argv[0]),
                 errno);
  return NULL;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * delete_file ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3641 of file file.c.

{
  int errid;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("delete-file", SCHEME_PATH_STRING_STR, 0, argc, argv);

  while (1) {
    if (!MSC_W_IZE(unlink)(MSC_WIDE_PATH(scheme_expand_string_filename(argv[0],
                                                               "delete-file",
                                                               NULL,
                                                               SCHEME_GUARD_FILE_DELETE))))
      return scheme_void;
    else if (errno != EINTR)
      break;
  }
  errid = errno;
  
  scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, 
                 "delete-file: cannot delete file: \"%q\" (%e)",
                 filename_for_error(argv[0]),
                 errid);

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * directory_exists ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 2240 of file file.c.

{
  char *f;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("directory-exists?", SCHEME_PATH_STRING_STR, 0, argc, argv);

  f = do_expand_filename(argv[0],
                      NULL,
                      0,
                      "directory-exists?",
                      NULL,
                      0, 1,
                      SCHEME_GUARD_FILE_EXISTS,
                         SCHEME_PLATFORM_PATH_KIND,
                         0);

  return (f && scheme_directory_exists(f)) ? scheme_true : scheme_false;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * directory_list ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4826 of file file.c.

{
  return do_directory_list(1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_build_path ( int  argc,
Scheme_Object **  argv,
int  idelta,
int  no_final_simplify,
int  kind 
) [static]

Definition at line 2575 of file file.c.

{
#define PN_BUF_LEN 256
  int pos, i, len, no_sep;
  int alloc = PN_BUF_LEN;
  char buffer[PN_BUF_LEN], *str, *next;
  int rel, next_off;
  int first_was_drive = 0;
  int first_len = 0;
  int needs_extra_slash = 0;
  int pre_unc = 0;
  int pre_qm = 0;
  const char *who = (idelta ? "build-path/convention-type" : "build-path");

  str = buffer;
  pos = 0;

  no_sep = 0; /* This is actually initialized after we know whether
               it's relative or not. */

  for (i = 0 ; i < argc; i++) {
    if (SCHEME_GENERAL_PATH_STRINGP(argv[i+idelta])
       || (SCHEME_SYMBOLP(argv[i+idelta]) 
           && (SAME_OBJ(argv[i+idelta], up_symbol)
              || SAME_OBJ(argv[i+idelta], same_symbol)))) {
      next_off = 0;
      if (SAME_OBJ(argv[i+idelta], up_symbol)) {
        next = "..";
        len = 2;
      } else if (SAME_OBJ(argv[i+idelta], same_symbol)) {
       next = ".";
       len = 1;
      } else {
       Scheme_Object *bs;

        if (SCHEME_CHAR_STRINGP(argv[i+idelta])) {
          if (kind != SCHEME_PLATFORM_PATH_KIND) {
            scheme_arg_mismatch(who,
                                (idelta
                                 ? "specified convention incompatible with string path element: "
                                 : "preceding path's convention incompatible with string path element: "),
                                argv[i+idelta]); 
          }
        }

       bs = TO_PATH(argv[i+idelta]);

        if (kind != SCHEME_PATH_KIND(bs)) {
          scheme_arg_mismatch(who,
                              (idelta
                               ? "specified convention incompatible with given path element: "
                               : "preceding path's convention incompatible from given path element: "),
                              argv[i+idelta]);
        }

       next = SCHEME_PATH_VAL(bs);
       len = SCHEME_PATH_LEN(bs);
       if (!len) {
         char *astr;
         long alen;

         astr = scheme_make_args_string("other ", i+idelta, argc, argv, &alen);
         scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                        "%s: %d%s path element is an empty string%t", 
                           who,
                        i + 1,
                        scheme_number_suffix(i + 1),
                        astr, alen); 
         return scheme_false;
       }

       if (has_null(next, len)) {
         raise_null_error(who, argv[i+idelta], " element");
         return NULL;
       }
      }

      if (kind == SCHEME_WINDOWS_PATH_KIND) {
       /* Strip trailing spaces before we add more path parts,
          because trailing spaces originally don't count for the base
          path, and they'll start counting if we add more without
          removing the spaces first. first_len points after anything
          that should be saved due to a \\?\ prefix. */
       int p = pos;
       strip_trailing_spaces(str, &p, first_len, 1);
       pos = p;
      }

      /* +3: null term, leading sep, and trailing sep (if up & Mac) */
      if (pos + len + PATH_EXTRA_SPACE >= alloc) {
       char *naya;
       int newalloc;

       newalloc = 2 * alloc + len + 1;
       naya = (char *)scheme_malloc_atomic(newalloc);
       memcpy(naya, str, pos);
       alloc = newalloc;
       
       str = naya;
      }

      if (kind == SCHEME_UNIX_PATH_KIND) {
        if (next[0] == '/') {
          rel = 0;
          if (i) {
            scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                             "%s: absolute path \"%q\" cannot be"
                             " added to a path",
                             who,
                             next);
            return scheme_false;
          }
        } else {
          rel = 1;
#ifdef TILDE_IS_ABSOLUTE
          if (i && (next[0] == '.') && (next[1] == '/') && (next[2] == '~')) {
            /* Strip the "./" prefix */
            next_off += 2;
            len -= 2;
          }
#endif
        }
      } else {
        /* SCHEME_WINDOWS_PATH_KIND: */
       int is_drive;

       needs_extra_slash = 0;
       
       if (IS_A_DOS_SEP(next[0])) {
         int drive_end, plus_sep = 0;
         rel = 0;
         if (check_dos_slashslash_qm(next, len, &drive_end, NULL, &plus_sep)) {
           if (drive_end < 0) {
             /* \\?\REL\ or \\?\RED\ path */
             rel = 1;
             is_drive = 0;
             if (i) {
              int dots_end, lit_start;
              int new_rel_base, need_simplify;
              int base_is_here = 0;

              /* If the current base is not a \\?\ path, turn it into one. */
              if (!check_dos_slashslash_qm(str, pos, &drive_end, NULL, NULL)) {
                Scheme_Object *simp;

                str[pos] = 0;
                simp = do_simplify_path(scheme_make_sized_offset_kind_path(str, 0, pos, 0,
                                                                             SCHEME_WINDOWS_PATH_KIND),
                                     scheme_null, first_len, 0, 0,
                                          SCHEME_WINDOWS_PATH_KIND);
                if (SCHEME_FALSEP(simp)) {
                  /* Base path is just relative "here". We can ignore it. */
                  pos = 0;
                  first_len = len;
                  if (next[len] != '\\')
                    first_len++;
                  no_sep = 1;
                  new_rel_base = 0;
                } else {
                  char *cleaned;
                  int clen;
                  int al = alloc;

                  clen = SCHEME_PATH_LEN(simp); 
                  cleaned = SCHEME_PATH_VAL(simp);

                  str = convert_to_backslashbackslash_qm(cleaned, &clen, str, &al, 
                                                    len + PATH_EXTRA_SPACE);

                  pos = clen;
                  alloc = al;
                  
                  if ((pos > 5)
                     && (str[4] == 'R')
                     && (str[5] == 'E'))
                    new_rel_base = 1;
                  else
                    new_rel_base = 0;

                  if (str[pos - 1] != '\\')
                    str[pos++] = '\\';
                  no_sep = 1;
                  first_len = pos;
                }
                need_simplify = 0;
              } else {
                new_rel_base = (drive_end < 0);
                need_simplify = 1;
              }
              
              if (!pos) {
                /* Base was relative "here", so we can use next directly */
              } else {
                dots_end = get_slashslash_qm_dot_ups_end(next, len, &lit_start);
                
                if (dots_end > 0) {
                  /* Add dots part of this addition, then simplify again: */
                  if (!no_sep)
                    str[pos++] = '\\';
                  memcpy(str + pos, next + 8, dots_end - 8);
                  pos += dots_end - 8;
                  str[pos] = 0;
                  need_simplify = 1;
                }

                if (need_simplify) {
                    /* Simplify the base path to build on: */
                  Scheme_Object *simp;

                  simp = do_simplify_path(scheme_make_sized_offset_kind_path(str, 0, pos, 0,
                                                                               SCHEME_WINDOWS_PATH_KIND),
                                       scheme_null, first_len, 0, 1,
                                            SCHEME_WINDOWS_PATH_KIND);
                  if (SCHEME_FALSEP(simp)) {
                      /* Note: if root turns out to be relative, then we couldn't
                         have had a \\?\RED\ path. */
                    memcpy(str, "\\\\?\\REL\\\\", 9);
                    pos = 9;
                    no_sep = 1;
                    base_is_here = 1;
                  } else {
                    pos = SCHEME_PATH_LEN(simp);
                    memcpy(str, SCHEME_PATH_VAL(simp), pos);
                    no_sep = (str[pos - 1] == '\\');
                  }
                }

                /* At this point, we may have dots only in a \\?\REL
                   path in str, or we might have something without a 
                   \\ to prevent later .. from being parsed as 'up.
                   So, add a backslash if needed. */
                if (new_rel_base && (lit_start < len)) {
                  int ls;
                  dots_end = get_slashslash_qm_dot_ups_end(str, pos, &ls);
                  if (dots_end > 0) {
                    if (ls == pos) {
                     if (dots_end + 2 > pos) {
                       if (dots_end + 1 > pos)
                         str[pos++] = '\\';
                       str[pos++] = '\\';
                       no_sep = 1;
                     }
                    }
                  } else if (ls == 8) {
                    memmove(str + 9, str + 8, pos - 8);
                    str[8] = '\\';
                    pos++;
                    no_sep = 1;
                  } 
                }

                /* Set offset into next to get only literal part, and
                   set first_len to indicate that the result will be
                   literal */
                next_off = lit_start;
                len -= next_off;
                if (!len) {
                  if (base_is_here) {
                    /* Special case: base is "here" and path to add is
                      "here". Make sure result is just ".". */
                    pos = 0;
                    no_sep = 1;
                    next = ".";
                    len = 1;
                    next_off = 0;
                  } else
                    no_sep = 1;
                } else {
                  /* One last possibility: str is \\?\ (which counts as a bizaare
                     root). We need two extra slashes. */
                  if (!new_rel_base && (pos == 4)) {
                    str[pos++] = '\\';
                    str[pos++] = '\\';
                  }
                }
                first_len = pos + len;
                if (next[next_off + len] != '\\')
                  first_len++;
              }
             } else {
              first_len = len;
             }
           } else {
             /* non-REL/RED \\?\ path */
              is_drive = (drive_end == len);
             needs_extra_slash = plus_sep;
             if (!i) {
              first_len = len;
              if (next[first_len - 1] != '\\')
                first_len++;
             }
           }
         } else
           is_drive = check_dos_slashslash_drive(next, 0, len, NULL, 1, 0);
       } else if ((len >= 2) 
                 && is_drive_letter(next[0])
                 && (next[1] == ':')) {
         int j;
         rel = 0;
         for (j = 2; j < len; j++) {
           if (!IS_A_DOS_SEP(next[j]))
             break;
         }
         is_drive = (j >= len);
       } else {
         rel = 1;
         is_drive = 0;
       }

       if (!rel) {
         if (i && (!first_was_drive || (i > 1) || is_drive)) {
           if (pos > 30) {
             str[27] = '.';
             str[28] = '.';
             str[29] = '.';
             str[30] = 0;
           } else
             str[pos] = 0;
           scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                          "%s: %s \"%s\" cannot be"
                          " added to the path \"%q\"",
                             who,
                          is_drive ? "drive" : "absolute path",
                          next, str);
           return scheme_false;
         }

         if (i == 1) {
           /* Absolute path onto a drive: skip separator(s) */
           while (len && IS_A_DOS_SEP(next[next_off])) {
             next_off++;
             len--;
           }
         }
       }

       if (!i)
         first_was_drive = is_drive;
      }

      if (!i) {
       no_sep = 1;
      }
      
      if (kind == SCHEME_WINDOWS_PATH_KIND) {
        if (i) {
          pre_unc = check_dos_slashslash_drive(str, 0, pos, NULL, 0, 0);
         if (!pre_unc) {
           int de;
           if (check_dos_slashslash_qm(str, pos, &de, NULL, NULL)) {
             if (de == 4) /* \\?\ */
              pre_qm = 1;
           }
         } else
           pre_qm = 0;
        } else {
          pre_unc = 1;
         pre_qm = 0;
       }

        if (no_final_simplify
            && (len == 2) 
            && (next[next_off] == '.')
            && (next[next_off+1] == '.')
            && (first_len < pos + 2)) {
          /* Adding ".." ... */
          int de;
          if (check_dos_slashslash_qm(str, pos, &de, NULL, NULL)) {
            if (de < 0) {
              /* ... to a \\?\REL\ or \\?\RED\ path. Unless the \\?\REL\ path
                 is only dots, we need to remove a path element
                 here, instead of waiting for simplify, because simplify
                 will just push the job back here. */
              int ls, dots_end;
              dots_end = get_slashslash_qm_dot_ups_end(str, pos, &ls);
              if (ls == pos) {
                /* It's ok to add "..". Make sure we don't
                   append to "..\\" by setting pos to no more
                   than dots_end + 1. */
                if (dots_end < ls)
                  pos = dots_end + 1;
              } else {
                int q;
                for (q = pos; q-- > ls; ) {
                  if (str[q] == '\\') {
                    break;
                  }
                }
                pos = q;
                first_len = pos;
                len = 0;
                while (q && (str[q-1] == '\\')) {
                  q--;
                }
                if (q == 7) {
                  /* All we have left is \\?\REL or \\?\RED (plus a slash or two).
                     We should only get here when called by scheme_simplify. */
                  if (i + 1 == argc) {
                    /* Since we were called by scheme_simplify, use #f to mean
                       the empty path. */
                    return scheme_false;
                  }
                  /* Shouldn't ever get here, but just in case... */
                  str[0] = '.';
                  pos = 1;
                  no_sep = 1;
                  first_len = 0;
                }
              }
            }
          }
        }
      }

      if (!no_sep)
       str[pos++] = FN_SEP(kind);

      memcpy(str + pos, next + next_off, len);
      pos += len;

      if (kind == SCHEME_WINDOWS_PATH_KIND) {
        if (!pre_unc
            && check_dos_slashslash_drive(str, 0, pos, NULL, 0, 0)) {
          /* Added to //x to get something that looks like UNC. Remove the
             first [back]slash. */
          memmove(str, str+1, pos - 1);
          --pos;
        }
       if (pre_qm) {
         int de;

         /* Normalize path separators for the addition: */
         {
           int i;
           for (i = first_len; i < pos; i++) {
             if (str[i] == '/') {
              str[i] = '\\';
             }
           }
         }

         /* check the \\?\ parsing */
         check_dos_slashslash_qm(str, pos, &de, NULL, NULL);
         if (de != 4) {
           /* Added to \\?\ to get something that now looks like 
              a \\?\UNC path. Insert a backslash or two. */
           int amt = ((str[4] == '\\') ? 1 : 2);
       
           if (pos + amt >= alloc) {
             char *naya;
             int newalloc;
             
             newalloc = 2 * alloc;
             naya = (char *)scheme_malloc_atomic(newalloc);
             memcpy(naya, str, pos);
             alloc = newalloc;
             
             str = naya;
           }
           memmove(str + 4 + amt, str + 4, pos - 4);
           str[4] = '\\';
           if (amt == 2)
             str[5] = '\\';
           pos += amt;
           first_len += amt;
         }
       }

        if (needs_extra_slash) {
          if (needs_extra_slash >= pos)
            str[pos++] = '\\';
          else if (str[needs_extra_slash] != '\\') {
            memmove(str + needs_extra_slash + 1, str + needs_extra_slash, pos - needs_extra_slash);
            str[needs_extra_slash] = '\\';
            pos++;
          }
        }
      }

      /* If last path elem ends in a separator, don't add one: */
      if (len) {
       no_sep = IS_A_SEP(kind, next[next_off + len - 1]);
      } else {
       no_sep = 0;
      }
    } else {
      scheme_wrong_type(who, "path, string, 'up, 'same", i + idelta, argc, argv);
      return scheme_false;
    }
  }

  str[pos] = 0;

  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    if (check_dos_slashslash_qm(str, pos, NULL, NULL, NULL) && !no_final_simplify) {
      /* Clean up additions to \\?\ path */
      int p;
      Scheme_Object *simp;
      p = pos;
      str = do_normal_path_seps(str, &p, first_len, 1, SCHEME_WINDOWS_PATH_KIND, NULL);
      str = remove_redundant_slashes(str, &p, first_len, NULL, SCHEME_WINDOWS_PATH_KIND);
      simp = do_simplify_path(scheme_make_sized_offset_kind_path(str, 0, p, 0, SCHEME_WINDOWS_PATH_KIND),
                              scheme_null, first_len, 0, 1, SCHEME_WINDOWS_PATH_KIND);
      if (SCHEME_FALSEP(simp))
        return scheme_make_sized_offset_kind_path(".\\", 0, 1, 0, SCHEME_WINDOWS_PATH_KIND);
      else
        return simp;
    }
  }

  return scheme_make_sized_offset_kind_path(str, 0, pos, alloc == PN_BUF_LEN, kind);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_bytes_to_path_element ( const char *  name,
Scheme_Object s,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 947 of file file.c.

{
  Scheme_Object *p;
  long i, len;
  int kind;

  if (!SCHEME_BYTE_STRINGP(s))
    scheme_wrong_type(name, "byte string", 0, argc, argv);
  kind = extract_path_kind(name, 1, argc, argv);

  len = SCHEME_BYTE_STRLEN_VAL(s);
  for (i = 0; i < len; i++) {
    if (IS_A_PRIM_SEP(kind, SCHEME_BYTE_STR_VAL(s)[i])) {
      break;
    }
  }

  if (i >= len)
    p = make_protected_sized_offset_path(1, SCHEME_BYTE_STR_VAL(s),
                                         0, len,
                                         SCHEME_MUTABLEP(s), 0,
                                         kind);
  else
    p = NULL;

  if (!p || !is_path_element(p))
    scheme_arg_mismatch(name,
                        "cannot be converted to a path element (can be split, is not relative, or names a special element): ",
                        argv[0]);

  return p;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_directory_list ( int  break_ok,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4634 of file file.c.

{
#if !defined(NO_READDIR) || defined(USE_FINDFIRST)
  char *filename;
  Scheme_Object * volatile first = scheme_null, * volatile last = NULL, *n, *elem;
#endif
#ifndef NO_READDIR
  DIR *dir;
  int nlen;
  struct dirent *e;
#endif
#ifdef USE_FINDFIRST
  char *pattern;
  int len;
  FF_HANDLE_TYPE hfile, *hfile_ptr = NULL;
  FF_TYPE info;
#endif
  volatile int counter = 0;

  if (argc && !SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("directory-list", SCHEME_PATH_STRING_STR, 0, argc, argv);

#if defined(NO_READDIR) && !defined(USE_FINDFIRST)
  return scheme_null;
#else

  if (argc) {
    Scheme_Object *path = argv[0];
# ifdef USE_FINDFIRST
    while (1) {
# endif
      filename = do_expand_filename(path, NULL, 0, 
                                break_ok ? "directory-list" : NULL, 
                                NULL, 1, 259 - 4 /* leave room for \*.* in Windows */, 
                                break_ok ? SCHEME_GUARD_FILE_READ : 0, 
                                    SCHEME_PLATFORM_PATH_KIND,
                                    0);
      if (!filename)
       return NULL;
# ifdef USE_FINDFIRST
      /* Eliminate "." and "..": */
      if (SAME_OBJ(path, argv[0])) {
       Scheme_Object *old;
       old = scheme_make_path(filename);
       path = do_simplify_path(old, scheme_null, 0, 1, 0, SCHEME_WINDOWS_PATH_KIND);
       if (SAME_OBJ(path, old))
         break;
      } else
       break;
    }
# endif
  } else {
    filename = SCHEME_PATH_VAL(CURRENT_WD());
    if (break_ok) {
      scheme_security_check_file("directory-list", NULL, SCHEME_GUARD_FILE_EXISTS);
      scheme_security_check_file("directory-list", filename, SCHEME_GUARD_FILE_READ);
    }
  }

# ifdef USE_FINDFIRST

  if (!filename)
    pattern = "*.*";
  else {
    char *nf;
    int is_unc = 0, d, nd;
    len = strlen(filename);
    if ((len > 1) && IS_A_DOS_SEP(filename[0]) && check_dos_slashslash_drive(filename, 0, len, NULL, 0, 0))
      is_unc = 1;
    nf = scheme_normal_path_seps(filename, &len, 0);
    pattern = (char *)scheme_malloc_atomic(len + 14);
    
    if ((scheme_stupid_windows_machine > 0)
       || check_dos_slashslash_qm(filename, len, NULL, NULL, NULL)) {
      d = 0;
      nd = 0;
    } else {
      pattern[0] = '\\';
      pattern[1] = '\\';
      pattern[2] = '?';
      pattern[3] = '\\';
      if (is_unc) {
       pattern[4] = 'U';
       pattern[5] = 'N';
       pattern[6] = 'C';
       pattern[7] = '\\';
       d = 8;
       nd = 2;
      } else {
       d = 4;
       nd = 0;
      }
    }
    memcpy(pattern + d, nf + nd, len - nd);
    len += (d - nd);
    if (len && !IS_A_DOS_SEP(pattern[len - 1]))
      pattern[len++] = '\\';      
    memcpy(pattern + len, "*.*", 4);
  }

  hfile = FIND_FIRST(WIDE_PATH(pattern), &info);
  if (FIND_FAILED(hfile)) {
    if (!filename)
      return scheme_null;
    if (break_ok)
      scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                       "directory-list: could not open \"%q\" (%E)",
                       filename,
                       GetLastError());  
    return NULL;
  }

  do {
    if ((GET_FF_NAME(info)[0] == '.')
       && (!GET_FF_NAME(info)[1] || ((GET_FF_NAME(info)[1] == '.')
                                  && !GET_FF_NAME(info)[2]))) {
      /* skip . and .. */
    } else {
      n = make_protected_path(NARROW_PATH(info.cFileName));
      elem = scheme_make_pair(n, scheme_null);
      if (last)
       SCHEME_CDR(last) = elem;
      else
       first = elem;
      last = elem;
    }
    counter++;
    if (break_ok && !(counter & 0x15)) {
      if (!hfile_ptr) {
       hfile_ptr = (FF_HANDLE_TYPE *)scheme_malloc_atomic(sizeof(FF_HANDLE_TYPE));
       *hfile_ptr = hfile;
      }
      BEGIN_ESCAPEABLE(do_find_close, hfile_ptr);
      scheme_thread_block(0);
      END_ESCAPEABLE();
      scheme_current_thread->ran_some = 1;
    }
  } while (FIND_NEXT(hfile, &info));
  
  FIND_CLOSE(hfile);

  return first;
# else
  
  dir = opendir(filename ? filename : ".");
  if (!dir) {
    if (!filename)
      return scheme_null;
    if (break_ok)
      scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                       "directory-list: could not open \"%q\" (%e)",
                       filename,
                       errno);
    return NULL;
  }
  
  while ((e = readdir(dir))) {
#  ifdef DIRENT_NO_NAMLEN
    nlen = strlen(e->d_name);
#  else
    nlen = e->d_namlen;
#  endif
#  if defined(UNIX_FILE_SYSTEM) || defined(DOS_FILE_SYSTEM)
    if (nlen == 1 && e->d_name[0] == '.')
      continue;
    if (nlen == 2 && e->d_name[0] == '.' && e->d_name[1] == '.')
      continue;
#  endif
    n = make_protected_sized_offset_path(1, e->d_name, 0, nlen, 1, 0, SCHEME_PLATFORM_PATH_KIND);
    elem = scheme_make_pair(n, scheme_null);
    if (last)
      SCHEME_CDR(last) = elem;
    else
      first = elem;
    last = elem;

    counter++;
    if (break_ok && !(counter & 0xF)) {
      BEGIN_ESCAPEABLE(closedir, dir);
      scheme_thread_block(0);
      END_ESCAPEABLE();
      scheme_current_thread->ran_some = 1;
    }
  }
  
  closedir(dir);

  return first;
# endif
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char* do_expand_filename ( Scheme_Object o,
char *  filename,
int  ilen,
const char *  errorin,
int expanded,
int  report_bad_user,
int  fullpath,
int  guards,
int  kind,
int  expand_user 
) [static]

Definition at line 1718 of file file.c.

{
  if (expanded)
    *expanded = 0;

  if (o) {
    o = TO_PATH(o);
    filename = SCHEME_PATH_VAL(o);
    ilen = SCHEME_PATH_LEN(o);
  }

  if (guards)
    scheme_security_check_file(errorin, filename, guards);

  if (ilen < 0)
    ilen = strlen(filename);
  else  {
    if (has_null(filename, ilen)) {
      if (errorin)
       raise_null_error(errorin, scheme_make_sized_path(filename, ilen, 1), "");
      else 
       return NULL;
    }
  }

  if (kind == SCHEME_UNIX_PATH_KIND) {
    /* User home lookup strategy taken from wxWindows: */

#ifdef UNIX_FILE_SYSTEM
    if (expand_user && (filename[0] == '~')) {
      char user[256], *home = NULL, *naya;
      struct passwd *who = NULL;
      int u, f, len, flen;
    
      for (u = 0, f = 1; 
           u < 255 && filename[f] && filename[f] != '/'; 
           u++, f++) {
        user[u] = filename[f];
      }

      if (filename[f] && filename[f] != '/') {
        if (errorin && report_bad_user)
          scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                           "%s: bad username in path: \"%q\"", 
                           errorin, filename);
        return NULL;
      }
      user[u] = 0;

      if (!user[0]) {
        if (!(home = getenv("HOME"))) {
          char *ptr;

          ptr = getenv("USER");
          if (!ptr)
            ptr = getenv("LOGNAME");

          who = ptr ? getpwnam(ptr) : NULL;

          if (!who)
            who = getpwuid(getuid());
        }
      } else
        who = getpwnam(user);

      if (!home && who)
        home = who->pw_dir;

      if (!home) {
        if (errorin && report_bad_user)
          scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                           "%s: bad username in path: \"%q\"", 
                           errorin, filename);
        return NULL;
      }

      len = strlen(home);
      if (f < ilen) 
        flen = ilen - f - 1;
      else
        flen = 0;
      naya = (char *)scheme_malloc_atomic(len + flen + 2);
      memcpy(naya, home, len);
      naya[len] = '/';
      memcpy(naya + len + 1, filename + f + 1, flen);
      naya[len + flen + 1] = 0;

      if (expanded)
        *expanded = 1;
  
      filename = naya;
      ilen = len + flen + 1;
    }
#endif

    /* Remove redundant slashes */
    {
      int l = ilen;
      filename = remove_redundant_slashes(filename, &l, 0, expanded, SCHEME_PLATFORM_PATH_KIND);
      ilen = l;
    }
  } else {
    /* SCHEME_WINDOWS_PATH_KIND */
    int drive_end, clean_start;
    int fixit = 0, i, insert_initial_sep = 0;

    if (!check_dos_slashslash_qm(filename, ilen, &drive_end, &clean_start, NULL))
      drive_end = 0;
    else if (drive_end < 0) {
      /* For \\?\REL\, only remove extra backslashes after 
        unprotected ..s, so count the start of that area
        as the drive end. */
      get_slashslash_qm_dot_ups_end(filename, ilen, &drive_end);
      /* Make sure that backslashes are doubled after dots. */
      if ((drive_end != ilen) && (filename[drive_end-2] != '\\')) {
       insert_initial_sep = 1;
       fixit = 1;
      }
    } else if (drive_end == 8) {
      /* For \\?\c:\\ path, start clean up after colon. */
      if (is_drive_letter(filename[4])
         && (filename[5] == ':'))
       drive_end = 6;
    } else if (drive_end == 9) {
      /* For \\?\\c:\\ path, start clean up after colon. */
      if ((filename[4] == '\\')
         && is_drive_letter(filename[5])
         && (filename[6] == ':'))
       drive_end = 7;
    } else {
      drive_end = clean_start;
    }

    /* Check whether to clean up the name, removing mulitple // and
       adding "/" after "c:" if necessary */
    if (!drive_end 
       && is_drive_letter(filename[0])
       && (filename[1] == ':') 
       && !IS_A_DOS_SEP(filename[2])) {
      drive_end = 2;
      insert_initial_sep = 1;
      fixit = 1;
    } else {
      int found_slash = 0, prim_only = drive_end;
      
      for (i = ilen; i-- > drive_end; ) {
       if (IS_A_DOS_X_SEP(prim_only, filename[i])) {
         if (IS_A_DOS_X_SEP(prim_only, filename[i - 1])) {
           if ((i > 1) || !found_slash)
             fixit = 1;
           break;
         }
         found_slash = 1;
       }
      }
    }

    if (fixit) {
      int pos, prim_only = drive_end;
      char *naya;
      
      if (expanded)
       *expanded = 1;
      
      if (!drive_end) {
       /* Allow // at start? */
       if (check_dos_slashslash_drive(filename, 0, ilen, NULL, 0, 0))
         drive_end = 2;
      }

      naya = (char *)scheme_malloc_atomic(ilen + 2);

      memcpy(naya, filename, drive_end);
      pos = i = drive_end;
      if (insert_initial_sep) {
       naya[pos++] = '\\';
      }
      
      while (i < ilen) {
       if (IS_A_DOS_X_SEP(prim_only, filename[i])
            && ((i + 1) < ilen)
           && IS_A_DOS_X_SEP(prim_only, filename[i + 1])) {
         i++;
       } else
         naya[pos++] = filename[i++];
      }
      
      naya[pos] = 0;
      filename = naya;
      ilen = pos;

      if (drive_end == 4) {
       /* If the root was \\?\, there's a chance that we removed a
          backslash and changed the root. In that case, add two \\s after \\?\: */
       check_dos_slashslash_qm(filename, ilen, &drive_end, NULL, NULL);
       if (drive_end != 4) {
         /* There's room to expand, because insert_initial_sep couldn't be -1. */
         if (filename[4] == '\\') {
           /* Need one more */
           memmove(filename + 5, filename + 4, ilen - 3);
           filename[4] = '\\'; /* Actually, this is redundant. */
           ilen += 1;
         } else {
           /* Need two more */
           memmove(filename + 6, filename + 4, ilen - 3);
           filename[4] = '\\'; /* Actually, this is redundant. */
           filename[5] = '\\';
           ilen += 2;
         }
       }
      }
    }
  }

  if (fullpath) {
    if (!scheme_is_complete_path(filename, ilen, kind)) {
      if (expanded)
       *expanded = 1;
      filename = do_path_to_complete_path(filename, ilen, NULL, 0, kind);
      ilen = strlen(filename);
    }
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      if (ilen > ((fullpath > 1) ? fullpath : 259)) {
        if (!check_dos_slashslash_qm(filename, ilen, NULL, NULL, NULL)) {
          /* Convert to \\?\ to avoid length limit. */
          int l = ilen, a = ilen + 1;
          Scheme_Object *p;

          p = scheme_make_sized_path(filename, ilen, 0);
          p = do_simplify_path(p, scheme_null, 0, 1, 0, SCHEME_WINDOWS_PATH_KIND);
          filename = SCHEME_PATH_VAL(p);
          ilen = SCHEME_PATH_LEN(p);

          filename = convert_to_backslashbackslash_qm(filename, &l, filename, &a, 0);
          filename[l] = 0;
        }
      }
    }
  }

  return filename;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char * do_normal_path_seps ( char *  si,
int _len,
int  delta,
int  strip_trail,
int  kind,
int _did 
) [static]

Definition at line 2535 of file file.c.

{
  if (kind == SCHEME_UNIX_PATH_KIND) {
    return si;
  } else {
    int i;
    unsigned char *s;
    int len = *_len;
    
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      if (!delta && check_dos_slashslash_qm(si, len, NULL, NULL, NULL))
        return si;
    }
    
    s = (unsigned char *)MALLOC_N_ATOMIC(char, len + 1);
    memcpy(s, si, len + 1);
    
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      for (i = delta; i < len; i++) {
        if (s[i] == '/') {
          if (_did)
            *_did = 1;
          s[i] = '\\';
        }
      }
      if (strip_trail)
        s = (unsigned char *)strip_trailing_spaces((char *)s, _len, delta, 1);
    }
    
    return (char *)s;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_path_element_to_bytes ( const char *  name,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 832 of file file.c.

{
  Scheme_Object *p = argv[0], *pe;
  int kind;

  if (!SCHEME_GENERAL_PATHP(p))
    scheme_wrong_type(name, "path", 0, argc, argv);
  
  pe = is_path_element(p);

  if (!pe)
    scheme_arg_mismatch(name,
                        "path can be split or is not relative: ",
                        p);

  if (SCHEME_SYMBOLP(pe)) {
    scheme_arg_mismatch(name,
                        (SAME_OBJ(pe, up_symbol)
                         ? "path is an up-directory indicator: "
                         : "path is a same-directory indicator: "),
                        p);
  }

  p = pe;

  kind = SCHEME_PATH_KIND(p);

  if (kind == SCHEME_UNIX_PATH_KIND) {
#ifdef TILDE_IS_ABSOLUTE
    /* Drop ./ of ./~ prefix */
    if ((SCHEME_PATH_VAL(p)[0] == '.')
        && (SCHEME_PATH_VAL(p)[1] == '/')
        && (SCHEME_PATH_VAL(p)[2] == '~')) {
      p = scheme_make_sized_offset_byte_string(SCHEME_PATH_VAL(p), 
                                               2, 
                                               SCHEME_PATH_LEN(p) - 2, 
                                               1);
    }
#endif
  }
  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    p = drop_rel_prefix(p);
  }

  return scheme_make_sized_byte_string(SCHEME_PATH_VAL(p),
                                   SCHEME_PATH_LEN(p),
                                   1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char * do_path_to_complete_path ( char *  filename,
long  ilen,
const char *  wrt,
long  wlen,
int  kind 
) [static]

Definition at line 3497 of file file.c.

{
  if (!scheme_is_complete_path(filename, ilen, kind)) {
    char *naya;
    int skip_sep = 0;

    if (!wrt) {
      Scheme_Object *wd;
      wd = CURRENT_WD();
      wrt = SCHEME_PATH_VAL(wd);
      wlen = SCHEME_PATH_LEN(wd);
      scheme_security_check_file("path->complete-path", NULL, SCHEME_GUARD_FILE_EXISTS);
    }

    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      if (!scheme_is_relative_path(filename, ilen, kind)) {
        /* Absolute, not complete. Fill in the disk */
        wrt = get_drive_part(wrt, wlen);
        wlen = strlen(wrt);
        /* drop trailing separator */
        if (IS_A_DOS_SEP(wrt[wlen - 1]) 
            && !check_dos_slashslash_qm(wrt, wlen, NULL, NULL, NULL)) {
          wlen--;
        }
        skip_sep = 1;
      }

      if (check_dos_slashslash_qm(wrt, wlen, NULL, NULL, NULL) /* wrt is never relative */
          || check_dos_slashslash_qm(filename, ilen, NULL, NULL, NULL)) { /* filename might be \\?\REL\ */
        /* For \\?\, give up on fast path and use build-path */
        Scheme_Object *a[2], *p;
        p = scheme_make_sized_offset_kind_path((char *)wrt, 0, wlen, 1, SCHEME_WINDOWS_PATH_KIND);
        a[0] = p;
        p = scheme_make_sized_offset_kind_path(filename, 0, ilen, 1, SCHEME_WINDOWS_PATH_KIND);
        a[1] = p;
        p = do_build_path(2, a, 0, 0, SCHEME_WINDOWS_PATH_KIND);
        return SCHEME_PATH_VAL(p);
      }
    }

    naya = (char *)scheme_malloc_atomic(ilen + wlen + 2);
    memcpy(naya, wrt, wlen);
    if (!skip_sep)
      if (!IS_A_SEP(kind, naya[wlen - 1]))
       naya[wlen++] = FN_SEP(kind);
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      int w = wlen;
      strip_trailing_spaces(naya, &w, 0, 1);
      wlen = w;
    }
    memcpy(naya + wlen, filename, ilen);
    naya[wlen + ilen] = 0;
    
    return naya;
  }

  return filename;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * do_path_to_directory_path ( char *  s,
long  offset,
long  len,
Scheme_Object p,
int  just_check,
int  kind 
) [static]

Definition at line 2431 of file file.c.

{
  char *s2;
  int not_a_sep = 0;

  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    int slash_dir_sep = 1;

    {
      int drive_end;

      if (offset) {
        scheme_signal_error("path->directory-path currently assumes a 0 offset");
      }

      if (check_dos_slashslash_qm(s, len, &drive_end, NULL, NULL)) {
#if DROP_REDUNDANT_SLASHES
        if (drive_end < 0) {
          /* It's a \\?\REL\ or \\?\RED\ path. */
          int litpos;
          drive_end = get_slashslash_qm_dot_ups_end(s, len, &litpos);
          /* If there's no path after the ..s, then nothing more is needed. */
          if (litpos >= len)
            return p;
        } else {
          /* If s is just a drive, then nothing more is needed. */
          if (drive_end == len)
            return p;
        }
#endif

        /* In \\?\, / can be part of a name, and it is never a separator. */
        slash_dir_sep = 0;
        /* Any "." or ".." at the end is a literal path element,
           not an up- or same-directory indicator: */
        not_a_sep = 1;
      } else {
#if DROP_REDUNDANT_SLASHES
        /* A slash after C: is not strictly necessary: */
        if ((len == 2)
            && is_drive_letter(s[offset])
            && (s[offset+1] == ':'))
          return p;
#endif
      }
    }
    {
      int cs = s[offset + len - 1];
      if (slash_dir_sep ? IS_A_DOS_SEP(cs) : (cs == '\\'))
        return p;
    }
  } else {
    if (IS_A_UNIX_SEP(s[offset + len - 1]))
      return p;
  }

#if DROP_REDUNDANT_SLASHES
  if (!not_a_sep
      && (((len > 1) && (s[offset + len - 1] == '.') && IS_A_SEP(kind, s[offset + len - 2]))
          || ((len == 1) && (s[offset] == '.'))))
    return p;
  if (!not_a_sep
      && (((len > 2) 
           && (s[offset + len - 1] == '.') 
           && (s[offset + len - 2] == '.') 
           && IS_A_SEP(kind, s[offset + len - 3]))
          || ((len == 2) && (s[offset] == '.') && (s[offset + 1] == '.'))))
    return p;
  
# ifdef TILDE_IS_ABSOLUTE
  if (kind == SCHEME_UNIX_PATH_KIND) {
    if (s[offset] == '~') {
      long i;
      for (i = 1; i < len; i++) {
        if (IS_A_UNIX_SEP(s[offset + i]))
          break;
      }
      if (i >= len)
        return p;
    }
  }
# endif
#endif

  if (just_check)
    return NULL;

  s2 = (char *)scheme_malloc_atomic(len + 2);
  memcpy(s2, s XFORM_OK_PLUS offset, len);
  s2[len] = FN_SEP(kind);
  s2[len+1] = 0;

  return scheme_make_sized_offset_kind_path(s2, 0, len + 1, 0, kind);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * do_simplify_path ( Scheme_Object path,
Scheme_Object cycle_check,
int  skip,
int  use_filesystem,
int  force_rel_up,
int  kind 
) [static]

Definition at line 4164 of file file.c.

{
  int isdir, cleaned_slashes = 0, must_be_dir = 0, last_was_dir = 0, did_first = 0;
  Scheme_Object *file = scheme_false, *base;

  /* cleanse-path doesn't touch the filesystem. Always start with
     that, to get things basically tidy. */
  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    char *s;
    int expanded, add_sep = 0;
    s = do_expand_filename(path, SCHEME_PATH_VAL(path), SCHEME_PATH_LEN(path),
                           NULL, &expanded, 0, 0, 0, kind, 0);
    {
      int slen;
      if (expanded)
        slen = strlen(s);
      else
        slen = SCHEME_PATH_LEN(path);
      s = do_normal_path_seps(s, &slen, 0, 0, SCHEME_WINDOWS_PATH_KIND, &expanded);
    }
    if (expanded) {
      path = scheme_make_sized_offset_kind_path(s, 0, -1, 0, SCHEME_WINDOWS_PATH_KIND);
    }
    if (!check_dos_slashslash_qm(SCHEME_PATH_VAL(path), SCHEME_PATH_LEN(path), NULL, NULL, &add_sep)) {
      int len = SCHEME_PATH_LEN(path);
      s = strip_trailing_spaces(SCHEME_PATH_VAL(path), &len, 0, 0);
      if (s != SCHEME_PATH_VAL(path))
        path = scheme_make_sized_offset_kind_path(s, 0, -1, 0, SCHEME_WINDOWS_PATH_KIND);
    } else if (add_sep) {
      int len = SCHEME_PATH_LEN(path);
      if ((add_sep < len) && (s[add_sep] != '\\')) {
        /* Add two \, as in \\?\c -> \\?\\\c */
        char *naya;
        naya = (char *)scheme_malloc_atomic(len + 3);
        memcpy(naya, s, add_sep);
        naya[add_sep] = '\\';
        naya[add_sep+1] = '\\';
        memcpy(naya + add_sep + 2, s + add_sep, len + 1 - add_sep);
        len += 2;
        path = scheme_make_sized_offset_kind_path(naya, 0, len, 0, SCHEME_WINDOWS_PATH_KIND);
      } else if (((add_sep + 1) < len) && (s[add_sep] == '\\') && (s[add_sep+1] != '\\')) {
        /* Add \, as in \\?\\c -> \\?\\\c */
        char *naya;
        naya = (char *)scheme_malloc_atomic(len + 2);
        memcpy(naya, s, add_sep);
        naya[add_sep] = '\\';
        memcpy(naya + add_sep + 1, s + add_sep, len + 1 - add_sep);
        len++;
        path = scheme_make_sized_offset_kind_path(naya, 0, len, 0, SCHEME_WINDOWS_PATH_KIND);
      }
    }
  }

  /* Fast check; avoids split operations, if possible.
     Also responsible for determing whether there's a
     redundant or missing trailing slash in the case that
     the path is just a root. */
  {
    char *s;
    int len, i, saw_dot = 0;
    s = SCHEME_PATH_VAL(path);
    len = SCHEME_PATH_LEN(path);

    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      if (!skip && check_dos_slashslash_qm(s, len, NULL, NULL, NULL)) {
        if (!force_rel_up) {
         int drive_end;
          path = simplify_qm_path(path);
         len = SCHEME_PATH_LEN(path);
         if (check_dos_slashslash_qm(SCHEME_PATH_VAL(path), len, &drive_end, NULL, NULL)) {
           /* If it's a drive... */
           if (drive_end == len) {
             /* Make it a directory path. */
             path = scheme_path_to_directory_path(path);
           }
         }
         return path;
        } else {
         /* force_rel_up means that we want a directory: */
          return scheme_path_to_directory_path(path);
       }
      }
      if (!skip && check_dos_slashslash_drive(s, 0, len, NULL, 1, 0)) {
        /* A UNC drive (with no further elements). 
          Remove extra trailing slashes, if any... */
        for (i = len; IS_A_DOS_SEP(s[i-1]); i--) { }
        if (i < len - 1) {
          path = scheme_make_sized_offset_kind_path(s, 0, i, 1, SCHEME_WINDOWS_PATH_KIND);
        }
       /* ... but make it a directory path. */
        path = scheme_path_to_directory_path(path);
      }

      if (skip) {
        while (s[skip] == '\\') {
          skip++;
        }
      }
    }

    i = skip;
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      if (!i && (len >= 2) && is_drive_letter(s[0]) && s[1] == ':') {
        i = 2;
      } else if (!i) {
        int drive_end;
        if (check_dos_slashslash_drive(s, 0, len, &drive_end, 0, 0)) {
          i = drive_end;
        }
      }
    }

    for (; i < len; i++) {
      if (s[i] == '.')
       saw_dot++;
      else if (IS_A_SEP(kind, s[i])) {
       if ((saw_dot == 1) || (saw_dot == 2))
         break;
        if ((i + 1 < len) && (IS_A_SEP(kind, s[i]))) {
          /* Double slash to clean up... */
          break;
        }
       saw_dot = 0;
      } else
       saw_dot = 3;
    }

    if (i == len) {
      if ((saw_dot != 1) && (saw_dot != 2)) {
        /* Still may need to add trailing separator if it's syntactically a directory. */
        if (path_is_simple_dir_without_sep(path))
          path = scheme_path_to_directory_path(path);
        return path;
      }
    }
    /* There's a ., .., or // in the path... */
  }

  /* Check whether it can be simplified: */
  if (!cleaned_slashes) {
    base = path;
    do {
      char *s;
      int len;
      s = SCHEME_PATH_VAL(base);
      len = SCHEME_PATH_LEN(base);
      if (len <= skip)
        break;
      file = do_split_path(s, len, &base, &isdir, &cleaned_slashes, kind);
      if (kind == SCHEME_WINDOWS_PATH_KIND) {
        if (force_rel_up) {
          file = convert_literal_relative(file);
        }
      }
      if (SCHEME_SYMBOLP(file) || cleaned_slashes)
        break;
    } while (SCHEME_GENERAL_PATHP(base));
  } else
    file = scheme_false;

  if (SCHEME_SYMBOLP(file) || cleaned_slashes) {
    /* It can be simplified: */
    char *s;
    int len;
    Scheme_Object *accum = scheme_null, *result;

    s = SCHEME_PATH_VAL(path);
    len = SCHEME_PATH_LEN(path);

    if (use_filesystem
       && !scheme_is_complete_path(s, len, kind)) {
      /* Make it absolute */
      s = scheme_expand_string_filename(path,
                                   "simplify-path", NULL,
                                   SCHEME_GUARD_FILE_EXISTS);
      len = strlen(s);
    }

    /* Check for cycles: */
    if (use_filesystem) {
      {
       Scheme_Object *l = cycle_check;
       while (!SCHEME_NULLP(l)) {
         Scheme_Object *p = SCHEME_CAR(l);
         if ((len == SCHEME_PATH_LEN(p))
             && !strcmp(s, SCHEME_PATH_VAL(p))) {
           /* Cycle of links detected */
           scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                          "simplify-path: cycle detected at link: \"%q\"",
                          s);
         }
         l = SCHEME_CDR(l);
       }
      }
    
      cycle_check = scheme_make_pair(scheme_make_sized_path(s, len, 0), 
                                 cycle_check);
    }

    /* Split the path into a list. */
    while (1) {
      if (len <= skip) {
       accum = scheme_make_pair(scheme_make_sized_offset_kind_path(s, 0, len, 0, kind), accum);
       break;
      }

      file = scheme_split_path(s, len, &base, &isdir, kind);
      if (kind == SCHEME_WINDOWS_PATH_KIND) {
        if (force_rel_up) {
          file = convert_literal_relative(file);
          if (SCHEME_SYMBOLP(file))
            isdir = 1;
        }
      }

      if (!did_first) {
        must_be_dir = isdir;
        did_first = 1;
      }

      if (SAME_OBJ(file, same_symbol)) {
       /* Drop it */
      } else
       accum = scheme_make_pair(file, accum);
      
      if (SCHEME_GENERAL_PATHP(base)) {
       s = SCHEME_PATH_VAL(base);
       len = SCHEME_PATH_LEN(base);
      } else {
       if (use_filesystem) {
         accum = scheme_make_pair(file, SCHEME_CDR(accum));
       }
       break;
      }
    }

    /* Now assemble the result */
    if (SCHEME_NULLP(accum)) {
      /* Only happens when !use_filesystem */
      result = scheme_false;
    } else {
      result = SCHEME_CAR(accum);
      if (SAME_OBJ(result, up_symbol)) {
       /* Only happens when !use_filesystem */
       result = scheme_false;
      } else
       accum = SCHEME_CDR(accum);
    }

    /* Build up path, watching for links just before a ..: */
    while (!SCHEME_NULLP(accum)) {
      if (SAME_OBJ(SCHEME_CAR(accum), up_symbol)) {
       if (use_filesystem) {
         /* Look for symlink in result-so-far. */
         Scheme_Object *new_result, *a[1];

         while (1) {
           a[0] = result;
           new_result = resolve_path(1, a);
       
           /* Was it a link? */
           if (result != new_result) {
             /* It was a link. Is the new result relative? */
             if (!scheme_is_complete_path(SCHEME_PATH_VAL(new_result),
                                      SCHEME_PATH_LEN(new_result),
                                           kind)) {
              Scheme_Object *aa[2], *result_base;
              /* Yes - resolve it relative to result's base: */
              scheme_split_path(SCHEME_PATH_VAL(result),
                              SCHEME_PATH_LEN(result),
                              &result_base,
                              &isdir,
                                  kind);
              aa[0] = result_base;
              aa[1] = new_result;
              new_result = do_build_path(2, aa, 0, 0, SCHEME_PLATFORM_PATH_KIND);
             }
           
             /* Simplify the new result */
             result = do_simplify_path(new_result, cycle_check, skip, 
                                   use_filesystem, force_rel_up, kind);
             cycle_check = scheme_make_pair(new_result, cycle_check);
           } else
             break;
         }
       }
       
       /* Do one 'up: */
       {
         accum = SCHEME_CDR(accum);
         if (SCHEME_FALSEP(result)) {
           /* Empty relative path so far */
           if (skip) /* => input was a \\?\ path, and it must be relative */
             result = scheme_make_sized_offset_kind_path("\\\\?\\REL\\..", 0, 10, 0, SCHEME_WINDOWS_PATH_KIND);
           else
             result = scheme_make_sized_offset_kind_path("..", 0, 2, 0, kind);
         } else {
           Scheme_Object *next, *to_go;
           to_go = scheme_split_path(SCHEME_PATH_VAL(result),
                                  SCHEME_PATH_LEN(result),
                                  &next,
                                  &isdir,
                                      kind);
           if (SAME_OBJ(to_go, up_symbol)) {
             /* We're building a sequence of ups... */
             Scheme_Object *a[2];
             a[0] = result;
             a[1] = up_symbol;
             result = do_build_path(2, a, 0, 1, kind);
#ifdef TILDE_IS_ABSOLUTE
           } else if ((kind == SCHEME_UNIX_PATH_KIND)
                       && SCHEME_FALSEP(next)
                       && SCHEME_GENERAL_PATHP(to_go)
                       && SCHEME_PATH_VAL(to_go)[0] == '~') {
             /* Can't delete a leading ~ for .. */
             Scheme_Object *a[2];
             a[0] = result;
             a[1] = up_symbol;
             result = do_build_path(2, a, 0, 1, kind);
#endif
           } else if (!SCHEME_GENERAL_PATH_STRINGP(next)) {
             if (SCHEME_FALSEP(next)) {
              /* Result is already a root, so we just drop the .. */
             } else {
              /* Result is empty relative path */
              result = scheme_false;
             }
           } else
             result = next;
         }
       }

        last_was_dir = 1;
      } else {
       /* Add path element onto the result: */
       if (SCHEME_FALSEP(result))
         result = SCHEME_CAR(accum);
       else {
         Scheme_Object *a[2];
         a[0] = result;
         a[1] = SCHEME_CAR(accum);
         result = do_build_path(2, a, 0, 0, kind);
       }
       accum = SCHEME_CDR(accum);
        last_was_dir = 0;
      }
    }

    if ((must_be_dir || last_was_dir) && !SCHEME_FALSEP(result)) {
      result = scheme_path_to_directory_path(result);
    }

    return result;
  } else
    return path;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_split_path ( const char *  path,
int  len,
Scheme_Object **  base_out,
int id_out,
int cleaned_slashes,
int  kind 
) [static]

Definition at line 3132 of file file.c.

{
  char *s;
  int p, last_was_sep = 0, is_dir, no_up = 0, not_same;
  Scheme_Object *file;
  int allow_double_before = 0, drive_end, no_slash_sep = 0;

#define MAKE_SPLIT(x, y, z) (*base_out = x, *id_out = z, y)

  s = (char *)path;

  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    if ((len > 2) && IS_A_DOS_SEP(s[0]) && IS_A_DOS_SEP(s[1])) {
      if (check_dos_slashslash_qm(s, len, &drive_end, NULL, NULL)) {
        allow_double_before = drive_end;
        no_slash_sep = 1;
        if (drive_end < 0) {
          /* \\?\REL\ or \\?\RED\ path. Handle it directly as a special case. */
          int p, lit_start, dots_end;
          is_dir = 0;
          if (s[len - 1] == '\\') {
            --len;
            is_dir = 1;
          }
          dots_end = get_slashslash_qm_dot_ups_end(s, len, &lit_start);
          if (lit_start < len) {
            /* There's at least one literal path. */
            for (p = len; --p >= ((dots_end > 0) ? lit_start - 1 : lit_start); ) {
              if (s[p] == '\\') {
                /* Prefix path element with \\?\REL\\: */
                {
                  int len2, nsep;
                  char *s2;
                  Scheme_Object *dir;
                  len2 = len - p - 1 + 9;
                  s2 = scheme_malloc_atomic(len2 + 1);
                  memcpy(s2, "\\\\?\\REL\\\\", 9);
                  memcpy(s2 + 9, s + p + 1, len - p - 1);
                  s2[len2] = 0;
                  if ((dots_end == p) || (dots_end == p - 1)) {
                    /* stripping the only element: drop reundant separator(s) after .. */
                    nsep = ((dots_end == p) ? 0 : -1);
                  } else {
                    if (s[6] == 'L') {
                      /* preserve separator */
                      nsep = 1;
                    } else {
                      /* preserve one separator, but not two */
                      if (s[p - 1] == '\\')
                        nsep = 0;
                      else
                        nsep = 1;
                    }
                  }
                  dir = scheme_make_sized_offset_kind_path(s, 0, p + nsep, 1, SCHEME_WINDOWS_PATH_KIND);
                  file = scheme_make_sized_offset_kind_path(s2, 0, len2, 0, SCHEME_WINDOWS_PATH_KIND);
                  return MAKE_SPLIT(dir, file, is_dir);
                }
              }
            }
          }
          /* Either no literal path elements, or only one element and no dots */
          if (dots_end > 0) {
            /* There are dots (so no literals) */
            if (dots_end - 3 > 8) {
              file = scheme_make_sized_offset_kind_path(s, 0, dots_end - 3, 1, SCHEME_WINDOWS_PATH_KIND);
              return MAKE_SPLIT(file, up_symbol, 1);
            } else
              return MAKE_SPLIT(relative_symbol, up_symbol, 1);
          } else {
            /* No dots, so there must be one element. */
            if (s[6] == 'L') {
              /* keep \\?\REL\ on path, and report 'relative as base */
              return MAKE_SPLIT(relative_symbol, 
                                scheme_make_sized_offset_kind_path(s, 0, len, 1,
                                                                   SCHEME_WINDOWS_PATH_KIND), 
                                is_dir);
            } else {
              /* Switch "D" to "L", and simplify base to just "\\" */
              char *naya;
              Scheme_Object *dir;
              naya = (char *)scheme_malloc_atomic(len + 2);
              memcpy(naya, s, len + 2);
              naya[6] = 'L';
              if (naya[8] != '\\') {
                /* Make sure REL is followed by \\, just in case the element is
                   ".." (i.e., we had \\?\RED\..). */
                memmove(naya + 9, naya + 8, len + 1 - 8);
                naya[8] = '\\';
                len++;
              }
              dir = scheme_make_sized_offset_kind_path("\\", 0, 1, 0,
                                                       SCHEME_WINDOWS_PATH_KIND);
              return MAKE_SPLIT(dir, 
                                scheme_make_sized_offset_kind_path(naya, 0, len, 0,
                                                                   SCHEME_WINDOWS_PATH_KIND), 
                                is_dir);
            }
          }
        } else {
          no_up = 1;
          if ((drive_end < len) && s[drive_end] == '\\') {
            /* Happens with \\?\c:\\, for example. */
            drive_end++;
          }
        }
      } else if (check_dos_slashslash_drive(s, 0, len, &drive_end, 0, 0)) {
        allow_double_before = 1;
        if ((drive_end < len) && IS_A_DOS_SEP(s[drive_end]))
          drive_end++;
      } else
        drive_end = 0;
    } else if ((len > 1) && is_drive_letter(s[0]) && (s[1] == ':')) {
      drive_end = 2;
      if ((drive_end < len) && IS_A_DOS_SEP(s[drive_end]))
        drive_end++;
    } else
      drive_end = 0;
  } else {
    drive_end = 0;
  }

  /* Look for confusing repeated separators (e.g. "x//y") */
  for (p = len; p--; ) {
    if (p > allow_double_before) {
      if (IS_A_SEP(kind, s[p]) && IS_A_SEP(kind, s[p - 1])) {
       /* Found it; copy without repeats */
       int q;
       char *old = s;

        if (cleaned_slashes)
          *cleaned_slashes = 1;

       s = (char *)scheme_malloc_atomic(len);
       --len;

       for (p = 0, q = 0; p < allow_double_before; p++) {
         s[q++] = old[p];
       }

       for (; p < len; p++) {
         if (!IS_A_SEP(kind, old[p]) || !IS_A_SEP(kind, old[p + 1]))
           s[q++] = old[p];
       }
       s[q++] = old[len];
       len = q;
       break;
      }
    }
  }

# define IS_A_SPLIT_SEP(x) (((kind == SCHEME_WINDOWS_PATH_KIND) && no_slash_sep) ? (x == '\\') : IS_A_SEP(kind, x))

  if ((kind == SCHEME_WINDOWS_PATH_KIND) && (len <= drive_end))
    p = -1;
  else {
    for (p = len; p--; ) {
      if (IS_A_SPLIT_SEP(s[p])) {
        if (p != len - 1)
          break;
        else
          last_was_sep = 1;
      }
      if (kind == SCHEME_WINDOWS_PATH_KIND) {
       if (p < drive_end)
         break;
      }
    }
  }
  
  if (kind == SCHEME_UNIX_PATH_KIND) {
#ifdef TILDE_IS_ABSOLUTE
    /* "./~..." can't be split at the beginning. */
    if ((p == 1)
        && s[0] == '.'
        && s[p + 1] == '~') {
      not_same = 1;
      p -= 2;
    } else
#endif
      not_same = 0;
  } else
    not_same = 0;

  if (p < 0) {
    Scheme_Object *dir;

    /* No splitting available. 
       For Unx & DOS, it was relative or exactly root.
       For Mac, it is relative or root with trailing sep. */
    if (kind == SCHEME_UNIX_PATH_KIND) {
      if (s[0] == '/')
        return MAKE_SPLIT(scheme_false, scheme_make_sized_offset_kind_path(s, 0, len, 1, kind), 1);
#ifdef TILDE_IS_ABSOLUTE
      if (s[0] == '~') {
        /* Strip ending slashes, if any. */
        while (IS_A_UNIX_SEP(s[len - 1])) {
          --len;
        }
        return MAKE_SPLIT(scheme_false, scheme_make_sized_offset_kind_path(s, 0, len, 1, kind), 1);
      }
#endif
    } else {
      if (IS_A_DOS_SEP(s[0]) || drive_end)
        return MAKE_SPLIT(scheme_false, scheme_make_sized_offset_kind_path(s, 0, len, 1, kind), 1);
    }

    dir = relative_symbol;

    /* Check for 'up: */
    if (!no_up && (s[0] == '.') && (s[1] == '.')
       && (2 >= len || IS_A_SEP(kind, s[2]))) {
      file = up_symbol;
      is_dir = 1;
    } else if (!no_up && !not_same && (s[0] == '.') && (1 >= len || IS_A_SEP(kind, s[1]))) {
      file = same_symbol;
      is_dir = 1;
    } else {
      int delta;
      is_dir = last_was_sep;
      delta = 0;
      file = make_protected_sized_offset_path(no_up || is_dir, 
                                         s, 0, len - last_was_sep + delta, 1, 0,
                                              kind);
    }
    
    return MAKE_SPLIT(dir, file, is_dir);
  }
  
  /* Check for 'up and 'same: */
  if (!no_up && (s[p + 1] == '.') && (s[p + 2] == '.')
      && (p + 3 >= len || IS_A_SEP(kind, s[p + 3]))) {
    file = up_symbol;
    is_dir = 1;
  } else if (!no_up && (s[p + 1] == '.') && (p + 2 >= len || IS_A_SEP(kind, s[p + 2]))) {
    file = same_symbol;
    is_dir = 1;
  } else {
    int protected;
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      protected = no_up || last_was_sep;
    } else  {
      protected = 1;
    }
    file = make_protected_sized_offset_path(protected,
                                       s,
                                       p + 1, 
                                       len - p - last_was_sep - 1, 
                                       1, 0, kind);
    is_dir = last_was_sep;
  }
  
  /* Check directory */
  if (p > 0) {
    Scheme_Object *ss;
    ss = make_exposed_sized_offset_path(no_up, s, 0, p + 1, 1, kind);
    return MAKE_SPLIT(ss, 
                    file, 
                    is_dir);
  }
       
  /* p = 0; this means root dir. */
  {
    Scheme_Object *ss;
    ss = scheme_make_sized_offset_kind_path(s, 0, 1, 1, kind);
    return MAKE_SPLIT(ss, file, is_dir);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* drop_rel_prefix ( Scheme_Object p) [static]

Definition at line 760 of file file.c.

{
  int drive_end;
  if (check_dos_slashslash_qm(SCHEME_PATH_VAL(p),
                              SCHEME_PATH_LEN(p),
                              &drive_end, NULL, NULL)) {
    if (drive_end < 0) {
      /* \\?\REL\ */
      int delta;
      if (SCHEME_PATH_VAL(p)[8] == '\\')
        delta = 9;
      else
        delta = 8;
      p = scheme_make_sized_offset_kind_path(SCHEME_BYTE_STR_VAL(p),
                                             delta,
                                             SCHEME_BYTE_STRLEN_VAL(p) - delta,
                                             1,
                                             SCHEME_WINDOWS_PATH_KIND);
    }
  }

  return p;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * expand_user_path ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4603 of file file.c.

{
  char *filename;
  int expanded;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("expand-user-path", SCHEME_PATH_STRING_STR, 0, argc, argv);

  filename = do_expand_filename(argv[0],
                            NULL,
                            0,
                            "expand-user-path",
                            &expanded,
                            1, 0,
                            SCHEME_GUARD_FILE_EXISTS, 
                                SCHEME_PLATFORM_PATH_KIND,
                                1);

  if (!expanded && SCHEME_PATHP(argv[0]))
    return argv[0];
  else
    return scheme_make_sized_path(filename, strlen(filename), 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* explode_path ( Scheme_Object p) [static]

Definition at line 4924 of file file.c.

{
  Scheme_Object *l = scheme_null, *base, *name;
  int isdir;

  while (1) {
    name = scheme_split_path(SCHEME_PATH_VAL(p), SCHEME_PATH_LEN(p), &base, &isdir, SCHEME_PATH_KIND(p));
    l = scheme_make_pair(name, l);

    if (!SCHEME_PATHP(base)) {
      l = scheme_make_pair(base, l);
      return l;
    }
    p = base;
  }
}

Here is the caller graph for this function:

static int extract_path_kind ( const char *  who,
int  which,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 914 of file file.c.

{
  if (which >= argc)
    return SCHEME_PLATFORM_PATH_KIND;
  
  if (SAME_OBJ(argv[which], windows_symbol))
    return SCHEME_WINDOWS_PATH_KIND;
  if (SAME_OBJ(argv[which], unix_symbol))
    return SCHEME_UNIX_PATH_KIND;

  scheme_wrong_type(who, "'unix or 'windows", which, argc, argv);
  return 0;
}

Here is the caller graph for this function:

static Scheme_Object * file_exists ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 2220 of file file.c.

{
  char *f;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("file-exists?", SCHEME_PATH_STRING_STR, 0, argc, argv);

  f = do_expand_filename(argv[0],
                      NULL,
                      0,
                      "file-exists?",
                      NULL,
                      0, 1,
                      SCHEME_GUARD_FILE_EXISTS,
                         SCHEME_PLATFORM_PATH_KIND,
                         0);

  return (f && scheme_file_exists(f)) ? scheme_true : scheme_false;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* file_modify_seconds ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* file_modify_seconds ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 5168 of file file.c.

{
  char *file;
  int set_time = 0;
  UNBUNDLE_TIME_TYPE mtime;
  struct MSC_IZE(stat) buf;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("file-or-directory-modify-seconds", SCHEME_PATH_STRING_STR, 0, argc, argv);

  set_time = ((argc > 1) && SCHEME_TRUEP(argv[1]));

  file = scheme_expand_string_filename(argv[0],
                                   "file-or-directory-modify-seconds",
                                   NULL,
                                   (set_time
                                   ? SCHEME_GUARD_FILE_WRITE
                                   : SCHEME_GUARD_FILE_READ));
  
  if (set_time) {
    if (!SCHEME_INTP(argv[1]) && !SCHEME_BIGNUMP(argv[1])) {
      scheme_wrong_type("file-or-directory-modify-seconds", "exact integer or #f", 1, argc, argv);
      return NULL;
    }
    if (!scheme_get_time_val(argv[1], &mtime)) {
      scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                     "file-or-directory-modify-seconds: integer %s is out-of-range",
                     scheme_make_provided_string(argv[1], 0, NULL));
      return NULL;
    }
  } else
    mtime = 0;

  if (argc > 2) {
    scheme_check_proc_arity("file-or-directory-modify-seconds", 0, 2, argc, argv);
  }

# ifdef DOS_FILE_SYSTEM
  if (!set_time) {
    int len = strlen(file);
    Scheme_Object *secs;

    if (UNC_stat(file, len, NULL, NULL, &secs, NULL))
      return secs;
  } else 
# endif
    {
      while (1) {
       if (set_time) {
         struct MSC_IZE(utimbuf) ut;
         ut.actime = mtime;
         ut.modtime = mtime;
         if (!MSC_W_IZE(utime)(MSC_WIDE_PATH(file), &ut))
           return scheme_void;
       } else {
         if (!MSC_W_IZE(stat)(MSC_WIDE_PATH(file), &buf))
           return scheme_make_integer_value_from_time(buf.st_mtime);
       }
       if (errno != EINTR)
         break;
      }
    }

  if (argc > 2) {
    return _scheme_tail_apply(argv[2], 0, NULL);
  }

  scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                 "file-or-directory-modify-seconds: error %s file/directory time: %q (%e)",
                 set_time ? "setting" : "getting",
                 filename_for_error(argv[0]),
                 errno);
  return NULL;
}

Here is the call graph for this function:

static Scheme_Object * file_or_dir_permissions ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5292 of file file.c.

{
  Scheme_Object *l = scheme_null;
  char *filename;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("file-or-directory-permissions", SCHEME_PATH_STRING_STR, 0, argc, argv);

  filename = scheme_expand_string_filename(argv[0],
                                      "file-or-directory-permissions",
                                      NULL,
                                      SCHEME_GUARD_FILE_READ);

# ifdef NO_STAT_PROC
  return scheme_null;
# else
#  ifdef UNIX_FILE_SYSTEM
  /* General strategy for permissions (to deal with setuid)
     taken from euidaccess() in coreutils... */
#   ifndef NO_UNIX_USERS
  if (have_user_ids == 0) {
    have_user_ids = 1;
    uid = getuid();
    gid = getgid();
    euid = geteuid();
    egid = getegid();
  }

  if ((uid == euid) && (gid == egid)) {
    /* Not setuid; use access() */
    int read, write, execute, ok;
    
    do {
      ok = access(filename, R_OK);
    } while ((ok == -1) && (errno == EINTR));
    read = !ok;

    if (ok && (errno != EACCES))
      l = NULL;
    else {
      do {
       ok = access(filename, W_OK);
      } while ((ok == -1) && (errno == EINTR));
      write = !ok;
      
      if (ok && (errno != EACCES))
       l = NULL;
      else {
       do {
         ok = access(filename, X_OK);
       } while ((ok == -1) && (errno == EINTR));
       execute = !ok;
      
        /* Don't fail at the exec step if the user is the
           superuser and errno is EPERM; under Mac OS X,
           at least, such a failure simply means tha the
           file is not executable. */
       if (ok && (errno != EACCES) 
            && (uid || gid || (errno != EPERM))) {
         l = NULL;
       } else {
         if (read)
           l = scheme_make_pair(read_symbol, l);
         if (write)
           l = scheme_make_pair(write_symbol, l);
         if (execute)
           l = scheme_make_pair(execute_symbol, l);
       }
      }
    }
  } else 
#  endif
    {
      /* Use stat, because setuid, or because or no user info available */
      struct stat buf;
      int read, write, execute;

      if (stat(filename, &buf))
       l = NULL;
      else {
#   ifndef NO_UNIX_USERS
       if (euid == 0) {
         /* Super-user can read/write anything, and can
            execute anything that someone can execute */
         read = 1;
         write = 1;
         execute = !!(buf.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH));
       } else if (buf.st_uid == euid) {
         read = !!(buf.st_mode & S_IRUSR);
         write = !!(buf.st_mode & S_IWUSR);
         execute = !!(buf.st_mode & S_IXUSR);
       } else if ((egid == buf.st_gid) || user_in_group(euid, buf.st_gid)) {
         read = !!(buf.st_mode & S_IRGRP);
         write = !!(buf.st_mode & S_IWGRP);
         execute = !!(buf.st_mode & S_IXGRP);
       } else {
         read = !!(buf.st_mode & S_IROTH);
         write = !!(buf.st_mode & S_IWOTH);
         execute = !!(buf.st_mode & S_IXOTH);
       }
#   else
       read = !!(buf.st_mode & (S_IRUSR | S_IRGRP | S_IROTH));
       write = !!(buf.st_mode & (S_IWUSR | S_IWGRP | S_IWOTH));
       execute = !!(buf.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH));
#   endif
       
       if (read)
         l = scheme_make_pair(read_symbol, l);
       if (write)
         l = scheme_make_pair(write_symbol, l);
       if (execute)
         l = scheme_make_pair(execute_symbol, l);
      }
    }
#  endif  
#  ifdef DOS_FILE_SYSTEM
  {
    int len = strlen(filename);
    int flags;
    
    if (UNC_stat(filename, len, &flags, NULL, NULL, NULL)) {
      if (flags & MZ_UNC_READ)
       l = scheme_make_pair(read_symbol, l);
      if (flags & MZ_UNC_WRITE)
       l = scheme_make_pair(write_symbol, l);
      if (flags & MZ_UNC_EXEC)
       l = scheme_make_pair(execute_symbol, l);
    } else
      l = NULL;
  }
#  endif
# endif
  
  if (!l) {
    scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                   "file-or-directory-permissions: file or directory not found: \"%q\"",
                   filename_for_error(argv[0]));
  }

  return l;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * file_size ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5434 of file file.c.

{
  char *filename;
  mzlonglong len = 0;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("file-size", SCHEME_PATH_STRING_STR, 0, argc, argv);

  filename = scheme_expand_string_filename(argv[0],
                                      "file-size",
                                      NULL,
                                      SCHEME_GUARD_FILE_READ);

#ifdef DOS_FILE_SYSTEM
 {
   if (UNC_stat(filename, strlen(filename), NULL, NULL, NULL, &len)) {
     return scheme_make_integer_value_from_long_long(len);
   }
 }
#else
  {
    struct BIG_OFF_T_IZE(stat) buf;

    while (1) {
      if (!BIG_OFF_T_IZE(stat)(MSC_WIDE_PATH(filename), &buf))
       break;
      else if (errno != EINTR)
       goto failed;
    }

    if (S_ISDIR(buf.st_mode))
      goto failed;

    len = buf.st_size;
  }

  return scheme_make_integer_value_from_long_long(len);

 failed:
#endif

  scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                 "file-size: file not found: \"%q\"",
                 filename_for_error(argv[0]));
  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char* filename_for_error ( Scheme_Object p) [static]

Definition at line 3631 of file file.c.

{
  return do_expand_filename(p, NULL, 0,
                         NULL,
                         NULL,
                         1, 1,
                         0, SCHEME_PLATFORM_PATH_KIND,
                            0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * filesystem_root_list ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4978 of file file.c.

{
  Scheme_Object *first = scheme_null;
#if defined(DOS_FILE_SYSTEM)
  Scheme_Object *last = NULL, *v;
#endif

  scheme_security_check_file("filesystem-root-list", NULL, SCHEME_GUARD_FILE_EXISTS);

#ifdef UNIX_FILE_SYSTEM 
  first = scheme_make_pair(scheme_make_path("/"), scheme_null);
#endif
#ifdef DOS_FILE_SYSTEM
  {
#   define DRIVE_BUF_SIZE 1024
    char drives[DRIVE_BUF_SIZE], *s;
    long len, ds;
    UINT oldmode;

    len = GetLogicalDriveStrings(DRIVE_BUF_SIZE, drives);
    if (len <= DRIVE_BUF_SIZE)
      s = drives;
    else {
      s = scheme_malloc_atomic(len + 1);
      GetLogicalDriveStrings(len + 1, s);
    }

    ds = 0;
    oldmode = SetErrorMode(SEM_FAILCRITICALERRORS);      
    while (s[ds]) {
      DWORD a, b, c, d;
      /* GetDiskFreeSpace effectively checks whether we can read the disk: */
      if (GetDiskFreeSpace(s XFORM_OK_PLUS ds, &a, &b, &c, &d)) {
       v = scheme_make_pair(scheme_make_sized_offset_path(s, ds, -1, 1), scheme_null);
       if (last)
         SCHEME_CDR(last) = v;
       else
         first = v;
       last = v;
      }
      ds += strlen(s XFORM_OK_PLUS ds) + 1;
    }
    SetErrorMode(oldmode);
  }
#endif

  return first;
}

Here is the caller graph for this function:

static Scheme_Object * find_system_path ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 5641 of file file.c.

{
  int which;

  if (argv[0] == temp_dir_symbol)
    which = id_temp_dir;
  else if (argv[0] == home_dir_symbol)
    which = id_home_dir;
  else if (argv[0] == doc_dir_symbol)
    which = id_doc_dir;
  else if (argv[0] == desk_dir_symbol)
    which = id_desk_dir;
  else if (argv[0] == pref_dir_symbol)
    which = id_pref_dir;
  else if (argv[0] == init_dir_symbol)
    which = id_init_dir;
  else if (argv[0] == pref_file_symbol)
    which = id_pref_file;
  else if (argv[0] == init_file_symbol)
    which = id_init_file;
  else if (argv[0] == sys_dir_symbol)
    which = id_sys_dir;
  else if (argv[0] == exec_file_symbol) {
    if (!exec_cmd) {
      REGISTER_SO(exec_cmd);
      exec_cmd = scheme_make_path("mzscheme");
    }
    return exec_cmd;
  } else if (argv[0] == run_file_symbol) {
    return scheme_get_run_cmd();
  } else if (argv[0] == collects_dir_symbol) {
    if (!collects_path) {
      REGISTER_SO(collects_path);
      collects_path = scheme_make_path("collects");
    }
    return collects_path;
  } else if (argv[0] == orig_dir_symbol) {
    return original_pwd;
  } else if (argv[0] == addon_dir_symbol) {
    which = id_addon_dir;
  } else {
    scheme_wrong_type("find-system-path", "system-path-symbol",
                    0, argc, argv);
    return NULL;
  }

  scheme_security_check_file("find-system-path", NULL, SCHEME_GUARD_FILE_EXISTS);

#ifdef UNIX_FILE_SYSTEM
  if (which == id_sys_dir) {
    return scheme_make_path("/");
  }

  if (which == id_temp_dir) {
    char *p;
    
    if ((p = getenv("TMPDIR"))) {
      p = scheme_expand_filename(p, -1, NULL, NULL, 0);
      if (p && scheme_directory_exists(p))
       return scheme_make_path(p);
    }

    if (scheme_directory_exists("/var/tmp"))
      return scheme_make_path("/var/tmp");

    if (scheme_directory_exists("/usr/tmp"))
      return scheme_make_path("/usr/tmp");

    if (scheme_directory_exists("/tmp"))
      return scheme_make_path("/tmp");

    return CURRENT_WD();
  }
  
  {
    /* Everything else is in ~: */
    Scheme_Object *home;
    char *home_str, *ex_home;
    int ends_in_slash;

    if ((which == id_pref_dir) 
       || (which == id_pref_file)
       || (which == id_addon_dir)) {
#if defined(OS_X) && !defined(XONX)
      if (which == id_addon_dir)
       home_str = "~/Library/PLT Scheme/";
      else
       home_str = "~/Library/Preferences/";
#else
      home_str = "~/.plt-scheme/";
#endif 
    } else {
#if defined(OS_X) && !defined(XONX)
      if (which == id_desk_dir)
       home_str = "~/Desktop/";
      else if (which == id_doc_dir)
       home_str = "~/Documents/";
      else
#endif
        home_str = "~/";
    }
    
    ex_home = do_expand_filename(NULL, home_str, strlen(home_str), NULL,
                                 NULL,
                                 0, 1,
                                 0, SCHEME_UNIX_PATH_KIND, 
                                 1);

    if (!ex_home) {
      /* Something went wrong with the user lookup. Just drop "~'. */
      home = scheme_make_sized_offset_path(home_str, 1, -1, 1);
    } else
      home = scheme_make_path(ex_home);

    
    if ((which == id_pref_dir) || (which == id_init_dir) 
       || (which == id_home_dir) || (which == id_addon_dir)
       || (which == id_desk_dir) || (which == id_doc_dir))
      return home;

    ends_in_slash = (SCHEME_PATH_VAL(home))[SCHEME_PATH_LEN(home) - 1] == '/';
    
    if (which == id_init_file)
      return append_path(home, scheme_make_path("/.mzschemerc" + ends_in_slash));
    if (which == id_pref_file) {
#if defined(OS_X) && !defined(XONX)
      return append_path(home, scheme_make_path("/org.plt-scheme.prefs.ss" + ends_in_slash));
#else      
      return append_path(home, scheme_make_path("/plt-prefs.ss" + ends_in_slash));
#endif
    }
  }
#endif

#ifdef DOS_FILE_SYSTEM
  if (which == id_sys_dir) {
    int size;
    wchar_t *s;
    size = GetSystemDirectoryW(NULL, 0);
    s = (wchar_t *)scheme_malloc_atomic((size + 1) * sizeof(wchar_t));
    GetSystemDirectoryW(s, size + 1);
    return scheme_make_path(NARROW_PATH(s));
  }

  {
    char *d, *p;
    Scheme_Object *home;
    int ends_in_slash;
    
    if (which == id_temp_dir) {
      if ((p = getenv("TMP")) || (p = getenv("TEMP"))) {
       p = scheme_expand_filename(p, -1, NULL, NULL, 0);
       if (p && scheme_directory_exists(p))
         return scheme_make_path(p);
      }
      
      return CURRENT_WD();
    }

    home = NULL;

    {
      /* Try to get Application Data directory: */
      LPITEMIDLIST items;
      int which_folder;

      if ((which == id_addon_dir)
         || (which == id_pref_dir)
         || (which == id_pref_file)) 
       which_folder = CSIDL_APPDATA;
      else if (which == id_doc_dir) {
#       ifndef CSIDL_PERSONAL
#         define CSIDL_PERSONAL 0x0005
#       endif
       which_folder = CSIDL_PERSONAL;
      } else if (which == id_desk_dir)    
       which_folder = CSIDL_DESKTOPDIRECTORY;
      else {
#       ifndef CSIDL_PROFILE
#         define CSIDL_PROFILE 0x0028
#       endif
       which_folder = CSIDL_PROFILE;
      }

      if (SHGetSpecialFolderLocation(NULL, which_folder, &items) == S_OK) {
       int ok;
       IMalloc *mi;
       wchar_t *buf;

       buf = (wchar_t *)scheme_malloc_atomic(MAX_PATH * sizeof(wchar_t));
       ok = SHGetPathFromIDListW(items, buf);

       SHGetMalloc(&mi);
       mi->lpVtbl->Free(mi, items);
       mi->lpVtbl->Release(mi);

       if (ok) {
         home = scheme_make_path_without_copying(NARROW_PATH(buf));
       }
      }
    }

    if (!home) {
      /* Back-up: try USERPROFILE environment variable */
      d = getenv("USERPROFILE");
      if (d) {
       if (scheme_directory_exists(d))
         home = scheme_make_path_without_copying(d);
      }
    }

    if (!home) {
    /* Last-ditch effort: try HOMEDRIVE+HOMEPATH */
      d = getenv("HOMEDRIVE");
      p = getenv("HOMEPATH");

      if (d && p) {
       char *s;
       s = scheme_malloc_atomic(strlen(d) + strlen(p) + 1);
       strcpy(s, d);
       strcat(s, p);
      
       if (scheme_directory_exists(s))
         home = scheme_make_path_without_copying(s);
       else
         home = NULL;
      } else 
       home = NULL;
    
      if (!home) {
       wchar_t name[1024];
      
       if (!GetModuleFileNameW(NULL, name, 1024)) {
         /* Disaster. Use CWD. */
         home = CURRENT_WD();
       } else {
         int i;
         wchar_t *s;
       
         s = name;
       
         i = wc_strlen(s) - 1;
       
         while (i && (s[i] != '\\')) {
           --i;
         }
         s[i] = 0;
         home = scheme_make_path(NARROW_PATH(s));
       }
      }
    }
    
    if ((which == id_init_dir)
       || (which == id_home_dir)
       || (which == id_doc_dir)
       || (which == id_desk_dir))
      return home;

    ends_in_slash = (SCHEME_PATH_VAL(home))[SCHEME_PATH_LEN(home) - 1];
    ends_in_slash = ((ends_in_slash == '/') || (ends_in_slash == '\\'));

    if ((which == id_addon_dir)
       || (which == id_pref_dir)
       || (which == id_pref_file)) {
      home = append_path(home, scheme_make_path("\\PLT Scheme" + ends_in_slash));
      ends_in_slash = 0;
    }

    if (which == id_init_file)
      return append_path(home, scheme_make_path("\\mzschemerc.ss" + ends_in_slash));
    if (which == id_pref_file)
      return append_path(home, scheme_make_path("\\plt-prefs.ss" + ends_in_slash));
    return home;
  }
#endif

  /* Something went wrong if we get here. */
  return scheme_void;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * general_path_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 724 of file file.c.

{
  return (SCHEME_GENERAL_PATHP(argv[0]) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static char* get_drive_part ( const char *  wds,
int  wdlen 
) [static]

Definition at line 1540 of file file.c.

{
  int dend, dstart = 0;
  char *naya;

  if (check_dos_slashslash_qm(wds, wdlen, &dend, NULL, NULL)) {
    /* dend can't be < 0, because that's a relative path */
  } else if (!check_dos_slashslash_drive(wds, 0, wdlen, &dend, 0, 0))
    dend = 3;

  naya = scheme_malloc_atomic(dend + 1);
  memcpy(naya + dstart, wds, dend);
  naya[dend] = 0;

  return naya;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int get_slashslash_qm_dot_ups_end ( const char *  s,
int  len,
int _lit_start 
) [static]

Definition at line 1439 of file file.c.

{
  int pos = -1, j = 7; /* \\?\REL\ or \\?\RED\ */

  if (s[6] == 'L') {
    while (1) {
      if (j + 3 > len) {
        break;
      } else if ((s[j] == '\\') && (s[j+1] == '.') && (s[j+2] == '.')
                 && ((j + 3 == len) || (s[j+3] == '\\'))) {
        pos = j + 3;
        j += 3;
      } else {
        break;
      }
    }
  }

  if (pos > 0) {
    if (pos == len) 
      *_lit_start = len;
    else if ((pos + 2 < len)
            && s[pos+1] == '\\') {
      *_lit_start = pos + 2;
    } else {
      *_lit_start = pos + 1;
    }
  } else if (len > 8) {
    if (s[8] == '\\')
      *_lit_start = 9;
    else
      *_lit_start = 8;
  } else
    *_lit_start = len;

  return pos;
}

Here is the caller graph for this function:

static int has_null ( const char *  s,
long  l 
) [static]

Definition at line 1205 of file file.c.

{
  if (!l)
    return 1;

  while (l--) {
    if (!s[l])
      return 1;
  }

  return 0;
}

Here is the caller graph for this function:

static Scheme_Object* is_path_element ( Scheme_Object p) [static]

Definition at line 815 of file file.c.

{
  Scheme_Object *base, *fn;
  int isdir;

  fn = scheme_split_path(SCHEME_PATH_VAL(p), 
                         SCHEME_PATH_LEN(p), 
                         &base, 
                         &isdir,
                         SCHEME_PATH_KIND(p));

  if (SCHEME_SYMBOLP(base)
      && SCHEME_GENERAL_PATHP(fn))
    return fn;
  return NULL;
}

Here is the caller graph for this function:

static int is_special_filename ( const char *  _f,
int  offset,
int  len,
int  not_nul,
int  immediate 
) [static]

Definition at line 1625 of file file.c.

{
  int i, j, delta;

  /* Skip over path: */
  if (!len)
    return 0;
  if (!immediate) {
    delta = len;
    if (check_dos_slashslash_qm(f, delta, NULL, NULL, NULL))
      return 0;
    delta -= 1;
    while (delta && !IS_A_DOS_SEP(f[delta])) {
      --delta;
    }
    if (!delta && is_drive_letter(f[0]) && f[1] == ':') {
      delta = 2;
    } else if (IS_A_DOS_SEP(f[delta]))
      delta++;
  } else
    delta = offset;

  for (i = not_nul; special_filenames[i]; i++) {
    const char *sf = special_filenames[i];
    for (j = 0; sf[j] && f[delta + j]; j++) {
      if (scheme_toupper((mzchar)(unsigned char)f[delta + j]) != sf[j])
       break;
    }
    if (j && !sf[j]) {
      j += delta;
      if ((j >= (len + offset))
         || (f[j] == '.')
         || (f[j] == ':'))
       return i + 1;
      while ((j < (len + offset))
            && ((f[j] == ' ')
               || (f[j] == '.'))) {
       j++;
      }
      if (j >= (len + offset))
       return i + 1;

      return 0;
    }
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * link_exists ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 2260 of file file.c.

{
  char *filename;
#ifndef UNIX_FILE_SYSTEM
  Scheme_Object *bs;
#endif

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("link-exists?", SCHEME_PATH_STRING_STR, 0, argc, argv);


#ifndef UNIX_FILE_SYSTEM
  /* DOS or MAC: expand isn't called, so check the form now */
  bs = TO_PATH(argv[0]);
  filename = SCHEME_PATH_VAL(bs);
  if (has_null(filename, SCHEME_PATH_LEN(bs))) {
    raise_null_error("link-exists?", bs, "");
    return NULL;
  }
#endif

#ifdef DOS_FILE_SYSTEM
  scheme_security_check_file("link-exists?", filename, SCHEME_GUARD_FILE_EXISTS);

  return scheme_false;
#endif
#ifdef UNIX_FILE_SYSTEM
  {
    struct MSC_IZE(stat) buf;

    filename = do_expand_filename(argv[0],
                              NULL,
                              0,
                              "link-exists?",
                              NULL,
                              0, 1,
                              SCHEME_GUARD_FILE_EXISTS, 
                                  SCHEME_PLATFORM_PATH_KIND,
                                  0);
    while (1) {
      if (!MSC_W_IZE(lstat)(MSC_WIDE_PATH(filename), &buf))
       break;
      else if (errno != EINTR)
       return scheme_false;
    }

    if (S_ISLNK(buf.st_mode))
      return scheme_true;
    else
      return scheme_false;
  }
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_directory ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5027 of file file.c.

{
#ifdef NO_MKDIR
  return scheme_false;
#else
  char *filename;
  int exists_already = 0;
  int len, copied;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("make-directory", SCHEME_PATH_STRING_STR, 0, argc, argv);

  filename = scheme_expand_string_filename(argv[0],
                                      "make-directory",
                                      &copied,
                                      SCHEME_GUARD_FILE_WRITE);
  
  /* Make sure path doesn't have trailing separator: */
  len = strlen(filename);
  while (len && IS_A_SEP(SCHEME_PLATFORM_PATH_KIND, filename[len - 1])) {
    if (!copied) {
      filename = scheme_strdup(filename);
      copied = 1;
    }
    filename[--len] = 0;
  }

  while (1) {
    if (!MSC_W_IZE(mkdir)(MSC_WIDE_PATH(filename)
#  ifndef MKDIR_NO_MODE_FLAG
                       , 0777
# endif
                       ))
      return scheme_void;
    else if (errno != EINTR)
      break;
  }

  exists_already = (errno == EEXIST);
# define MKDIR_EXN_TYPE "%e"

  scheme_raise_exn(exists_already ? MZEXN_FAIL_FILESYSTEM_EXISTS : MZEXN_FAIL_FILESYSTEM,
                 "make-directory: cannot make directory: %q (" MKDIR_EXN_TYPE ")",
                 filename_for_error(argv[0]),
                 errno);
  return NULL;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* make_exposed_sized_offset_path ( int  already_protected,
char *  chars,
long  d,
long  len,
int  copy,
int  kind 
)

Definition at line 628 of file file.c.

{
  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    if (!already_protected) {
      int i, name_end;
      int non_dot = 0, trailing_dots = 0, protect = 0;
      /* Skip trailing seps: */
      for (i = d + len - 1; (i > d) && IS_A_DOS_SEP(chars[i]); --i) {
      }
      name_end = i+1;
      for (; (i > d) && !IS_A_DOS_SEP(chars[i]); --i) {
        if ((chars[i] != ' ') && (chars[i] != '.'))
          non_dot = 1;
        else if (!non_dot)
          trailing_dots = 1;
      }
      if (non_dot && trailing_dots)
        protect = 1;
      else if (name_end == (d + len))
        protect = is_special_filename(chars, i+1, name_end, 0, 1);

      if (protect) {
        Scheme_Object *first, *last, *a[2];
        char *s2;
        int l;
        l = name_end - (i+1);
        s2 = (char *)scheme_malloc_atomic(l + 9 + 1);
        memcpy(s2, "\\\\?\\REL\\\\", 9);
        memcpy(s2+9, chars + i + 1, l);
        s2[l + 9] = 0;
        last = scheme_make_sized_offset_kind_path(s2, 0, l+9, 0, SCHEME_WINDOWS_PATH_KIND);
        first = make_exposed_sized_offset_path(0, chars, d, i-d+1, 1, SCHEME_WINDOWS_PATH_KIND);
        a[0] = first;
        a[1] = last;
        return scheme_build_path(2, a);
      }
    }
  }

  /* We may need to remove a redundant separator from the directory
     path. Try removing it, and see if anyone would care: */
  if (do_path_to_directory_path(chars, d, len - 1, scheme_true, 1, kind)) {
    /* Actually, don't remove a separator after a drive, although it's
       technically redundant. */
    if ((kind != SCHEME_WINDOWS_PATH_KIND)
        || !((len == 3) && is_drive_letter(chars[d]) && (chars[d+1] == ':'))) {
      len--;
      copy = 1;
    }
  }

  return scheme_make_sized_offset_kind_path(chars, d, len, copy, kind);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_link ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5118 of file file.c.

{
  char *src;
  Scheme_Object *dest;
  int copied;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("make-file-or-directory-link", SCHEME_PATH_STRING_STR, 0, argc, argv);
  if (!SCHEME_PATH_STRINGP(argv[1]))
    scheme_wrong_type("make-file-or-directory-link", SCHEME_PATH_STRING_STR, 0, argc, argv);

  dest = argv[0];
  /* dest does not get expanded, but we need to make sure it's a path */
  dest = TO_PATH(dest);
  if (has_null(SCHEME_PATH_VAL(dest), SCHEME_PATH_LEN(dest))) {
    raise_null_error("make-file-or-directory-link", dest, "");
    return NULL;
  }

  src = scheme_expand_string_filename(argv[1],
                                  "make-file-or-directory-link",
                                  &copied,
                                  SCHEME_GUARD_FILE_WRITE);

  scheme_security_check_file_link("make-file-or-directory-link", 
                              src, 
                              SCHEME_PATH_VAL(dest));

#if defined(DOS_FILE_SYSTEM)
  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
                 "make-file-or-directory-link: link creation not supported on this platform; "
                 "cannot create link: %Q",
                 argv[1]);
#else
  while (1) {
    if (!symlink(SCHEME_PATH_VAL(dest), src))
      return scheme_void;
    else if (errno != EINTR)
      break;
  }

  scheme_raise_exn((errno == EEXIST) ? MZEXN_FAIL_FILESYSTEM_EXISTS : MZEXN_FAIL_FILESYSTEM,
                 "make-file-or-directory-link: cannot make link: %q (%e)",
                 filename_for_error(argv[1]),
                 errno);
#endif

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_protected_sized_offset_path ( int  protect,
char *  chars,
long  d,
long  len,
int  copy,
int  just_check,
int  kind 
) [static]

Definition at line 544 of file file.c.

{
  if (kind == SCHEME_WINDOWS_PATH_KIND) {
    if (protect) {
      int i;

      protect = 0;

      if (!protect) {
        int at_end = 1;
        for (i = len; i--; ) {
          if ((just_check != 2)
              && ((chars[i + d] == '.')
                  || (chars[i + d] == ' '))) {
            if (at_end) {
              protect = 1;
              break;
            }
          } else {
            at_end = 0;
            if ((chars[i + d] == '/')
                || (IS_SPEC_CHAR(chars[i + d]))) {
              protect = 1;
              break;
            }
          }
        }
      }

      if (!protect && (len == 1) && (chars[d] == '.'))
        protect = 1;

      if (!protect && (len == 2) && (chars[d] == '.') && (chars[d+1] == '.'))
        protect = 1;

      if (!protect) 
        protect = is_special_filename(chars, d, len, 0, 1);

      if (protect) {
        char *s2;
        if (just_check)
          return scheme_true;
        s2 = (char *)scheme_malloc_atomic(len + 9 + 1);
        memcpy(s2, "\\\\?\\REL\\\\", 9);
        memcpy(s2 + 9, chars + d, len);
        s2[9 + len] = 0;
        return scheme_make_sized_offset_kind_path(s2, 0, len + 9, 0, SCHEME_WINDOWS_PATH_KIND);
      }
    }
  } else {
#ifdef TILDE_IS_ABSOLUTE
    if (protect) {
      if (chars[d] == '~') {
        char *nm;
        if (just_check)
          return scheme_true;
        nm = (char *)scheme_malloc_atomic(len + 3);
        memcpy(nm XFORM_OK_PLUS 2, chars XFORM_OK_PLUS d, len);
        nm[0] = '.';
        nm[1] = '/';
        nm[len + 2] = 0;
        return scheme_make_sized_offset_kind_path(nm, 0, len + 2, 0, kind);
      }
    }
#endif
  }

  if (just_check)
    return scheme_false;

  return scheme_make_sized_offset_kind_path(chars, d, len, copy, kind);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * path_element_to_bytes ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 881 of file file.c.

{
  return do_path_element_to_bytes("path-element->bytes", argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * path_element_to_string ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 886 of file file.c.

{
  Scheme_Object *b;
  b = do_path_element_to_bytes("path-element->string", argc, argv);
  return scheme_byte_string_to_char_string_locale(b);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int path_is_simple_dir_without_sep ( Scheme_Object path) [static]

Definition at line 2380 of file file.c.

{
  int len;

  len = SCHEME_PATH_LEN(path);
  if (IS_A_SEP(SCHEME_PATH_VAL(path)[len - 1], SCHEME_PATH_KIND(path)))
    return 0;

  /* The simple thing to do here is to use split_path, but that's
     a lot of extra computation. */

  if (SCHEME_PATH_VAL(path)[len - 1] == '.') {
    if (len == 1)
      return 1;
    if (IS_A_SEP(SCHEME_PATH_VAL(path)[len - 2], SCHEME_PATH_KIND(path)))
      return 1;
    if (SCHEME_PATH_VAL(path)[len - 2] == '.') {
      if (len == 2)
        return 1;
      if (IS_A_SEP(SCHEME_PATH_VAL(path)[len - 3], SCHEME_PATH_KIND(path)))
        return 1;
    }
  }

#ifdef TILDE_IS_ABSOLUTE
  if (SCHEME_PATH_KIND(path) == SCHEME_UNIX_PATH_KIND) {
    if (SCHEME_PATH_VAL(path)[0] == '~') {
      int i;
      for (i = 1; i < len; i++) {
        if (IS_A_UNIX_SEP(SCHEME_PATH_VAL(path)[i]))
          break;
      }
      if (i == len)
        return 1;
    }
  }
#endif

  if (SCHEME_PATH_KIND(path) == SCHEME_WINDOWS_PATH_KIND) {
    int drive_end;
    if (check_dos_slashslash_drive(SCHEME_PATH_VAL(path), 0, len, &drive_end, 1, 0))
      return 1; /* exactly a UNC drive */
    if (len == 2
        && (is_drive_letter(SCHEME_PATH_VAL(path)[0]))
        && (SCHEME_PATH_VAL(path)[1] == ':'))
      return 1; /* a c: path */
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * path_kind ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 729 of file file.c.

{
  if (SCHEME_GENERAL_PATHP(argv[0])) {
    switch (SCHEME_PATH_KIND(argv[0])) {
    case SCHEME_WINDOWS_PATH_KIND:
      return windows_symbol;
      break;
    default:
    case SCHEME_UNIX_PATH_KIND:
      return unix_symbol;
      break;
    }
  } else {
    scheme_wrong_type("path-system-type", "path (for any system)", 0, argc, argv);
    return NULL;
  }
}

Here is the caller graph for this function:

static Scheme_Object * path_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 719 of file file.c.

{
  return (SCHEME_PATHP(argv[0]) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * path_to_bytes ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 805 of file file.c.

{
  if (!SCHEME_GENERAL_PATHP(argv[0]))
    scheme_wrong_type("path->bytes", "path", 0, argc, argv);

  return scheme_make_sized_byte_string(SCHEME_PATH_VAL(argv[0]),
                                   SCHEME_PATH_LEN(argv[0]),
                                   1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * path_to_complete_path ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3556 of file file.c.

{
  Scheme_Object *p, *wrt;
  char *s;
  int len, kind;

  p = argv[0];
  if (!SCHEME_GENERAL_PATH_STRINGP(p))
    scheme_wrong_type("path->complete-path", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);
  p = TO_PATH(p);
  if (argc > 1) {
    wrt = argv[1];
    if (!SCHEME_GENERAL_PATH_STRINGP(wrt))
      scheme_wrong_type("path->complete-path", SCHEME_GENERAL_PATH_STRING_STR, 1, argc, argv);
    wrt = TO_PATH(wrt);
  } else
    wrt = NULL;

  kind = SCHEME_PATH_KIND(p);
  if (wrt) {
    if (SCHEME_PATH_KIND(wrt) != kind) {
      scheme_arg_mismatch("path->complete-path",
                          "convention of first path incompatible with convention of second path: ",
                          argv[1]);
    }
  } else if (kind != SCHEME_PLATFORM_PATH_KIND) {
    scheme_arg_mismatch("path->complete-path",
                        "no second path supplied, and given path is not for the current platform: ",
                        argv[0]);
  }

  s = SCHEME_PATH_VAL(p);
  len = SCHEME_PATH_LEN(p);

  if (has_null(s, len))
    raise_null_error("path->complete-path", p, "");

  if (wrt) {
    char *ws;
    int wlen;

    ws = SCHEME_PATH_VAL(wrt);
    wlen = SCHEME_PATH_LEN(wrt);
    
    if (has_null(ws, wlen))
      raise_null_error("path->complete-path", p, "");

    if (!scheme_is_complete_path(ws, wlen, kind))
      scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                     "path->complete-path: second argument is not a complete path: \"%q\"",
                     ws);

    if (!scheme_is_complete_path(s, len, kind)) {
      s = do_path_to_complete_path(s, len, ws, wlen, kind);
      return scheme_make_sized_offset_kind_path(s, 0, strlen(s), 0, kind);
    }
  } else if (!scheme_is_complete_path(s, len, kind)) {
    s = do_path_to_complete_path(s, len, NULL, 0, kind);

    return scheme_make_sized_offset_kind_path(s, 0, strlen(s), 0, kind);
  }
   
  return p;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* path_to_directory_path ( int  argc,
Scheme_Object argv[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* path_to_directory_path ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3118 of file file.c.

{
  Scheme_Object *inpath;

  inpath = argv[0];

  if (!SCHEME_GENERAL_PATH_STRINGP(inpath))
    scheme_wrong_type("path->directory-path", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  inpath = TO_PATH(inpath);

  return scheme_path_to_directory_path(inpath);
}
static Scheme_Object * path_to_string ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 797 of file file.c.

{
  if (!SCHEME_PATHP(argv[0]))
    scheme_wrong_type("path->string", "path", 0, argc, argv);

  return scheme_path_to_char_string(argv[0]);
}

Here is the caller graph for this function:

static Scheme_Object * platform_path_kind ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 747 of file file.c.

{
  switch (SCHEME_PLATFORM_PATH_KIND) {
  case SCHEME_WINDOWS_PATH_KIND:
    return windows_symbol;
    break;
  default:
  case SCHEME_UNIX_PATH_KIND:
    return unix_symbol;
    break;
  }
}

Here is the caller graph for this function:

static void raise_null_error ( const char *  name,
Scheme_Object path,
const char *  mod 
) [static]

Definition at line 1218 of file file.c.

{
  if (!(SCHEME_CHAR_STRINGP(path) ? SCHEME_CHAR_STRTAG_VAL(path) : SCHEME_PATH_LEN(path)))
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "%s: path string%s is empty", 
                   name, mod);
  else
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "%s: path string%s contains a null character: %Q", 
                   name, mod, 
                   path);
}

Here is the caller graph for this function:

static Scheme_Object * relative_path_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3852 of file file.c.

{
  char *s;
  int len;
  Scheme_Object *bs;

  if (!SCHEME_GENERAL_PATH_STRINGP(argv[0]))
    scheme_wrong_type("relative-path?", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  bs = TO_PATH(argv[0]);

  s = SCHEME_PATH_VAL(bs);
  len = SCHEME_PATH_LEN(bs);

  if (has_null(s, len))
    return scheme_false;

  return (scheme_is_relative_path(s, len, SCHEME_PATH_KIND(bs))
         ? scheme_true
         : scheme_false);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char * remove_redundant_slashes ( char *  filename,
int l,
int  delta,
int expanded,
int  kind 
) [static]

Definition at line 1681 of file file.c.

{
  int extra = 0, i, ilen = *l;
  
  for (i = ilen; --i > delta; ) {
    if (IS_A_SEP(kind, filename[i])) {
      if (IS_A_SEP(kind, filename[i - 1])) {
        extra++;
      }
    }
  }

  if (extra) {
    char *naya;
    naya = (char *)scheme_malloc_atomic(ilen + 1 - extra);
    extra = 0;
    for (i = delta; i < ilen; i++) {
      if (IS_A_SEP(kind, filename[i])
          && IS_A_SEP(kind, filename[i + 1])) {
        /* Skip */
        extra++;
      } else {
        naya[i - extra] = filename[i];
      }
    }
    memcpy(naya, filename, delta);
    ilen -= extra;
    naya[ilen] = 0;
    filename = naya;
    if (expanded)
      *expanded = 1;
  }
  
  *l = ilen;
  return filename;
}

Here is the caller graph for this function:

static Scheme_Object * rename_file ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3667 of file file.c.

{
  int exists_ok = 0;
  char *src, *dest;
  Scheme_Object *bss, *bsd;

  if (!SCHEME_PATH_STRINGP(argv[0]))
    scheme_wrong_type("rename-file-or-directory", SCHEME_PATH_STRING_STR, 0, argc, argv);
  if (!SCHEME_PATH_STRINGP(argv[1]))
    scheme_wrong_type("rename-file-or-directory", SCHEME_PATH_STRING_STR, 1, argc, argv);
  if (argc > 2)
    exists_ok = SCHEME_TRUEP(argv[2]);

  bss = argv[0];
  bsd = argv[1];

  src = scheme_expand_string_filename(bss,
                                  "rename-file-or-directory",
                                  NULL,
                                  SCHEME_GUARD_FILE_READ);
  dest = scheme_expand_string_filename(bsd,
                                   "rename-file-or-directory",
                                   NULL,
                                   SCHEME_GUARD_FILE_WRITE);

# ifdef DOS_FILE_SYSTEM
  if (MoveFileExW(WIDE_PATH_COPY(src), WIDE_PATH(dest), (exists_ok ? MOVEFILE_REPLACE_EXISTING : 0)))
    return scheme_void;

  {
    int errid;
    errid = GetLastError();
    errno = errid;
  }

  if (errno == ERROR_CALL_NOT_IMPLEMENTED) {
    /* Then we have the great misfortune of running in Windows 9x. If
       exists_ok, then do something no less stupid than the OS
       itself: */
    int errid;
    if (exists_ok)
      MSC_W_IZE(unlink)(MSC_WIDE_PATH(dest));
    if (MoveFileW(WIDE_PATH_COPY(src), WIDE_PATH(dest)))
      return scheme_void;
    errid = GetLastError();
    errno = errid;
  }

# define MOVE_ERRNO_FORMAT "%E"
# else
  if (!exists_ok && (scheme_file_exists(dest) || scheme_directory_exists(dest))) {
    exists_ok = -1;
    errno = EEXIST;
    goto failed;
  }
  
  while (1) {
    if (!rename(src, dest))
      return scheme_void;
    else if (errno != EINTR)
      break;
  }
# define MOVE_ERRNO_FORMAT "%e"
# endif

#ifndef DOS_FILE_SYSTEM
failed:
#endif
  scheme_raise_exn((exists_ok < 0) ? MZEXN_FAIL_FILESYSTEM_EXISTS : MZEXN_FAIL_FILESYSTEM, 
                 "rename-file-or-directory: cannot rename file or directory: %q to: %q (" MOVE_ERRNO_FORMAT ")",
                 filename_for_error(argv[0]),
                 filename_for_error(argv[1]),
                 errno);
  
  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * resolve_path ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3918 of file file.c.

{
#ifndef NO_READLINK
#define SL_NAME_MAX 2048
  char buffer[SL_NAME_MAX];
#endif
#ifndef NO_READLINK
  long len;
  int copied = 0;
#endif
  char *filename;
  int expanded;

  if (!SCHEME_GENERAL_PATH_STRINGP(argv[0]))
    scheme_wrong_type("resolve-path", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  filename = do_expand_filename(argv[0],
                            NULL,
                            0,
                            "resolve-path",
                            &expanded,
                            1, 0,
                            SCHEME_GUARD_FILE_EXISTS,
                                SCHEME_PLATFORM_PATH_KIND,
                                0);

#ifndef NO_READLINK
  {
    char *fullfilename = filename;

    len = strlen(fullfilename);
    if (!scheme_is_complete_path(fullfilename, len, SCHEME_PLATFORM_PATH_KIND)) {
      fullfilename = do_path_to_complete_path(fullfilename, len, NULL, 0, SCHEME_PLATFORM_PATH_KIND);
      copied = 1;
    }

    /* Make sure path doesn't have trailing separator: */
    len = strlen(fullfilename);
    while (len && IS_A_SEP(SCHEME_PLATFORM_PATH_KIND, fullfilename[len - 1])) {
      if (!expanded && !copied) {
       fullfilename = scheme_strdup(fullfilename);
       copied = 1;
      }
      fullfilename[--len] = 0;
    }

    while (1) {
      len = readlink(fullfilename, buffer, SL_NAME_MAX);
      if (len == -1) {
       if (errno != EINTR)
         break;
      } else
       break;
    }

    if (len > 0)
      return scheme_make_sized_path(buffer, len, 1);
  }
#endif

  if (!expanded)
    return argv[0];
  else
    return scheme_make_sized_path(filename, strlen(filename), 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 3093 of file file.c.

{
  int kind = SCHEME_PLATFORM_PATH_KIND, i;

  for (i = 0; i < argc; i++) {
    if (SCHEME_GENERAL_PATHP(argv[i])) {
      kind = SCHEME_PATH_KIND(argv[i]);
      break;
    } else if (SCHEME_CHAR_STRINGP(argv[i])) {
      kind = SCHEME_PLATFORM_PATH_KIND;
      break;
    }
  }
  
  return do_build_path(argc, argv, 0, 0, kind);
}

Here is the call graph for this function:

Definition at line 711 of file file.c.

Definition at line 5579 of file file.c.

                                                                                        {
  return current_library_collection_paths(argc, argv);
}

Here is the call graph for this function:

int scheme_directory_exists ( char *  dirname)

Definition at line 2172 of file file.c.

{
# ifdef NO_STAT_PROC
  return 0;
# else
#  ifdef DOS_FILE_SYSTEM
  int isdir;

  return (UNC_stat(dirname, strlen(dirname), NULL, &isdir, NULL, NULL)
         && isdir);
#  else
  struct MSC_IZE(stat) buf;

  while (1) {
    if (!MSC_IZE(stat)(dirname, &buf))
      break;
    else if (errno != EINTR)
      return 0;
  }

  return S_ISDIR(buf.st_mode);
#  endif
# endif
}
char* scheme_expand_filename ( char *  filename,
int  ilen,
const char *  errorin,
int expanded,
int  guards 
)

Definition at line 1964 of file file.c.

{
  return do_expand_filename(NULL, filename, ilen, errorin, expanded, 1, 1, guards, SCHEME_PLATFORM_PATH_KIND, 0);
}

Here is the call graph for this function:

char* scheme_expand_string_filename ( Scheme_Object o,
const char *  errorin,
int expanded,
int  guards 
)

Definition at line 1974 of file file.c.

{
  return do_expand_filename(o, NULL, 0, errorin, expanded, 1, 1, guards, SCHEME_PLATFORM_PATH_KIND, 0);
}

Here is the call graph for this function:

char* scheme_expand_user_filename ( char *  filename,
int  ilen,
const char *  errorin,
int expanded,
int  guards 
)

Definition at line 1969 of file file.c.

{
  return do_expand_filename(NULL, filename, ilen, errorin, expanded, 1, 1, guards, SCHEME_PLATFORM_PATH_KIND, 1);
}

Here is the call graph for this function:

Definition at line 4941 of file file.c.

{
  Scheme_Object *de, *oe;

  de = explode_path(dir);
  oe = explode_path(obj);

  while (SCHEME_PAIRP(de)
        && SCHEME_PAIRP(oe)) {
    if (!scheme_equal(SCHEME_CAR(de), SCHEME_CAR(oe)))
      return obj;
    de = SCHEME_CDR(de);
    oe = SCHEME_CDR(oe);
  }

  if (SCHEME_NULLP(de)) {
    Scheme_Object *a[2];
   
    if (SCHEME_NULLP(oe)) {
      a[0] = same_symbol;
      obj = scheme_build_path(1, a);
    } else {
      obj = SCHEME_CAR(oe);
      oe = SCHEME_CDR(oe);
    }

    while (SCHEME_PAIRP(oe)) {
      a[0] = obj;
      a[1] = SCHEME_CAR(oe);
      obj = scheme_build_path(2, a);
      oe = SCHEME_CDR(oe);
    }
  }

  return obj;
}

Here is the call graph for this function:

int scheme_file_exists ( char *  filename)

Definition at line 2137 of file file.c.

{
# ifdef NO_STAT_PROC
  FILE *fp;

  fp = fopen(filename, "r");
  if (fp) {
    fclose(fp);
    return 1;
  } else
    return 0;
# else
#  ifdef DOS_FILE_SYSTEM
  /* Claim that all special files exist: */
  if (scheme_is_special_filename(filename, 0))
    return 1;

  {
    int isdir;
    return (UNC_stat(filename, strlen(filename), NULL, &isdir, NULL, NULL)
           && !isdir);
  }
#  else
  struct MSC_IZE(stat) buf;
  int ok;

  do {
    ok = MSC_W_IZE(stat)(MSC_WIDE_PATH(filename), &buf);
  } while ((ok == -1) && (errno == EINTR));

  return !ok && !S_ISDIR(buf.st_mode);
#  endif
# endif
}
char* scheme_find_completion ( char *  fn)

Definition at line 4831 of file file.c.

{
  int len;
  Scheme_Object *p, *l, *a[2], *f, *matches, *fst;
  int isdir, max_match;
  Scheme_Object *base;
  
  len = strlen(fn);

  if (!len)
    return NULL;
  
  f = scheme_split_path(fn, len, &base, &isdir, SCHEME_PLATFORM_PATH_KIND);
  if (isdir) {
    /* Look for single file/prefix in directory: */
    base = scheme_make_sized_path(fn, len, 0);
    f = scheme_make_sized_path("", 0, 0);
  } else {
    if (!SCHEME_PATHP(base))
      return NULL;
  }

  a[0] = base;
  l = do_directory_list(0, 1, a);
  if (!l)
    return NULL;

  matches = scheme_null;
  while (SCHEME_PAIRP(l)) {
    p = SCHEME_CAR(l);
    if ((SCHEME_PATH_LEN(p) >= SCHEME_PATH_LEN(f))
       && !memcmp(SCHEME_PATH_VAL(f), SCHEME_PATH_VAL(p), SCHEME_PATH_LEN(f))) {
      matches = scheme_make_pair(p, matches);
    }
    l = SCHEME_CDR(l);
  }

  if (SCHEME_NULLP(matches))
    return NULL;

  if (SCHEME_NULLP(SCHEME_CDR(matches))) {
    /* One match */
    a[0] = base;
    a[1] = SCHEME_CAR(matches);
    p = scheme_build_path(2, a);
    a[0] = p;
    if (SCHEME_TRUEP(directory_exists(1, a))) {
      /* Add trailing separator if one is not there */
      fn = SCHEME_PATH_VAL(p);
      len = SCHEME_PATH_LEN(p);
      if (!IS_A_SEP(SCHEME_PLATFORM_PATH_KIND, fn[len-1])) {
       char *naya;
       naya = (char *)scheme_malloc_atomic(len + 2);
       memcpy(naya, fn, len);
       naya[len++] = FN_SEP(SCHEME_PLATFORM_PATH_KIND);
       naya[len] = 0;
       fn = naya;
      }
    } else
      fn = SCHEME_PATH_VAL(p);
    return fn;
  }

  fst = SCHEME_CAR(matches);
  max_match = SCHEME_PATH_LEN(fst);
  for (l = SCHEME_CDR(matches); SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
    int i, l2;
    p = SCHEME_CAR(l);
    l2 = SCHEME_PATH_LEN(p);
    if (max_match < l2)
      l2 = max_match;
    else if (l2 < max_match)
      max_match = l2;
    for (i = 0; i < l2; i++) {
      if (SCHEME_PATH_VAL(fst)[i] != SCHEME_PATH_VAL(p)[i]) {
       max_match = i;
       break;
      }
    }
  }

  if (max_match <= SCHEME_PATH_LEN(f)) 
    /* No longer match available: */
    return NULL;

  /* Build match */
  a[0] = base;
  a[1] = scheme_make_sized_path(SCHEME_PATH_VAL(fst), max_match, 0);
  f = scheme_build_path(2, a);  

  return SCHEME_PATH_VAL(f);
}

Here is the call graph for this function:

Definition at line 5947 of file file.c.

{
  if (exec_cmd)
    return SCHEME_PATH_VAL(exec_cmd);
  else
    return NULL;
}

Definition at line 2314 of file file.c.

{
  int errid = 0;
  unsigned long devi = 0, inoi = 0, inoi2 = 0;
  int shift = 0, shift2 = -1;
  Scheme_Object *devn, *inon, *a[2];

#ifdef FILES_HAVE_FDS
  struct MSC_IZE(stat) buf;

  while (1) {
    if (!MSC_IZE(fstat)(fd, &buf))
      break;
    else if (errno != EINTR) {
      errid = errno;
      break;
    }
  }
  
  if (!errid) {
    /* Warning: we assume that dev_t and ino_t fit in a long. */
    devi = (unsigned long)buf.st_dev;
    inoi = (unsigned long)buf.st_ino;
    shift = sizeof(dev_t);
  }
#endif
#ifdef WINDOWS_FILE_HANDLES
  BY_HANDLE_FILE_INFORMATION info;

  if (GetFileInformationByHandle((HANDLE)fd, &info))
    errid = 0;
  else
    errid = GetLastError();

  if (!errid) {
    devi = info.dwVolumeSerialNumber;
    inoi = info.nFileIndexLow;
    inoi2 = info.nFileIndexHigh;
    shift = sizeof(DWORD);
    shift2 = 2 * sizeof(DWORD);
  }
#endif

  if (!errid) {
    devn = scheme_make_integer_value_from_unsigned(devi);
    inon = scheme_make_integer_value_from_unsigned(inoi);
    
    a[0] = inon;
    a[1] = scheme_make_integer(shift);
    inon = scheme_bitwise_shift(2, a);
    
    if (shift2 > -1) {
      a[0] = scheme_make_integer_value_from_unsigned(inoi2);
      a[1] = scheme_make_integer(shift2);
      inon = scheme_bin_plus(inon, scheme_bitwise_shift(2, a));
    }

    return scheme_bin_plus(devn, inon);
  }

  scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                 "port-file-identity: error obtaining identity (%E)",
                 errid);
  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1172 of file file.c.

{
  int isdir;
  Scheme_Object *base;
  
  scheme_split_path(filename, strlen(filename), &base, &isdir, SCHEME_PLATFORM_PATH_KIND);
  
  return base;
}

Here is the caller graph for this function:

Definition at line 5631 of file file.c.

{
  if (!run_cmd) {
    REGISTER_SO(run_cmd);
    run_cmd = scheme_make_path("mzscheme");
  }
  return run_cmd;
}

Here is the caller graph for this function:

char* scheme_getdrive ( void  )

Definition at line 1557 of file file.c.

{
  scheme_security_check_file("current-drive", NULL, SCHEME_GUARD_FILE_EXISTS);
#ifdef DOS_FILE_SYSTEM
  {
    Scheme_Object *wd;
    wd = CURRENT_WD();
    return get_drive_part(SCHEME_PATH_VAL(wd), SCHEME_PATH_LEN(wd));
  }
#else
  return "";
#endif
}

Here is the call graph for this function:

Definition at line 233 of file file.c.

{
  REGISTER_SO(up_symbol);
  REGISTER_SO(relative_symbol);
  REGISTER_SO(same_symbol);
#ifndef NO_FILE_SYSTEM_UTILS
  REGISTER_SO(read_symbol);
  REGISTER_SO(write_symbol);
  REGISTER_SO(execute_symbol);
  
  REGISTER_SO(temp_dir_symbol);
  REGISTER_SO(home_dir_symbol);
  REGISTER_SO(pref_dir_symbol);
  REGISTER_SO(doc_dir_symbol);
  REGISTER_SO(desk_dir_symbol);
  REGISTER_SO(init_dir_symbol);
  REGISTER_SO(init_file_symbol);
  REGISTER_SO(sys_dir_symbol);
  REGISTER_SO(pref_file_symbol);
  REGISTER_SO(exec_file_symbol);
  REGISTER_SO(run_file_symbol);
  REGISTER_SO(collects_dir_symbol);
  REGISTER_SO(orig_dir_symbol);
  REGISTER_SO(addon_dir_symbol);
#endif
  REGISTER_SO(windows_symbol);
  REGISTER_SO(unix_symbol);

  up_symbol = scheme_intern_symbol("up");
  relative_symbol = scheme_intern_symbol("relative");
  same_symbol = scheme_intern_symbol("same");
  
#ifndef NO_FILE_SYSTEM_UTILS
  read_symbol = scheme_intern_symbol("read");
  write_symbol = scheme_intern_symbol("write");
  execute_symbol = scheme_intern_symbol("execute");
  
  temp_dir_symbol = scheme_intern_symbol("temp-dir");
  home_dir_symbol = scheme_intern_symbol("home-dir");
  doc_dir_symbol = scheme_intern_symbol("doc-dir");
  desk_dir_symbol = scheme_intern_symbol("desk-dir");
  pref_dir_symbol = scheme_intern_symbol("pref-dir");
  init_dir_symbol = scheme_intern_symbol("init-dir");
  init_file_symbol = scheme_intern_symbol("init-file");
  sys_dir_symbol = scheme_intern_symbol("sys-dir");
  pref_file_symbol = scheme_intern_symbol("pref-file");
  exec_file_symbol = scheme_intern_symbol("exec-file");
  run_file_symbol = scheme_intern_symbol("run-file");
  collects_dir_symbol = scheme_intern_symbol("collects-dir");
  orig_dir_symbol = scheme_intern_symbol("orig-dir");
  addon_dir_symbol = scheme_intern_symbol("addon-dir");
#endif

  windows_symbol = scheme_intern_symbol("windows");
  unix_symbol = scheme_intern_symbol("unix");

  scheme_add_global_constant("path?", 
                          scheme_make_prim_w_arity(path_p, 
                                                "path?", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("path-for-some-system?", 
                          scheme_make_folding_prim(general_path_p, 
                                                      "path-for-some-system?", 
                                                      1, 1, 1), 
                          env);
  scheme_add_global_constant("path-convention-type", 
                          scheme_make_folding_prim(path_kind, 
                                                      "path-convention-type", 
                                                      1, 1, 1), 
                          env);
  scheme_add_global_constant("system-path-convention-type", 
                          scheme_make_prim_w_arity(platform_path_kind, 
                                                      "system-path-convention-type", 
                                                      0, 0),
                          env);
  scheme_add_global_constant("path->string", 
                          scheme_make_prim_w_arity(path_to_string, 
                                                "path->string", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("path->bytes", 
                          scheme_make_prim_w_arity(path_to_bytes, 
                                                "path->bytes", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("path-element->bytes", 
                          scheme_make_prim_w_arity(path_element_to_bytes, 
                                                "path-element->bytes", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("path-element->string", 
                          scheme_make_prim_w_arity(path_element_to_string, 
                                                "path-element->string", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("string->path", 
                          scheme_make_prim_w_arity(string_to_path, 
                                                "string->path", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("bytes->path", 
                          scheme_make_prim_w_arity(bytes_to_path, 
                                                "bytes->path", 
                                                1, 2), 
                          env);
  scheme_add_global_constant("bytes->path-element", 
                          scheme_make_prim_w_arity(bytes_to_path_element, 
                                                "bytes->path-element", 
                                                1, 2), 
                          env);
  scheme_add_global_constant("string->path-element", 
                          scheme_make_prim_w_arity(string_to_path_element, 
                                                "string->path-element", 
                                                1, 1), 
                          env);

  scheme_add_global_constant("file-exists?", 
                          scheme_make_prim_w_arity(file_exists, 
                                                "file-exists?", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("directory-exists?", 
                          scheme_make_prim_w_arity(directory_exists, 
                                                "directory-exists?", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("link-exists?", 
                          scheme_make_prim_w_arity(link_exists, 
                                                "link-exists?", 
                                                1, 1), 
                          env);
#ifndef NO_FILE_SYSTEM_UTILS
  scheme_add_global_constant("delete-file", 
                          scheme_make_prim_w_arity(delete_file, 
                                                "delete-file", 
                                                1, 1), 
                          env);
  scheme_add_global_constant("rename-file-or-directory", 
                          scheme_make_prim_w_arity(rename_file, 
                                                "rename-file-or-directory", 
                                                2, 3), 
                          env);
  scheme_add_global_constant("copy-file", 
                          scheme_make_prim_w_arity(copy_file, 
                                                "copy-file", 
                                                2, 2), 
                          env);
  scheme_add_global_constant("build-path", 
                          scheme_make_prim_w_arity(scheme_build_path,
                                                "build-path", 
                                                1, -1), 
                          env);
  scheme_add_global_constant("build-path/convention-type", 
                          scheme_make_prim_w_arity(build_path_kind,
                                                "build-path/convention-type", 
                                                2, -1), 
                          env);
  scheme_add_global_constant("path->directory-path",
                          scheme_make_prim_w_arity(path_to_directory_path,
                                                "path->directory-path",
                                                1, 1), 
                          env);
  scheme_add_global_constant("split-path", 
                          scheme_make_prim_w_arity2(split_path,
                                                 "split-path",
                                                 1, 1,
                                                 3, 3), 
                          env);
  scheme_add_global_constant("relative-path?", 
                          scheme_make_prim_w_arity(relative_path_p,
                                                "relative-path?",
                                                1, 1), 
                          env);
  scheme_add_global_constant("absolute-path?", 
                          scheme_make_prim_w_arity(absolute_path_p,
                                                "absolute-path?",
                                                1, 1), 
                          env);
  scheme_add_global_constant("complete-path?", 
                          scheme_make_prim_w_arity(complete_path_p,
                                                "complete-path?",
                                                1, 1), 
                          env);
  scheme_add_global_constant("path->complete-path",
                          scheme_make_prim_w_arity(path_to_complete_path,
                                                "path->complete-path",
                                                1, 2), 
                          env);
  scheme_add_global_constant("resolve-path",
                          scheme_make_prim_w_arity(resolve_path,
                                                "resolve-path",
                                                1, 1), 
                          env);
  scheme_add_global_constant("simplify-path",
                          scheme_make_prim_w_arity(simplify_path,
                                                "simplify-path",
                                                1, 2), 
                          env);
  scheme_add_global_constant("cleanse-path",
                          scheme_make_prim_w_arity(cleanse_path,
                                                "cleanse-path",
                                                1, 1), 
                          env);
  scheme_add_global_constant("expand-user-path",
                          scheme_make_prim_w_arity(expand_user_path,
                                                "expand-user-path",
                                                1, 1), 
                          env);
  scheme_add_global_constant("directory-list",
                          scheme_make_prim_w_arity(directory_list,
                                                "directory-list",
                                                0, 1), 
                          env);
  scheme_add_global_constant("filesystem-root-list",
                          scheme_make_prim_w_arity(filesystem_root_list,
                                                "filesystem-root-list",
                                                0, 0), 
                          env);
  scheme_add_global_constant("make-directory",
                          scheme_make_prim_w_arity(make_directory,
                                                "make-directory",
                                                1, 1), 
                          env);
  scheme_add_global_constant("delete-directory",
                          scheme_make_prim_w_arity(delete_directory,
                                                "delete-directory",
                                                1, 1), 
                          env);
  scheme_add_global_constant("make-file-or-directory-link",
                          scheme_make_prim_w_arity(make_link,
                                                "make-file-or-directory-link",
                                                2, 2), 
                          env);
  scheme_add_global_constant("file-or-directory-modify-seconds",
                          scheme_make_prim_w_arity(file_modify_seconds,
                                                "file-or-directory-modify-seconds",
                                                1, 3), 
                          env);
  scheme_add_global_constant("file-or-directory-permissions",
                          scheme_make_prim_w_arity(file_or_dir_permissions,
                                                "file-or-directory-permissions",
                                                1, 1), 
                          env);
  scheme_add_global_constant("file-size",
                          scheme_make_prim_w_arity(file_size,
                                                "file-size",
                                                1, 1), 
                          env);

  scheme_add_global_constant("current-drive", 
                          scheme_make_prim_w_arity(current_drive, 
                                                "current-drive", 
                                                0, 0), 
                          env);

  scheme_add_global_constant("find-system-path", 
                          scheme_make_prim_w_arity(find_system_path, 
                                                "find-system-path", 
                                                1, 1), 
                          env);

#endif

#ifdef DIR_FUNCTION
  scheme_add_global_constant("current-directory",
                          scheme_register_parameter(current_directory,
                                                 "current-directory", 
                                                 MZCONFIG_CURRENT_DIRECTORY),
                          env);
#endif

#ifndef NO_FILE_SYSTEM_UTILS
  scheme_add_global_constant("current-library-collection-paths",
                          scheme_register_parameter(current_library_collection_paths,
                                                 "current-library-collection-paths",
                                                 MZCONFIG_COLLECTION_PATHS),
                          env);
#endif
  scheme_add_global_constant("use-compiled-file-paths",
                          scheme_register_parameter(use_compiled_kind,
                                                 "use-compiled-file-paths",
                                                 MZCONFIG_USE_COMPILED_KIND),
                          env);
  scheme_add_global_constant("use-user-specific-search-paths",
                          scheme_register_parameter(use_user_paths,
                                                 "use-user-specific-search-paths",
                                                 MZCONFIG_USE_USER_PATHS),
                          env);
}

Here is the caller graph for this function:

int scheme_is_complete_path ( const char *  s,
long  len,
int  kind 
)

Definition at line 3467 of file file.c.

{
  if (!len)
    return 0;

  if (!kind)
    kind = SCHEME_PLATFORM_PATH_KIND;

  if (!scheme_is_relative_path(s, len, kind)) {
    if (kind == SCHEME_WINDOWS_PATH_KIND) {
      if (IS_A_DOS_SEP(s[0]) && IS_A_DOS_SEP(s[1])) {
        int dlen;
        if (check_dos_slashslash_qm(s, len, &dlen, NULL, NULL)) { /* not relative */
          return (dlen >= 0);
        } else if (check_dos_slashslash_drive(s, 0, len, NULL, 0, 0))
          return 1;
        else
          return 0;
      } else if ((len >= 2) 
                 && is_drive_letter(s[0])
                 && (s[1] == ':')) {
        return 1;
      } else
        return 0;
    } else
      return 1;
  } else 
    return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int scheme_is_regular_file ( char *  filename)

Definition at line 2197 of file file.c.

{
# ifdef NO_STAT_PROC
  return 0;
# else
  struct MSC_IZE(stat) buf;

#  ifdef DOS_FILE_SYSTEM
  if (scheme_is_special_filename(filename, 1))
    return 0;
#  endif

  while (1) {
    if (!MSC_W_IZE(stat)(MSC_WIDE_PATH(filename), &buf))
      break;
    else if (errno != EINTR)
      return 0;
  }

  return S_ISREG(buf.st_mode);
# endif  
}

Here is the caller graph for this function:

int scheme_is_relative_path ( const char *  s,
long  len,
int  kind 
)

Definition at line 3440 of file file.c.

{
  if (!len)
    return 0;

  if (kind == SCHEME_UNIX_PATH_KIND) {
    return !((s[0] == '/') || WHEN_TILDE_IS_ABSOLUTE(s[0] == '~'));
  } else {
    int dlen;
    if (check_dos_slashslash_qm(s, len, &dlen, NULL, NULL)
       && (dlen < 0)) {
      if (dlen == -1)
        return 1; /* It's a \\?\REL\ path */
      else
        return 0; /* It's a \\?\RED\ path */
    }

    if (IS_A_DOS_SEP(s[0])
        || ((len >= 2) 
            && is_drive_letter(s[0])
            && (s[1] == ':')))
      return 0;
    else
      return 1;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* scheme_make_path ( const char *  chars)

Definition at line 688 of file file.c.

{
  return scheme_make_sized_offset_path((char *)chars, 0, -1, 1);
}

Definition at line 698 of file file.c.

{
  return scheme_make_sized_offset_path(chars, 0, -1, 0);
}
Scheme_Object* scheme_make_sized_offset_kind_path ( char *  chars,
long  d,
long  len,
int  copy,
int  kind 
)

Definition at line 528 of file file.c.

{
  Scheme_Object *s;
  s = scheme_make_sized_offset_byte_string(chars, d, len, copy);
  s->type = kind;
  return s;
}

Here is the call graph for this function:

Scheme_Object* scheme_make_sized_offset_path ( char *  chars,
long  d,
long  len,
int  copy 
)

Definition at line 536 of file file.c.

Scheme_Object* scheme_make_sized_path ( char *  chars,
long  len,
int  copy 
)

Definition at line 693 of file file.c.

{
  return scheme_make_sized_offset_path(chars, 0, len, copy);
}
char* scheme_normal_path_seps ( char *  si,
int _len,
int  delta 
)

Definition at line 2568 of file file.c.

{
  return do_normal_path_seps(si, _len, delta, 1, SCHEME_PLATFORM_PATH_KIND, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

char* scheme_os_getcwd ( char *  buf,
int  buflen,
int actlen,
int  noexn 
)

Definition at line 1034 of file file.c.

{
# define GETCWD_BUFSIZE 1024
  char buffer[GETCWD_BUFSIZE], *r, *gbuf;
  int obuflen = buflen;

  if (buflen < GETCWD_BUFSIZE) {
    gbuf = buffer;
    buflen = GETCWD_BUFSIZE;
  } else
    gbuf = buf;

  r = mz_getcwd(gbuf, buflen - 1);
  if (!r) {
    char *r2;

    r = mz_getcwd(NULL, 0);
    if (!r) {
      /* Something bad happened! */
      if (noexn) {
        /* We need to invent some complete path. */
#ifdef DOS_FILE_SYSTEM
        r = "C:\\";
#else
        r = "/";
#endif        
       if (actlen)
         *actlen = strlen(r);

       if (buf) {
          strcpy(buf, r);
         return buf;
       } else {
         return r;
       }
      }
       
      scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, 
                     "current-directory: unknown failure (%e)", errno);
    }

    buflen = strlen(r) + 1;
    r2 = (char *)scheme_malloc_atomic(buflen);
    memcpy(r2, r, buflen);
    r2[buflen] = 0;
    free(r);
    r = r2;

    if (actlen)
      *actlen = buflen;
  } else {
    int slen = strlen(r) + 1;

    if (actlen)
      *actlen = slen;

    if (obuflen < slen)
      r = scheme_strdup(r);
    else if (r != buf) {
      memcpy(buf, r, slen);
      r = buf;
    }
  }
     
  return r;
}
int scheme_os_setcwd ( char *  expanded,
int  noexn 
)

Definition at line 1101 of file file.c.

{
  int err;

  while (1) {
    err = MSC_W_IZE(chdir)(MSC_WIDE_PATH(expanded));
    if (!err || (errno != EINTR))
      break;
  }

  if (err && !noexn)
      scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                     "current-directory: unable to switch to directory: \"%q\"",
                     expanded);

  return !err;
}

Here is the call graph for this function:

Definition at line 785 of file file.c.

Definition at line 3621 of file file.c.

{
  Scheme_Object *a[2];
  a[0] = path;
  a[1] = relto_path;
  return path_to_complete_path(relto_path ? 2 : 1, a);
}

Here is the call graph for this function:

Definition at line 2529 of file file.c.

Here is the call graph for this function:

Definition at line 1182 of file file.c.

{
  Scheme_Object *cwd;
  long len;

  cwd = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_DIRECTORY);

  fn = TO_PATH(fn);

  len = SCHEME_PATH_LEN(cwd);
  if ((len < SCHEME_PATH_LEN(fn))
      && !scheme_strncmp(SCHEME_PATH_VAL(cwd), SCHEME_PATH_VAL(fn), len)) {
    /* Skip over path separators: */
    while (IS_A_SEP(SCHEME_PLATFORM_PATH_KIND, SCHEME_PATH_VAL(fn)[len])) {
      len++;
    }

    return scheme_make_sized_offset_path(SCHEME_PATH_VAL(fn), len, SCHEME_PATH_LEN(fn) - len, 1);
  }

  return fn;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 5955 of file file.c.

Here is the caller graph for this function:

Definition at line 5923 of file file.c.

{
#ifndef NO_FILE_SYSTEM_UTILS
  if (!exec_cmd) {
    REGISTER_SO(exec_cmd);
    exec_cmd = scheme_make_path(s);
  }

  return exec_cmd;
#endif
}

Definition at line 132 of file file.c.

Definition at line 5961 of file file.c.

Here is the caller graph for this function:

Definition at line 5935 of file file.c.

{
#ifndef NO_FILE_SYSTEM_UTILS
  if (!run_cmd) {
    REGISTER_SO(run_cmd);
    run_cmd = scheme_make_path(s);
  }

  return run_cmd;
#endif
}
Scheme_Object* scheme_split_path ( const char *  path,
int  len,
Scheme_Object **  base_out,
int id_out,
int  kind 
)

Definition at line 3402 of file file.c.

{
  return do_split_path(path, len, base_out, id_out, NULL, kind);
}

Here is the call graph for this function:

static Scheme_Object * simplify_path ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 4529 of file file.c.

{
  char *s;
  int len, use_fs, kind;
  Scheme_Object *bs, *r;

  if (!SCHEME_GENERAL_PATH_STRINGP(argv[0]))
    scheme_wrong_type("simplify-path", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  bs = TO_PATH(argv[0]);

  s = SCHEME_PATH_VAL(bs);
  len = SCHEME_PATH_LEN(bs);

  if (has_null(s, len))
    raise_null_error("simplify-path", argv[0], "");

  use_fs = ((argc <= 1) || SCHEME_TRUEP(argv[1]));
  kind = SCHEME_PATH_KIND(bs);

  if (use_fs && (kind != SCHEME_PLATFORM_PATH_KIND)) {
    scheme_arg_mismatch("simplify-path",
                        "in use-filesystem mode, path is not for the current platform: ",
                        argv[0]);
  }
  
  r = do_simplify_path(bs, scheme_null, 0, use_fs, 0, kind);

  if (SCHEME_FALSEP(r)) {
    /* Input was just 'same: */
    return scheme_make_sized_offset_kind_path((kind == SCHEME_WINDOWS_PATH_KIND) ? ".\\" : "./", 0, 2, 0, kind);
  }

  return r;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* simplify_qm_path ( Scheme_Object path) [static]

Definition at line 3997 of file file.c.

{
  /* path is already expanded, so the only remaining
     clean-ups are dropping a trailing separator,
     and getting rid of \\?\ if it's not actually needed. */
  char *s = SCHEME_PATH_VAL(path);
  int drive_end, clean_start, len = SCHEME_PATH_LEN(path), fixed = 0, i;
  int drop_extra_slash = -1, set_slash = -1, element_start;
  int found_bad = 0, start_special_check = 0, is_dir = 0, norm_unc = 0, drop_ss_slash = 0;

  if ((s[len - 1] == '\\')
      && (s[len - 2] != '\\')
      && do_path_to_directory_path(s, 0, len - 1, scheme_true, 1, SCHEME_WINDOWS_PATH_KIND)) {
    --len;
    fixed = 1;
  }

  check_dos_slashslash_qm(s, len, &drive_end, &clean_start, NULL);
  if ((drive_end == 7)
      && is_drive_letter(s[4])
      && (s[5] == ':')) {
    /* Maybe don't need \\?\ for \\?\C:\... */
    start_special_check = 7;
    drive_end = 4;
  } else if ((drive_end == 8)
            && (s[4] == '\\')
            && is_drive_letter(s[5])
            && (s[6] == ':')) {
    /* Maybe don't need \\?\\ for \\?\\C:\... */
    start_special_check = 8;
    drive_end = 5;
    drop_ss_slash = 1;
  } else if (drive_end == -2) {
    /* \\?\RED\ */
    int lit_start;
    get_slashslash_qm_dot_ups_end(s, len, &lit_start);
    start_special_check = lit_start;
    drive_end = lit_start - 1;
  } else if (drive_end < 0) {
    int lit_start, dots_end;
    dots_end = get_slashslash_qm_dot_ups_end(s, len, &lit_start);
    if (lit_start == len) {
      /* just keep the dots */
      return scheme_path_to_directory_path(scheme_make_sized_offset_kind_path(s, 8, dots_end - 8, 1, SCHEME_WINDOWS_PATH_KIND));
    }
    start_special_check = lit_start;
    if (dots_end < 9)
      drive_end = lit_start; /* no dots, so just keep the literal part */
    else {
      drive_end = 8; /* \\?\REL\..\, and we keep the .. */
      drop_extra_slash = dots_end;
      is_dir = 1;
    }
  } else if ((clean_start == 7) 
            && ((s[4] == 'U') || (s[4] == 'u'))
            && ((s[5] == 'N') || (s[5] == 'n'))
            && ((s[6] == 'C') || (s[6] == 'c'))) {
    if (drive_end == len) {
      is_dir = 1;
    }
    drive_end = 6;
    start_special_check = 7; /* \\?\UNC */
    set_slash = 6;
    norm_unc = 1;
  } else if ((clean_start == 8) 
            && (s[4] == '\\')
            && ((s[5] == 'U') || (s[5] == 'u'))
            && ((s[6] == 'N') || (s[6] == 'n'))
            && ((s[7] == 'C') || (s[7] == 'c'))) {
    if (drive_end == len) {
      is_dir = 1;
    }
    drive_end = 7;
    start_special_check = 8; /* \\?\\UNC */
    set_slash = 7;
    norm_unc = 1;
    drop_ss_slash = 1;
  } else {
    /* We have a weird root. Give up. */
    found_bad = 1;
    start_special_check = len;
  }

  if (!found_bad) {
    element_start = start_special_check;
    for (i = element_start; 1; i++) {
      if ((i == len) || (s[i] == '\\')) {
       if (element_start <= i - 1) {
         /* Need the protection? */
         Scheme_Object *v;
         int any_more = 0, j;
       
         for (j = i+1; j < len; j++) {
           if (s[j] != '\\') {
             any_more = 1;
             break;
           }
         }
       
         v = make_protected_sized_offset_path(1, 
                                          s, element_start, i - element_start,
                                          1, 
                                          (any_more ? 2 : 1),
                                               SCHEME_WINDOWS_PATH_KIND);
         if (SCHEME_TRUEP(v)) {
           found_bad = 1;
           break;
         }
       }
       if (i == len)
         break;
       element_start = i + 1;
      }
    }
  }

  if (found_bad) {
    if (norm_unc) {
      if ((s[4 + drop_ss_slash] == 'U')
         && (s[5 + drop_ss_slash] == 'N')
         && (s[6 + drop_ss_slash] == 'C'))
       norm_unc = 0;
    }
    if (norm_unc || drop_ss_slash) {
      if (!fixed) {
       char *naya;
       naya = (char *)scheme_malloc_atomic(len);
       memcpy(naya, s, len);
       s = naya;
       fixed = 1;
      }
      if (drop_ss_slash) {
       memmove(s + 3, s + 4, len - 4);
       len--;
      }
      if (norm_unc) {
       s[4] = 'U';
       s[5] = 'N';
       s[6] = 'C';
      }
    }
    if (fixed)
      path = scheme_make_sized_offset_kind_path(s, 0, len, 1, SCHEME_WINDOWS_PATH_KIND);
    return path;
  } else {
    if (drop_extra_slash > -1) {
      char *naya;
      naya = (char *)scheme_malloc_atomic(len);
      memcpy(naya, s, drop_extra_slash);
      memcpy(naya + drop_extra_slash, s + drop_extra_slash + 1, len - drop_extra_slash - 1);
      s = naya;
      --len;
    }
    if (set_slash > -1) {
      char *naya;
      naya = (char *)scheme_malloc_atomic(len);
      memcpy(naya, s, len);
      naya[set_slash] = '\\';
      s = naya;
    }
    path = scheme_make_sized_offset_kind_path(s, drive_end, len - drive_end, 1, SCHEME_WINDOWS_PATH_KIND);
    if (is_dir)
      path = scheme_path_to_directory_path(path);
    return path;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * split_path ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3408 of file file.c.

{
  char *s;
  int is_dir, len;
  Scheme_Object *three[3], *inpath;

  inpath = argv[0];

  if (!SCHEME_GENERAL_PATH_STRINGP(inpath))
    scheme_wrong_type("split-path", SCHEME_GENERAL_PATH_STRING_STR, 0, argc, argv);

  inpath = TO_PATH(inpath);

  s = SCHEME_PATH_VAL(inpath);
  len = SCHEME_PATH_LEN(inpath);

  if (!len) {
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "split-path: path is an empty string");
  }

  if (has_null(s, len))
    raise_null_error("split-path", inpath, "");

  three[1] = scheme_split_path(s, len, &three[0], &is_dir, SCHEME_PATH_KIND(inpath));

  three[2] = is_dir ? scheme_true : scheme_false;

  return scheme_values(3, three);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * string_to_path ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 900 of file file.c.

{
  Scheme_Object *p;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string->path", "string", 0, argc, argv);

  p = scheme_char_string_to_path(argv[0]);
  
  check_path_ok("string->path", p, argv[0]);

  return p;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * string_to_path_element ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 985 of file file.c.

{
  Scheme_Object *b;

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("string->path-element", "string", 0, argc, argv);

  b = scheme_char_string_to_byte_string_locale(argv[0]);
  
  return do_bytes_to_path_element("string->path-element", b, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

char* strip_trailing_spaces ( const char *  s,
int _len,
int  delta,
int  in_place 
)

Definition at line 1571 of file file.c.

{
  int len, skip_end = 0;

  if (_len)
    len = *_len;
  else
    len = strlen(s);

  /* Keep separators that are at the very end: */
  if ((len - skip_end > delta) && IS_A_DOS_SEP(s[len - 1 - skip_end])) {
    skip_end++;
  }

  if ((len - skip_end > delta) 
      && ((s[len - 1 - skip_end] == ' ') || (s[len - 1 - skip_end] == '.'))) {
    char *t;
    int orig_len = len;

    while ((len - skip_end > delta) 
          && ((s[len - 1 - skip_end] == ' ') || (s[len - 1 - skip_end] == '.'))) {
      len--;
    }

    /* If the path element doesn't contain any non-space non-. chars, don't
       strip them after all. */
    if ((len - skip_end > delta) && !IS_A_DOS_SEP(s[len - 1 - skip_end])) {
      if (in_place)
       t = (char *)s;
      else {
       t = (char *)scheme_malloc_atomic(len + 1);
       memcpy(t, s, len - skip_end);
      }
      memcpy(t + len - skip_end, t + orig_len - skip_end, skip_end);
      t[len] = 0;
      
      if (_len)
       *_len = len;
      
      return t;
    }
  }

  return (char *)s;
}

Here is the caller graph for this function:

static Scheme_Object * use_compiled_kind ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5598 of file file.c.

{
  return scheme_param_config("use-compiled-file-paths",
                          scheme_make_integer(MZCONFIG_USE_COMPILED_KIND),
                          argc, argv,
                          -1, compiled_kind_p, "list of relative paths and strings", 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * use_user_paths ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5606 of file file.c.

{
  return scheme_param_config("use-user-specific-search-paths", 
                          scheme_make_integer(MZCONFIG_USE_USER_PATHS),
                          argc, argv,
                          -1, NULL, NULL, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

Definition at line 227 of file file.c.

Definition at line 226 of file file.c.

Definition at line 229 of file file.c.

Definition at line 224 of file file.c.

Definition at line 224 of file file.c.

Definition at line 229 of file file.c.

Definition at line 226 of file file.c.

Definition at line 221 of file file.c.

Definition at line 223 of file file.c.

Definition at line 225 of file file.c.

Definition at line 225 of file file.c.

Definition at line 227 of file file.c.

Definition at line 229 of file file.c.

Definition at line 223 of file file.c.

Definition at line 227 of file file.c.

Definition at line 221 of file file.c.

Definition at line 218 of file file.c.

Scheme_Object * run_cmd [static]

Definition at line 229 of file file.c.

Definition at line 226 of file file.c.

Definition at line 219 of file file.c.

Definition at line 131 of file file.c.

char* special_filenames[] [static]
Initial value:
 { "NUL", "CON", "PRN", "AUX", 
                                     "COM1", "COM2", "COM3", "COM4", "COM5", 
                                     "COM6", "COM7", "COM8", "COM9",
                                     "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", 
                                     "LPT6", "LPT7", "LPT8", "LPT9", NULL }

Definition at line 1619 of file file.c.

Definition at line 225 of file file.c.

Definition at line 223 of file file.c.

Definition at line 231 of file file.c.

Definition at line 218 of file file.c.

Definition at line 231 of file file.c.

Definition at line 221 of file file.c.