mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-02-20 06:00:23 -08:00
pathnames: handle unicode characters
On Unix, pathnames are converted into the default encoding specified by ext:*default-external-format* and back. On Windows, the operating system already gives us utf16 encoded pathnames, so we use those. ecl_namestring with ECL_NAMESTRING_FORCE_BASE_STRING encodes with the specified encoding. Decoding is handled individually in the filesystem functions. Includes a minor refactor of list_directory, changing the PARSE_DIRECTORY_ENTRY macro into an inline function. Closes #609, #549.
This commit is contained in:
Marius Gerbershagen
parent
57f1597d86
commit
ff8cf4d3c1
13 changed files with 510 additions and 333 deletions
|
|
@ -29,7 +29,10 @@
|
|||
|
||||
* Pending changes since 21.2.1
|
||||
** Enhancements
|
||||
- Add hook functions for cl:ed via ext:*ed-functions* list
|
||||
- Support for non-ascii characters in pathnames. Pathname encoding defaults
|
||||
to utf-8 on Unix and may be changed using ~ext:*default-external-format*~
|
||||
(Windows always uses the utf-16 format provided by the OS).
|
||||
- Add hook functions for cl:ed via ext:*ed-functions* list)
|
||||
* 21.2.1 changes since 20.4.24
|
||||
** Announcement
|
||||
Dear Community,
|
||||
|
|
|
|||
|
|
@ -109,14 +109,14 @@ copy_object_file(cl_object original)
|
|||
*/
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
ecl_disable_interrupts();
|
||||
err = !CopyFile(original->base_string.self, copy->base_string.self, 0);
|
||||
err = !ecl_CopyFile(ecl_filename_self(original), ecl_filename_self(copy), 0);
|
||||
ecl_enable_interrupts();
|
||||
if (err) {
|
||||
FEwin32_error("Error when copying file from~&~3T~A~&to~&~3T~A",
|
||||
2, original, copy);
|
||||
}
|
||||
#else
|
||||
err = Null(si_copy_file(original, copy));
|
||||
err = Null(si_copy_file(ecl_decode_filename(original,ECL_NIL), copy));
|
||||
if (err) {
|
||||
FEerror("Error when copying file from~&~3T~A~&to~&~3T~A",
|
||||
2, original, copy);
|
||||
|
|
@ -125,12 +125,12 @@ copy_object_file(cl_object original)
|
|||
#ifdef cygwin
|
||||
{
|
||||
cl_object new_copy = @".dll";
|
||||
new_copy = si_base_string_concatenate(2, copy, new_copy);
|
||||
cl_rename_file(2, copy, new_copy);
|
||||
new_copy = ecl_concatenate_filename(copy, new_copy);
|
||||
cl_rename_file(2, ecl_decode_filename(copy,ECL_NIL), ecl_decode_filename(new_copy,ECL_NIL));
|
||||
copy = new_copy;
|
||||
}
|
||||
ecl_disable_interrupts();
|
||||
err = chmod(copy->base_string.self, S_IRWXU) < 0;
|
||||
err = ecl_chmod(ecl_filename_self(copy), S_IRWXU) < 0;
|
||||
ecl_enable_interrupts();
|
||||
if (err) {
|
||||
FElibc_error("Unable to give executable permissions to ~A",
|
||||
|
|
@ -176,7 +176,7 @@ static void
|
|||
dlopen_wrapper(cl_object block)
|
||||
{
|
||||
cl_object filename = block->cblock.name;
|
||||
char *filename_string = (char*)filename->base_string.self;
|
||||
ecl_filename_char *filename_string = ecl_filename_self(filename);
|
||||
#ifdef HAVE_DLFCN_H
|
||||
block->cblock.handle = dlopen(filename_string, RTLD_NOW|RTLD_GLOBAL);
|
||||
#endif
|
||||
|
|
@ -196,7 +196,7 @@ dlopen_wrapper(cl_object block)
|
|||
}}
|
||||
#endif
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
block->cblock.handle = LoadLibrary(filename_string);
|
||||
block->cblock.handle = ecl_LoadLibrary(filename_string);
|
||||
#endif
|
||||
if (block->cblock.handle == NULL)
|
||||
set_library_error(block);
|
||||
|
|
@ -286,7 +286,7 @@ ecl_library_open(cl_object filename, bool force_reload) {
|
|||
bool self_destruct = 0;
|
||||
|
||||
/* Coerces to a file name but does not merge with cwd */
|
||||
filename = coerce_to_physical_pathname(filename);
|
||||
filename = si_coerce_to_physical_pathname(filename);
|
||||
filename = ecl_namestring(filename,
|
||||
ECL_NAMESTRING_TRUNCATE_IF_ERROR |
|
||||
ECL_NAMESTRING_FORCE_BASE_STRING);
|
||||
|
|
@ -438,7 +438,7 @@ ecl_library_close(cl_object block) {
|
|||
} ECL_WITH_GLOBAL_LOCK_END;
|
||||
if (block != ECL_NIL && block->cblock.self_destruct) {
|
||||
if (!Null(block->cblock.name)) {
|
||||
unlink((char*)block->cblock.name->base_string.self);
|
||||
ecl_unlink(ecl_filename_self(block->cblock.name));
|
||||
}
|
||||
}
|
||||
return success;
|
||||
|
|
|
|||
12
src/c/file.d
12
src/c/file.d
|
|
@ -2594,12 +2594,12 @@ cl_synonym_stream_symbol(cl_object strm)
|
|||
#endif
|
||||
|
||||
static int
|
||||
safe_open(const char *filename, int flags, ecl_mode_t mode)
|
||||
safe_open(const ecl_filename_char *filename, int flags, ecl_mode_t mode)
|
||||
{
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
int output;
|
||||
ecl_disable_interrupts_env(the_env);
|
||||
output = open(filename, flags, mode);
|
||||
output = ecl_open(filename, flags, mode);
|
||||
ecl_enable_interrupts_env(the_env);
|
||||
return output;
|
||||
}
|
||||
|
|
@ -2616,12 +2616,12 @@ safe_close(int f)
|
|||
}
|
||||
|
||||
static FILE *
|
||||
safe_fdopen(int fildes, const char *mode)
|
||||
safe_fdopen(int fildes, const ecl_filename_char *mode)
|
||||
{
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
FILE *output;
|
||||
ecl_disable_interrupts_env(the_env);
|
||||
output = fdopen(fildes, mode);
|
||||
output = ecl_fdopen(fildes, mode);
|
||||
ecl_enable_interrupts_env(the_env);
|
||||
return output;
|
||||
}
|
||||
|
|
@ -4323,7 +4323,7 @@ cl_object
|
|||
ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm,
|
||||
cl_fixnum byte_size, int flags, cl_object external_format)
|
||||
{
|
||||
char *mode; /* file open mode */
|
||||
ecl_filename_char *mode; /* file open mode */
|
||||
FILE *fp; /* file pointer */
|
||||
switch(smm) {
|
||||
case ecl_smm_input:
|
||||
|
|
@ -5461,7 +5461,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
|
|||
/* FILENAME is used only to access the actual file while a stream
|
||||
remembers the original pathname FN. -- jd 2020-03-27 */
|
||||
cl_object filename = si_coerce_to_filename(fn);
|
||||
char *fname = (char*)filename->base_string.self;
|
||||
ecl_filename_char *fname = ecl_filename_self(filename);
|
||||
|
||||
if (if_does_not_exist == @':create') {
|
||||
open_flags |= O_CREAT;
|
||||
|
|
|
|||
|
|
@ -206,7 +206,7 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
|
|||
}
|
||||
/* INV: coerce_to_file_pathname() creates a fresh new pathname object */
|
||||
source = cl_merge_pathnames(1, source);
|
||||
pathname = coerce_to_file_pathname(source);
|
||||
pathname = si_coerce_to_file_pathname(source);
|
||||
pntype = pathname->pathname.type;
|
||||
|
||||
filename = ECL_NIL;
|
||||
|
|
@ -233,8 +233,8 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
|
|||
/* If filename already has an extension, make sure
|
||||
that the file exists */
|
||||
cl_object kind;
|
||||
filename = si_coerce_to_filename(pathname);
|
||||
kind = si_file_kind(filename, ECL_T);
|
||||
filename = pathname;
|
||||
kind = si_file_kind(pathname, ECL_T);
|
||||
if (kind != @':file' && kind != @':special') {
|
||||
filename = ECL_NIL;
|
||||
} else {
|
||||
|
|
|
|||
15
src/c/main.d
15
src/c/main.d
|
|
@ -634,14 +634,13 @@ cl_boot(int argc, char **argv)
|
|||
GC_enable();
|
||||
|
||||
/*
|
||||
* Initialize default pathnames
|
||||
* Set *default-pathname-defaults* to a temporary fake value. We
|
||||
* will fix this when we have access to the condition system to
|
||||
* allow for error recovery when we can't parse the output of
|
||||
* getcwd.
|
||||
*/
|
||||
#if 1
|
||||
ECL_SET(@'*default-pathname-defaults*', si_getcwd(0));
|
||||
#else
|
||||
ECL_SET(@'*default-pathname-defaults*',
|
||||
ecl_make_pathname(ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL, ECL_NIL, @':local'));
|
||||
#endif
|
||||
|
||||
#ifdef ECL_THREADS
|
||||
ECL_SET(@'mp::*current-process*', env->own_process);
|
||||
|
|
@ -779,6 +778,12 @@ cl_boot(int argc, char **argv)
|
|||
|
||||
ecl_init_module(OBJNULL,init_lib_LSP);
|
||||
|
||||
ECL_HANDLER_CASE_BEGIN(env, ecl_list1(@'ext::stream-decoding-error')) {
|
||||
ECL_SET(@'*default-pathname-defaults*', si_getcwd(0));
|
||||
} ECL_HANDLER_CASE(1, c) {
|
||||
_ecl_funcall3(@'warn', @"Cannot initialize *DEFAULT-PATHNAME-DEFAULTS* with the current directory:~%~A~%", c);
|
||||
} ECL_HANDLER_CASE_END;
|
||||
|
||||
if (cl_fboundp(@'ext::make-encoding') != ECL_NIL) {
|
||||
maybe_fix_console_stream(cl_core.standard_input);
|
||||
maybe_fix_console_stream(cl_core.standard_output);
|
||||
|
|
|
|||
|
|
@ -843,16 +843,16 @@ cl_logical_pathname(cl_object x)
|
|||
@)
|
||||
|
||||
/*
|
||||
* coerce_to_file_pathname(P) converts P to a physical pathname,
|
||||
* for a file which is accesible in our filesystem.
|
||||
* si_coerce_to_file_pathname(P) converts P to a physical pathname,
|
||||
* for a file which is accessible in our filesystem.
|
||||
* INV: Wildcards are allowed.
|
||||
* INV: A fresh new copy of the pathname is created.
|
||||
* INV: The pathname is absolute.
|
||||
*/
|
||||
cl_object
|
||||
coerce_to_file_pathname(cl_object pathname)
|
||||
si_coerce_to_file_pathname(cl_object pathname)
|
||||
{
|
||||
pathname = coerce_to_physical_pathname(pathname);
|
||||
pathname = si_coerce_to_physical_pathname(pathname);
|
||||
pathname = cl_merge_pathnames(1, pathname);
|
||||
#if 0
|
||||
#if !defined(cygwin) && !defined(ECL_MS_WINDOWS_HOST)
|
||||
|
|
@ -871,11 +871,11 @@ coerce_to_file_pathname(cl_object pathname)
|
|||
}
|
||||
|
||||
/*
|
||||
* coerce_to_physical_pathname(P) converts P to a physical pathname,
|
||||
* si_coerce_to_physical_pathname(P) converts P to a physical pathname,
|
||||
* performing the appropriate transformation if P was a logical pathname.
|
||||
*/
|
||||
cl_object
|
||||
coerce_to_physical_pathname(cl_object x)
|
||||
si_coerce_to_physical_pathname(cl_object x)
|
||||
{
|
||||
x = cl_pathname(x);
|
||||
if (x->pathname.logical)
|
||||
|
|
@ -884,9 +884,9 @@ coerce_to_physical_pathname(cl_object x)
|
|||
}
|
||||
|
||||
/*
|
||||
* si_coerce_to_filename(P) converts P to a physical pathname and then to
|
||||
* a namestring. The output must always be a new simple-string which can
|
||||
* be used by the C library.
|
||||
* si_coerce_to_filename(P) converts P to a physical pathname and then
|
||||
* to a properly encoded namestring. The output is a new simple-string
|
||||
* or vector of utf-16 characters which can be used by the C library.
|
||||
* INV: No wildcards are allowed.
|
||||
*/
|
||||
cl_object
|
||||
|
|
@ -896,7 +896,7 @@ si_coerce_to_filename(cl_object pathname_orig)
|
|||
|
||||
/* We always go through the pathname representation and thus
|
||||
* cl_namestring() always outputs a fresh new string */
|
||||
pathname = coerce_to_file_pathname(pathname_orig);
|
||||
pathname = si_coerce_to_file_pathname(pathname_orig);
|
||||
if (cl_wild_pathname_p(1,pathname) != ECL_NIL)
|
||||
cl_error(3, @'file-error', @':pathname', pathname_orig);
|
||||
namestring = ecl_namestring(pathname,
|
||||
|
|
@ -1000,16 +1000,38 @@ ecl_namestring(cl_object x, int flags)
|
|||
{
|
||||
bool logical;
|
||||
cl_object l, y;
|
||||
cl_object buffer, host;
|
||||
cl_object buffer_string, buffer, host;
|
||||
bool truncate_if_unreadable = flags & ECL_NAMESTRING_TRUNCATE_IF_ERROR;
|
||||
|
||||
x = cl_pathname(x);
|
||||
|
||||
/* INV: Pathnames can only be created by mergin, parsing namestrings
|
||||
/* INV: Pathnames can only be created by merging, parsing namestrings
|
||||
* or using ecl_make_pathname(). In all of these cases ECL will complain
|
||||
* at creation time if the pathname has wrong components.
|
||||
*/
|
||||
buffer = ecl_make_string_output_stream(128, 1);
|
||||
#ifdef ECL_UNICODE
|
||||
if (flags & ECL_NAMESTRING_FORCE_BASE_STRING) {
|
||||
# ifdef ECL_MS_WINDOWS_HOST
|
||||
buffer_string = si_make_vector(@'ext::byte16', /* element-type */
|
||||
ecl_make_fixnum(128), /* size */
|
||||
ECL_T, /* adjustable */
|
||||
ecl_make_fixnum(0), /* fillp */
|
||||
ECL_NIL, /* displaced */
|
||||
ECL_NIL); /* displaced-offset */
|
||||
buffer = si_make_sequence_output_stream(3, buffer_string,
|
||||
@':external-format', @':ucs-2');
|
||||
# else
|
||||
buffer_string = ecl_alloc_adjustable_base_string(128);
|
||||
buffer = si_make_sequence_output_stream(1, buffer_string);
|
||||
# endif
|
||||
} else {
|
||||
buffer_string = ecl_alloc_adjustable_extended_string(128);
|
||||
buffer = si_make_string_output_stream_from_string(buffer_string);
|
||||
}
|
||||
#else
|
||||
buffer_string = ecl_alloc_adjustable_base_string(128);
|
||||
buffer = si_make_string_output_stream_from_string(buffer_string);
|
||||
#endif
|
||||
logical = x->pathname.logical;
|
||||
host = x->pathname.host;
|
||||
if (logical) {
|
||||
|
|
@ -1132,18 +1154,17 @@ ecl_namestring(cl_object x, int flags)
|
|||
return ECL_NIL;
|
||||
}
|
||||
}
|
||||
buffer = cl_get_output_stream_string(buffer);
|
||||
#ifdef ECL_UNICODE
|
||||
if (ECL_EXTENDED_STRING_P(buffer) &&
|
||||
(flags & ECL_NAMESTRING_FORCE_BASE_STRING)) {
|
||||
unlikely_if (!ecl_fits_in_base_string(buffer))
|
||||
FEerror("The filesystem does not accept filenames "
|
||||
"with extended characters: ~S",
|
||||
1, buffer);
|
||||
buffer = si_copy_to_simple_base_string(buffer);
|
||||
if (flags & ECL_NAMESTRING_FORCE_BASE_STRING) {
|
||||
#endif
|
||||
/* add null terminator */
|
||||
ecl_write_char('\0', buffer);
|
||||
buffer_string->base_string.fillp--;
|
||||
buffer_string->base_string.dim--;
|
||||
#ifdef ECL_UNICODE
|
||||
}
|
||||
#endif
|
||||
return buffer;
|
||||
return buffer_string;
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
@ -1530,7 +1551,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
|
|||
@
|
||||
/* Check that host is a valid host name */
|
||||
if (ecl_unlikely(!ECL_STRINGP(host)))
|
||||
FEwrong_type_nth_arg(@[si::pathname-translations], 1, host, @[string]);
|
||||
FEwrong_type_nth_arg(@[si::pathname-translations], 1, host, @[string]);
|
||||
host = cl_string_upcase(1, host);
|
||||
len = ecl_length(host);
|
||||
parse_word(host, is_null, WORD_LOGICAL, 0, len, &parsed_len);
|
||||
|
|
|
|||
|
|
@ -1168,9 +1168,11 @@ cl_symbols[] = {
|
|||
{SYS_ "CLEAR-COMPILER-PROPERTIES" ECL_FUN("cl_identity", cl_identity, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-BASE-STRING" ECL_FUN("si_coerce_to_base_string", si_coerce_to_base_string, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-EXTENDED-STRING" ECL_FUN("si_coerce_to_extended_string", si_coerce_to_extended_string, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-FILE-PATHNAME" ECL_FUN("si_coerce_to_file_pathname", si_coerce_to_file_pathname, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-FILENAME" ECL_FUN("si_coerce_to_filename", si_coerce_to_filename, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-FUNCTION" ECL_FUN("si_coerce_to_function", si_coerce_to_function, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-PACKAGE" ECL_FUN("si_coerce_to_package", si_coerce_to_package, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COERCE-TO-PHYSICAL-PATHNAME" ECL_FUN("si_coerce_to_physical_pathname", si_coerce_to_physical_pathname, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COPY-TO-SIMPLE-BASE-STRING" ECL_FUN("si_copy_to_simple_base_string", si_copy_to_simple_base_string, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{SYS_ "COMPILED-FUNCTION-BLOCK" ECL_FUN("si_compiled_function_block", si_compiled_function_block, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
|
||||
{EXT_ "COMPILED-FUNCTION-NAME" ECL_FUN("si_compiled_function_name", si_compiled_function_name, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
|
||||
|
|
|
|||
557
src/c/unixfsys.d
557
src/c/unixfsys.d
|
|
@ -21,7 +21,6 @@
|
|||
#else
|
||||
# include <io.h>
|
||||
# include <direct.h>
|
||||
# define access _access
|
||||
# define F_OK 0
|
||||
typedef int mode_t;
|
||||
#endif
|
||||
|
|
@ -49,35 +48,145 @@ typedef int mode_t;
|
|||
#include <fcntl.h>
|
||||
#include <errno.h>
|
||||
|
||||
#if defined(ECL_MS_WINDOWS_HOST) && defined(ECL_UNICODE)
|
||||
cl_object
|
||||
ecl_make_simple_filename(const ecl_filename_char *x, cl_fixnum size)
|
||||
{
|
||||
if (size < 0) {
|
||||
size = wcslen(x);
|
||||
}
|
||||
cl_object vec = si_make_vector(@'ext::byte16', /* element-type */
|
||||
ecl_make_fixnum(size+1), /* size */
|
||||
ECL_NIL, /* adjustable */
|
||||
ECL_NIL, /* fillp */
|
||||
ECL_NIL, /* displaced */
|
||||
ECL_NIL); /* displaced-offset */
|
||||
for (cl_index i = 0; i < size; i++) {
|
||||
vec->vector.self.b16[i] = x[i];
|
||||
}
|
||||
vec->vector.self.b16[size] = 0;
|
||||
/* use the same trick as for base strings to store the null
|
||||
* terminator: allocate one element more, adjust fill-pointer and
|
||||
* dimension */
|
||||
vec->vector.fillp = vec->vector.dim = size;
|
||||
return vec;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_concatenate_filename(cl_object x, cl_object y)
|
||||
{
|
||||
cl_index size = x->vector.fillp + y->vector.fillp;
|
||||
cl_object vec = si_make_vector(@'ext::byte16', /* element-type */
|
||||
ecl_make_fixnum(size+1), /* size */
|
||||
ECL_NIL, /* adjustable */
|
||||
ECL_NIL, /* fillp */
|
||||
ECL_NIL, /* displaced */
|
||||
ECL_NIL); /* displaced-offset */
|
||||
if (x->vector.elttype == ecl_aet_bc) {
|
||||
for (cl_index i = 0; i < x->vector.fillp; i++) {
|
||||
vec->vector.self.b16[i] = x->vector.self.bc[i];
|
||||
}
|
||||
} else if (x->vector.elttype == ecl_aet_b16) {
|
||||
for (cl_index i = 0; i < x->vector.fillp; i++) {
|
||||
vec->vector.self.b16[i] = x->vector.self.b16[i];
|
||||
}
|
||||
} else {
|
||||
ecl_internal_error("Wrong type for first argument to ecl_concatenate_filename");
|
||||
}
|
||||
if (y->vector.elttype == ecl_aet_bc) {
|
||||
for (cl_index i = 0; i < y->vector.fillp; i++) {
|
||||
vec->vector.self.b16[i + x->vector.fillp] = y->vector.self.bc[i];
|
||||
}
|
||||
} else if (y->vector.elttype == ecl_aet_b16) {
|
||||
for (cl_index i = 0; i < y->vector.fillp; i++) {
|
||||
vec->vector.self.b16[i + x->vector.fillp] = y->vector.self.b16[i];
|
||||
}
|
||||
} else {
|
||||
ecl_internal_error("Wrong type for second argument to ecl_concatenate_filename");
|
||||
}
|
||||
vec->vector.self.b16[size] = 0;
|
||||
vec->vector.fillp = vec->vector.dim = size;
|
||||
return vec;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_alloc_filename(cl_index len, cl_object adjustable)
|
||||
{
|
||||
cl_object ret = si_make_vector(@'ext::byte16', /* element-type */
|
||||
ecl_make_fixnum(len+1),/* size */
|
||||
adjustable, /* adjustable */
|
||||
ecl_make_fixnum(0), /* fillp */
|
||||
ECL_NIL, /* displaced */
|
||||
ECL_NIL); /* displaced-offset */
|
||||
ret->vector.self.b16[len] = 0;
|
||||
ret->vector.fillp = ret->vector.dim = len;
|
||||
return ret;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_decode_filename(cl_object x, cl_object len)
|
||||
{
|
||||
return si_octets_to_string(5, x,
|
||||
@':end', len,
|
||||
@':external-format', @':ucs-2');
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_encode_filename(cl_object x, cl_object len)
|
||||
{
|
||||
return si_string_to_octets(9, x,
|
||||
@':end', len,
|
||||
@':null-terminate', ECL_T,
|
||||
@':element-type', @'ext::byte16',
|
||||
@':external-format', @':ucs-2');
|
||||
}
|
||||
|
||||
#else
|
||||
cl_object
|
||||
ecl_decode_filename(cl_object x, cl_object len)
|
||||
{
|
||||
return si_octets_to_string(3, x, @':end', len);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_encode_filename(cl_object x, cl_object len)
|
||||
{
|
||||
return si_string_to_octets(7, x,
|
||||
@':end', len,
|
||||
@':null-terminate', ECL_T,
|
||||
@':element-type', @'base-char');
|
||||
}
|
||||
#endif
|
||||
|
||||
static int
|
||||
safe_chdir(const char *path, cl_object prefix)
|
||||
safe_chdir(const ecl_filename_char *path, cl_object prefix)
|
||||
{
|
||||
if (prefix != ECL_NIL) {
|
||||
cl_object aux = ecl_make_constant_base_string(path,-1);
|
||||
aux = si_base_string_concatenate(2, prefix, aux);
|
||||
return safe_chdir((char *)aux->base_string.self, ECL_NIL);
|
||||
cl_object aux = ecl_make_constant_filename(path,-1);
|
||||
aux = ecl_concatenate_filename(prefix, aux);
|
||||
return safe_chdir(ecl_filename_self(aux), ECL_NIL);
|
||||
} else {
|
||||
int output;
|
||||
ecl_disable_interrupts();
|
||||
output = chdir((char *)path);
|
||||
output = ecl_chdir((ecl_filename_char *)path);
|
||||
ecl_enable_interrupts();
|
||||
return output;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
safe_stat(const char *path, struct stat *sb)
|
||||
safe_stat(const ecl_filename_char *path, ecl_stat_struct *sb)
|
||||
{
|
||||
int output;
|
||||
ecl_disable_interrupts();
|
||||
output = stat(path, sb);
|
||||
output = ecl_stat(path, sb);
|
||||
ecl_enable_interrupts();
|
||||
return output;
|
||||
}
|
||||
|
||||
#ifdef HAVE_LSTAT
|
||||
static int
|
||||
safe_lstat(const char *path, struct stat *sb)
|
||||
safe_lstat(const ecl_filename_char *path, ecl_stat_struct *sb)
|
||||
{
|
||||
int output;
|
||||
ecl_disable_interrupts();
|
||||
|
|
@ -87,59 +196,23 @@ safe_lstat(const char *path, struct stat *sb)
|
|||
}
|
||||
#endif
|
||||
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
static cl_object
|
||||
drive_host_prefix(cl_object pathname)
|
||||
{
|
||||
cl_object device = pathname->pathname.device;
|
||||
cl_object host = pathname->pathname.host;
|
||||
cl_object output = ECL_NIL;
|
||||
if (device != ECL_NIL) {
|
||||
output = ecl_make_simple_base_string("X:",-1);
|
||||
output->base_string.self[0] = device->base_string.self[0];
|
||||
}
|
||||
if (host != ECL_NIL) {
|
||||
cl_object slash = cl_core.slash;
|
||||
if (output != ECL_NIL)
|
||||
output = si_base_string_concatenate(5, output, slash, slash,
|
||||
host, slash);
|
||||
else
|
||||
output = si_base_string_concatenate(4, slash, slash, host,
|
||||
slash);
|
||||
}
|
||||
return output;
|
||||
}
|
||||
#else
|
||||
#define drive_host_prefix(x) ECL_NIL
|
||||
#endif
|
||||
|
||||
/*
|
||||
* string_to_pathanme, to be used when s is a real pathname
|
||||
*/
|
||||
cl_object
|
||||
ecl_cstring_to_pathname(char *s)
|
||||
{
|
||||
cl_object string = ecl_make_simple_base_string(s, -1);
|
||||
return cl_parse_namestring(1, string);
|
||||
}
|
||||
|
||||
/*
|
||||
* Finds current directory by using getcwd() with an adjustable
|
||||
* string which grows until it can host the whole path.
|
||||
*/
|
||||
static cl_object
|
||||
current_dir(void) {
|
||||
cl_object output;
|
||||
const char *ok;
|
||||
ecl_filename_char *output;
|
||||
const ecl_filename_char *ok;
|
||||
#ifdef _MSC_VER
|
||||
unsigned char *c;
|
||||
ecl_filename_char *c;
|
||||
#endif
|
||||
cl_index size = 128;
|
||||
|
||||
do {
|
||||
output = ecl_alloc_adjustable_base_string(size+2);
|
||||
output = ecl_alloc_atomic((size+2)*sizeof(ecl_filename_char));
|
||||
ecl_disable_interrupts();
|
||||
ok = getcwd((char*)output->base_string.self, size);
|
||||
ok = ecl_getcwd(output, size);
|
||||
if (ok == NULL && errno != ERANGE) {
|
||||
perror("ext::getcwd error");
|
||||
ecl_internal_error("Can't work without CWD");
|
||||
|
|
@ -147,18 +220,17 @@ current_dir(void) {
|
|||
ecl_enable_interrupts();
|
||||
size += 256;
|
||||
} while (ok == NULL);
|
||||
size = strlen((char*)output->base_string.self);
|
||||
size = ecl_fstrlen(output);
|
||||
#ifdef _MSC_VER
|
||||
for (c = output->base_string.self; *c; c++) {
|
||||
for (c = output; *c; c++) {
|
||||
if (*c == '\\') *c = '/';
|
||||
}
|
||||
#endif
|
||||
if (output->base_string.self[size-1] != '/') {
|
||||
output->base_string.self[size++] = '/';
|
||||
output->base_string.self[size] = '\0';
|
||||
if (output[size-1] != '/') {
|
||||
output[size++] = '/';
|
||||
output[size] = '\0';
|
||||
}
|
||||
output->base_string.fillp = size;
|
||||
return output;
|
||||
return ecl_make_constant_filename(output, size);
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
@ -166,12 +238,12 @@ current_dir(void) {
|
|||
*/
|
||||
|
||||
static cl_object
|
||||
file_kind(char *filename, bool follow_links) {
|
||||
file_kind(ecl_filename_char *filename, bool follow_links) {
|
||||
cl_object output;
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
DWORD dw;
|
||||
ecl_disable_interrupts();
|
||||
dw = GetFileAttributes( filename );
|
||||
dw = ecl_GetFileAttributes( filename );
|
||||
if (dw == -1)
|
||||
output = ECL_NIL;
|
||||
else if ( dw & FILE_ATTRIBUTE_DIRECTORY )
|
||||
|
|
@ -180,7 +252,7 @@ file_kind(char *filename, bool follow_links) {
|
|||
output = @':file';
|
||||
ecl_enable_interrupts();
|
||||
#else
|
||||
struct stat buf;
|
||||
ecl_stat_struct buf;
|
||||
# ifdef HAVE_LSTAT
|
||||
if ((follow_links? safe_stat : safe_lstat)(filename, &buf) < 0)
|
||||
# else
|
||||
|
|
@ -208,7 +280,7 @@ file_kind(char *filename, bool follow_links) {
|
|||
cl_object
|
||||
si_file_kind(cl_object filename, cl_object follow_links) {
|
||||
filename = si_coerce_to_filename(filename);
|
||||
@(return file_kind((char*)filename->base_string.self, !Null(follow_links)));
|
||||
@(return file_kind(ecl_filename_self(filename), !Null(follow_links)));
|
||||
}
|
||||
|
||||
#if defined(HAVE_LSTAT) && !defined(ECL_MS_WINDOWS_HOST)
|
||||
|
|
@ -217,24 +289,23 @@ si_readlink(cl_object filename) {
|
|||
/* Given a filename which is a symlink, this routine returns
|
||||
* the value of this link in the form of a pathname. */
|
||||
cl_index size = 128, written;
|
||||
cl_object output, kind;
|
||||
char *output;
|
||||
cl_object kind;
|
||||
do {
|
||||
/* We reserve 2 characters for trailing '/' and '\0' */
|
||||
output = ecl_alloc_adjustable_base_string(size+2);
|
||||
output = ecl_alloc_atomic(size+2);
|
||||
ecl_disable_interrupts();
|
||||
written = readlink((char*)filename->base_string.self,
|
||||
(char*)output->base_string.self, size);
|
||||
written = readlink(ecl_filename_self(filename), output, size);
|
||||
ecl_enable_interrupts();
|
||||
size += 256;
|
||||
} while (written == size-256);
|
||||
output->base_string.self[written] = '\0';
|
||||
kind = file_kind((char*)output->base_string.self, FALSE);
|
||||
output[written] = '\0';
|
||||
kind = file_kind(output, FALSE);
|
||||
if (kind == @':directory') {
|
||||
output->base_string.self[written++] = '/';
|
||||
output->base_string.self[written] = '\0';
|
||||
output[written++] = '/';
|
||||
output[written] = '\0';
|
||||
}
|
||||
output->base_string.fillp = written;
|
||||
return output;
|
||||
return ecl_decode_filename(ecl_make_constant_filename(output, written), ECL_NIL);
|
||||
}
|
||||
#endif /* HAVE_LSTAT */
|
||||
|
||||
|
|
@ -254,12 +325,6 @@ enter_directory(cl_object base_dir, cl_object subdir, bool ignore_if_failure)
|
|||
return base_dir;
|
||||
} else if (subdir == @':up') {
|
||||
aux = @"..";
|
||||
} else if (!ECL_BASE_STRING_P(subdir)) {
|
||||
unlikely_if (!ecl_fits_in_base_string(subdir))
|
||||
FEerror("Directory component ~S found in pathname~& ~S"
|
||||
"~&is not allowed in TRUENAME or DIRECTORY",
|
||||
1, subdir);
|
||||
aux = si_coerce_to_base_string(subdir);
|
||||
} else {
|
||||
aux = subdir;
|
||||
}
|
||||
|
|
@ -271,8 +336,8 @@ enter_directory(cl_object base_dir, cl_object subdir, bool ignore_if_failure)
|
|||
aux = ecl_namestring(output, ECL_NAMESTRING_FORCE_BASE_STRING);
|
||||
/* We remove the trailing '/' from the namestring because the
|
||||
* POSIX library does not like it. */
|
||||
aux->base_string.self[--aux->base_string.fillp] = 0;
|
||||
kind = file_kind((char*)aux->base_string.self, FALSE);
|
||||
ecl_filename_self(aux)[--aux->base_string.fillp] = 0;
|
||||
kind = file_kind(ecl_filename_self(aux), FALSE);
|
||||
if (kind == ECL_NIL) {
|
||||
if (ignore_if_failure) return ECL_NIL;
|
||||
FEcannot_open(output);
|
||||
|
|
@ -309,9 +374,8 @@ enter_directory(cl_object base_dir, cl_object subdir, bool ignore_if_failure)
|
|||
static cl_object
|
||||
make_absolute_pathname(cl_object orig_pathname)
|
||||
{
|
||||
cl_object base_dir = si_getcwd(0);
|
||||
cl_object pathname = coerce_to_file_pathname(orig_pathname);
|
||||
return ecl_merge_pathnames(pathname, base_dir, @':default');
|
||||
/* INV: si_coerce_to_file_pathname creates an absolute pathname */
|
||||
return si_coerce_to_file_pathname(orig_pathname);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -341,17 +405,17 @@ file_truename(cl_object pathname, cl_object filename, int flags)
|
|||
FEerror("Unprintable pathname ~S found in TRUENAME", 1, pathname);
|
||||
}
|
||||
}
|
||||
kind = file_kind((char*)filename->base_string.self, FALSE);
|
||||
kind = file_kind(ecl_filename_self(filename), FALSE);
|
||||
if (kind == ECL_NIL) {
|
||||
FEcannot_open(filename);
|
||||
FEcannot_open(pathname);
|
||||
#ifdef HAVE_LSTAT
|
||||
} else if (kind == @':link' && (flags & FOLLOW_SYMLINKS)) {
|
||||
/* The link might be a relative pathname. In that case
|
||||
* we have to merge with the original pathname. On
|
||||
* the other hand, if the link is broken – return file
|
||||
* truename "as is". */
|
||||
struct stat filestatus;
|
||||
if (safe_stat((char*) filename->base_string.self, &filestatus) < 0) {
|
||||
ecl_stat_struct filestatus;
|
||||
if (safe_stat(ecl_filename_self(filename), &filestatus) < 0) {
|
||||
@(return pathname kind);
|
||||
}
|
||||
filename = si_readlink(filename);
|
||||
|
|
@ -368,8 +432,8 @@ file_truename(cl_object pathname, cl_object filename, int flags)
|
|||
separator and re-parsing again the namestring */
|
||||
if (pathname->pathname.name != ECL_NIL ||
|
||||
pathname->pathname.type != ECL_NIL) {
|
||||
pathname = si_base_string_concatenate
|
||||
(2, filename, @"/");
|
||||
pathname = ecl_concatenate_filename(filename, @"/");
|
||||
pathname = ecl_decode_filename(pathname, ECL_NIL);
|
||||
pathname = cl_truename(pathname);
|
||||
}
|
||||
}
|
||||
|
|
@ -416,41 +480,42 @@ cl_truename(cl_object orig_pathname)
|
|||
}
|
||||
|
||||
int
|
||||
ecl_backup_open(const char *filename, int option, int mode)
|
||||
ecl_backup_open(const ecl_filename_char *filename, int option, int mode)
|
||||
{
|
||||
char *backupfilename = ecl_alloc(strlen(filename) + 5);
|
||||
cl_index length = ecl_fstrlen(filename);
|
||||
ecl_filename_char *backupfilename = ecl_alloc_atomic((length + 5)*sizeof(ecl_filename_char));
|
||||
if (backupfilename == NULL) {
|
||||
FElibc_error("Cannot allocate memory for backup filename", 0);
|
||||
}
|
||||
|
||||
strcat(strcpy(backupfilename, filename), ".BAK");
|
||||
ecl_fstrcat(ecl_fstrcpy(backupfilename, filename), ecl_fstr(".BAK"));
|
||||
ecl_disable_interrupts();
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
/* Windows' rename doesn't replace an existing file */
|
||||
if (access(backupfilename, F_OK) == 0 && unlink(backupfilename)) {
|
||||
if (ecl_access(backupfilename, F_OK) == 0 && ecl_unlink(backupfilename)) {
|
||||
ecl_enable_interrupts();
|
||||
FElibc_error("Cannot remove the file ~S", 1,
|
||||
ecl_make_constant_base_string(backupfilename,-1));
|
||||
ecl_decode_filename(ecl_make_constant_filename(backupfilename,-1), ECL_NIL));
|
||||
}
|
||||
#endif
|
||||
if (rename(filename, backupfilename)) {
|
||||
if (ecl_rename(filename, backupfilename)) {
|
||||
ecl_enable_interrupts();
|
||||
FElibc_error("Cannot rename the file ~S to ~S.", 2,
|
||||
ecl_make_constant_base_string(filename,-1),
|
||||
ecl_make_constant_base_string(backupfilename,-1));
|
||||
ecl_decode_filename(ecl_make_constant_filename(filename,-1), ECL_NIL),
|
||||
ecl_decode_filename(ecl_make_constant_filename(backupfilename,-1), ECL_NIL));
|
||||
}
|
||||
ecl_enable_interrupts();
|
||||
ecl_dealloc(backupfilename);
|
||||
return open(filename, option, mode);
|
||||
return ecl_open(filename, option, mode);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_file_len(int f)
|
||||
{
|
||||
struct stat filestatus;
|
||||
ecl_stat_struct filestatus;
|
||||
memset(&filestatus, 0, sizeof(filestatus));
|
||||
ecl_disable_interrupts();
|
||||
fstat(f, &filestatus);
|
||||
ecl_fstat(f, &filestatus);
|
||||
ecl_enable_interrupts();
|
||||
#ifdef S_ISFIFO
|
||||
if (S_ISFIFO(filestatus.st_mode)) {
|
||||
|
|
@ -483,7 +548,7 @@ ecl_file_len(int f)
|
|||
|
||||
while (if_exists == @':error' || if_exists == ECL_NIL)
|
||||
{
|
||||
if (cl_probe_file(new_filename) == ECL_NIL) {
|
||||
if (file_kind(ecl_filename_self(new_filename), TRUE) == ECL_NIL) {
|
||||
if_exists = ECL_T;
|
||||
break;
|
||||
}
|
||||
|
|
@ -514,8 +579,8 @@ ecl_file_len(int f)
|
|||
ecl_disable_interrupts();
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
error = SetErrorMode(0);
|
||||
if (MoveFile((char*)old_filename->base_string.self,
|
||||
(char*)new_filename->base_string.self)) {
|
||||
if (ecl_MoveFile(ecl_filename_self(old_filename),
|
||||
ecl_filename_self(new_filename))) {
|
||||
SetErrorMode(error);
|
||||
goto SUCCESS;
|
||||
}
|
||||
|
|
@ -526,35 +591,23 @@ ecl_file_len(int f)
|
|||
default:
|
||||
goto FAILURE_CLOBBER;
|
||||
};
|
||||
if (MoveFileEx((char*)old_filename->base_string.self,
|
||||
(char*)new_filename->base_string.self,
|
||||
MOVEFILE_REPLACE_EXISTING)) {
|
||||
SetErrorMode(error);
|
||||
goto SUCCESS;
|
||||
}
|
||||
/* hack for win95/novell */
|
||||
chmod((char*)old_filename->base_string.self, 0777);
|
||||
chmod((char*)new_filename->base_string.self, 0777);
|
||||
SetFileAttributesA((char*)new_filename->base_string.self,
|
||||
FILE_ATTRIBUTE_NORMAL);
|
||||
SetFileAttributesA((char*)new_filename->base_string.self,
|
||||
FILE_ATTRIBUTE_TEMPORARY);
|
||||
if (MoveFile((char*)old_filename->base_string.self,
|
||||
(char*)new_filename->base_string.self)) {
|
||||
if (ecl_MoveFileEx(ecl_filename_self(old_filename),
|
||||
ecl_filename_self(new_filename),
|
||||
MOVEFILE_REPLACE_EXISTING)) {
|
||||
SetErrorMode(error);
|
||||
goto SUCCESS;
|
||||
}
|
||||
/* fallback on old behavior */
|
||||
(void)DeleteFileA((char*)new_filename->base_string.self);
|
||||
if (MoveFile((char*)old_filename->base_string.self,
|
||||
(char*)new_filename->base_string.self)) {
|
||||
ecl_DeleteFile(ecl_filename_self(new_filename));
|
||||
if (ecl_MoveFile(ecl_filename_self(old_filename),
|
||||
ecl_filename_self(new_filename))) {
|
||||
SetErrorMode(error);
|
||||
goto SUCCESS;
|
||||
}
|
||||
/* fall through */
|
||||
#else
|
||||
if (rename((char*)old_filename->base_string.self,
|
||||
(char*)new_filename->base_string.self) == 0) {
|
||||
if (ecl_rename(ecl_filename_self(old_filename),
|
||||
ecl_filename_self(new_filename)) == 0) {
|
||||
goto SUCCESS;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -597,7 +650,7 @@ cl_delete_file(cl_object file)
|
|||
int ok;
|
||||
|
||||
ecl_disable_interrupts();
|
||||
ok = (isdir? rmdir : unlink)((char*)filename->base_string.self);
|
||||
ok = (isdir? ecl_rmdir : ecl_unlink)(ecl_filename_self(filename));
|
||||
ecl_enable_interrupts();
|
||||
|
||||
if (ok < 0) {
|
||||
|
|
@ -628,8 +681,8 @@ cl_object
|
|||
cl_file_write_date(cl_object file)
|
||||
{
|
||||
cl_object time, filename = si_coerce_to_filename(file);
|
||||
struct stat filestatus;
|
||||
if (safe_stat((char*)filename->base_string.self, &filestatus) < 0) {
|
||||
ecl_stat_struct filestatus;
|
||||
if (safe_stat(ecl_filename_self(filename), &filestatus) < 0) {
|
||||
time = ECL_NIL;
|
||||
} else {
|
||||
time = UTC_time_to_universal_time(filestatus.st_mtime);
|
||||
|
|
@ -641,8 +694,8 @@ cl_object
|
|||
cl_file_author(cl_object file)
|
||||
{
|
||||
cl_object output, filename = si_coerce_to_filename(file);
|
||||
struct stat filestatus;
|
||||
if (safe_stat((char*)filename->base_string.self, &filestatus) < 0) {
|
||||
ecl_stat_struct filestatus;
|
||||
if (safe_stat(ecl_filename_self(filename), &filestatus) < 0) {
|
||||
const char *msg = "Unable to read file author for ~S."
|
||||
"~%C library error: ~S";
|
||||
cl_object c_error = _ecl_strerror(errno);
|
||||
|
|
@ -661,6 +714,7 @@ cl_file_author(cl_object file)
|
|||
pwent = getpwuid(filestatus.st_uid);
|
||||
ecl_enable_interrupts();
|
||||
output = ecl_make_simple_base_string(pwent->pw_name,-1);
|
||||
output = si_octets_to_string(1, output);
|
||||
}
|
||||
#else
|
||||
output = @"UNKNOWN";
|
||||
|
|
@ -673,20 +727,20 @@ ecl_homedir_pathname(cl_object user)
|
|||
{
|
||||
cl_index i;
|
||||
cl_object namestring;
|
||||
const char *h;
|
||||
const ecl_filename_char *h;
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
const char *d;
|
||||
const ecl_filename_char *d;
|
||||
#endif
|
||||
if (!Null(user)) {
|
||||
if (!Null(user)){
|
||||
#ifdef HAVE_PWD_H
|
||||
struct passwd *pwent = NULL;
|
||||
#endif
|
||||
char *p;
|
||||
ecl_filename_char *p;
|
||||
i = ecl_length(user);
|
||||
/* This ensures that our string has the right length
|
||||
and it is terminated with a '\0' */
|
||||
user = si_copy_to_simple_base_string(user);
|
||||
p = (char*)user->base_string.self;
|
||||
i = user->base_string.fillp;
|
||||
user = ecl_encode_filename(user, ECL_NIL);
|
||||
p = ecl_filename_self(user);
|
||||
if (i > 0 && *p == '~') {
|
||||
p++;
|
||||
i--;
|
||||
|
|
@ -697,28 +751,27 @@ ecl_homedir_pathname(cl_object user)
|
|||
pwent = getpwnam(p);
|
||||
if (pwent == NULL)
|
||||
FEerror("Unknown user ~S.", 1, p);
|
||||
namestring = ecl_make_simple_base_string(pwent->pw_dir,-1);
|
||||
namestring = ecl_make_simple_filename(pwent->pw_dir,-1);
|
||||
#endif
|
||||
FEerror("Unknown user ~S.", 1, p);
|
||||
} else if ((h = getenv("HOME"))) {
|
||||
namestring = ecl_make_simple_base_string(h,-1);
|
||||
} else if ((h = ecl_getenv(ecl_fstr("HOME")))) {
|
||||
namestring = ecl_make_simple_filename(h,-1);
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
} else if ((h = getenv("HOMEPATH")) && (d = getenv("HOMEDRIVE"))) {
|
||||
namestring =
|
||||
si_base_string_concatenate(2,
|
||||
ecl_make_constant_base_string(d,-1),
|
||||
ecl_make_constant_base_string(h,-1));
|
||||
} else if ((h = ecl_getenv(ecl_fstr("HOMEPATH"))) && (d = ecl_getenv(ecl_fstr("HOMEDRIVE")))) {
|
||||
namestring = ecl_concatenate_filename(ecl_make_constant_filename(d,-1),
|
||||
ecl_make_constant_filename(h,-1));
|
||||
#endif
|
||||
} else {
|
||||
namestring = @"/";
|
||||
}
|
||||
if (namestring->base_string.self[0] == '~') {
|
||||
if (ecl_filename_self(namestring)[0] == '~') {
|
||||
FEerror("Not a valid home pathname ~S", 1, namestring);
|
||||
}
|
||||
i = namestring->base_string.fillp;
|
||||
if (!IS_DIR_SEPARATOR(namestring->base_string.self[i-1]))
|
||||
namestring = si_base_string_concatenate(2, namestring,
|
||||
ECL_CODE_CHAR(DIR_SEPARATOR));
|
||||
if (!IS_DIR_SEPARATOR(ecl_filename_self(namestring)[i-1]))
|
||||
namestring = ecl_concatenate_filename(namestring,
|
||||
si_coerce_to_base_string(ECL_CODE_CHAR(DIR_SEPARATOR)));
|
||||
namestring = ecl_decode_filename(namestring, ECL_NIL);
|
||||
return cl_parse_namestring(3, namestring, ECL_NIL, ECL_NIL);
|
||||
}
|
||||
|
||||
|
|
@ -729,39 +782,40 @@ ecl_homedir_pathname(cl_object user)
|
|||
@)
|
||||
|
||||
static bool
|
||||
string_match(const char *s, cl_object pattern)
|
||||
string_match(const ecl_filename_char *s, cl_object pattern)
|
||||
{
|
||||
if (pattern == ECL_NIL || pattern == @':wild') {
|
||||
return 1;
|
||||
} else {
|
||||
cl_index ls = strlen(s);
|
||||
ecl_def_ct_base_string(strng, s, ls, /*auto*/, const);
|
||||
return ecl_string_match(strng, 0, ls,
|
||||
cl_object string_decoded = ecl_decode_filename(ecl_make_constant_filename(s,-1), ECL_NIL);
|
||||
return ecl_string_match(string_decoded, 0, string_decoded->base_string.fillp,
|
||||
pattern, 0, ecl_length(pattern));
|
||||
}
|
||||
}
|
||||
|
||||
/*XXX:*/
|
||||
#define PARSE_DIRECTORY_ENTRY \
|
||||
{ \
|
||||
cl_object component, component_path, kind; \
|
||||
if (text[0] == '.' && \
|
||||
(text[1] == '\0' || \
|
||||
(text[1] == '.' && text[2] == '\0'))) \
|
||||
continue; \
|
||||
if (!string_match(text, text_mask)) \
|
||||
continue; \
|
||||
component = ecl_make_constant_base_string(text,-1); \
|
||||
component = si_base_string_concatenate(2, prefix, component); \
|
||||
component_path = cl_pathname(component); \
|
||||
if (!Null(pathname_mask)) { \
|
||||
if (Null(cl_pathname_match_p(component, pathname_mask))) \
|
||||
continue; \
|
||||
} \
|
||||
component_path = file_truename(component_path, component, flags); \
|
||||
kind = ecl_nth_value(the_env, 1); \
|
||||
out = CONS(CONS(component_path, kind), out); \
|
||||
static inline cl_object
|
||||
parse_directory_entry(const ecl_filename_char *text, cl_object text_mask, cl_object prefix, cl_object pathname_mask, int flags)
|
||||
{
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
cl_object component, component_string, component_path, kind;
|
||||
if (text[0] == '.' &&
|
||||
(text[1] == '\0' ||
|
||||
(text[1] == '.' && text[2] == '\0')))
|
||||
return ECL_NIL;
|
||||
if (!string_match(text, text_mask))
|
||||
return ECL_NIL;
|
||||
component = ecl_make_constant_filename(text,-1);
|
||||
component = ecl_concatenate_filename(prefix, component);
|
||||
component_string = ecl_decode_filename(component, ECL_NIL);
|
||||
component_path = cl_pathname(component_string);
|
||||
if (!Null(pathname_mask)) {
|
||||
if (Null(cl_pathname_match_p(component_string, pathname_mask)))
|
||||
return ECL_NIL;
|
||||
}
|
||||
component_path = file_truename(component_path, component, flags);
|
||||
kind = ecl_nth_value(the_env, 1);
|
||||
return CONS(component_path, kind);
|
||||
}
|
||||
|
||||
/*
|
||||
* list_current_directory() lists the files and directories which are contained
|
||||
|
|
@ -773,30 +827,12 @@ static cl_object
|
|||
list_directory(cl_object base_dir, cl_object text_mask, cl_object pathname_mask,
|
||||
int flags)
|
||||
{
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
cl_object out = ECL_NIL;
|
||||
cl_object prefix = ecl_namestring(base_dir, ECL_NAMESTRING_FORCE_BASE_STRING);
|
||||
cl_object entry;
|
||||
|
||||
char *text;
|
||||
#if defined(HAVE_DIRENT_H)
|
||||
DIR *dir;
|
||||
struct dirent *entry;
|
||||
|
||||
ecl_disable_interrupts();
|
||||
dir = opendir((char*)prefix->base_string.self);
|
||||
if (dir == NULL) {
|
||||
out = ECL_NIL;
|
||||
goto OUTPUT;
|
||||
}
|
||||
|
||||
while ((entry = readdir(dir))) {
|
||||
text = entry->d_name;
|
||||
PARSE_DIRECTORY_ENTRY;
|
||||
}
|
||||
closedir(dir);
|
||||
#else
|
||||
# ifdef ECL_MS_WINDOWS_HOST
|
||||
WIN32_FIND_DATA fd;
|
||||
#ifdef ECL_MS_WINDOWS_HOST
|
||||
ecl_WIN32_FIND_DATA fd;
|
||||
HANDLE hFind = NULL;
|
||||
BOOL found = FALSE;
|
||||
|
||||
|
|
@ -804,31 +840,47 @@ list_directory(cl_object base_dir, cl_object text_mask, cl_object pathname_mask,
|
|||
for (;;) {
|
||||
if (hFind == NULL) {
|
||||
cl_object aux = @".\\*";
|
||||
cl_object mask = si_base_string_concatenate(2, prefix, aux);
|
||||
hFind = FindFirstFile((char*)mask->base_string.self, &fd);
|
||||
cl_object mask = ecl_concatenate_filename(prefix, aux);
|
||||
hFind = ecl_FindFirstFile(ecl_filename_self(mask), &fd);
|
||||
if (hFind == INVALID_HANDLE_VALUE) {
|
||||
out = ECL_NIL;
|
||||
goto OUTPUT;
|
||||
}
|
||||
found = TRUE;
|
||||
} else {
|
||||
found = FindNextFile(hFind, &fd);
|
||||
found = ecl_FindNextFile(hFind, &fd);
|
||||
}
|
||||
|
||||
if (!found)
|
||||
break;
|
||||
|
||||
text = fd.cFileName;
|
||||
PARSE_DIRECTORY_ENTRY;
|
||||
if (!Null(entry = parse_directory_entry(fd.cFileName, text_mask, prefix, pathname_mask, flags)))
|
||||
out = CONS(entry, out);
|
||||
}
|
||||
FindClose(hFind);
|
||||
# else /* sys/dir.h as in SYSV */
|
||||
#elif defined(HAVE_DIRENT_H)
|
||||
DIR *dir;
|
||||
struct dirent *d_entry;
|
||||
|
||||
ecl_disable_interrupts();
|
||||
dir = opendir(ecl_filename_self(prefix));
|
||||
if (dir == NULL) {
|
||||
out = ECL_NIL;
|
||||
goto OUTPUT;
|
||||
}
|
||||
|
||||
while ((d_entry = readdir(dir))) {
|
||||
if (!Null(entry = parse_directory_entry(d_entry->d_name, text_mask, prefix, pathname_mask, flags)))
|
||||
out = CONS(entry, out);
|
||||
}
|
||||
closedir(dir);
|
||||
#else /* sys/dir.h as in SYSV */
|
||||
FILE *fp;
|
||||
char iobuffer[BUFSIZ];
|
||||
DIRECTORY dir;
|
||||
|
||||
ecl_disable_interrupts();
|
||||
fp = fopen((char*)prefix->base_string.self, OPEN_R);
|
||||
fp = ecl_fopen(ecl_filename_self(prefix), OPEN_R);
|
||||
if (fp == NULL) {
|
||||
out = ECL_NIL;
|
||||
goto OUTPUT;
|
||||
|
|
@ -840,20 +892,17 @@ list_directory(cl_object base_dir, cl_object text_mask, cl_object pathname_mask,
|
|||
if (dir.d_ino == 0)
|
||||
continue;
|
||||
|
||||
text=dir.d_name;
|
||||
PARSE_DIRECTORY_ENTRY;
|
||||
if (!Null(entry = parse_directory_entry(dir.d_name, text_mask, prefix, pathname_mask, flags)))
|
||||
out = CONS(entry, out);
|
||||
}
|
||||
fclose(fp);
|
||||
# endif /* !ECL_MS_WINDOWS_HOST */
|
||||
#endif /* !HAVE_DIRENT_H */
|
||||
#endif
|
||||
|
||||
OUTPUT:
|
||||
ecl_enable_interrupts();
|
||||
return cl_nreverse(out);
|
||||
}
|
||||
|
||||
#undef PARSE_DIRECTORY_ENTRY
|
||||
|
||||
/*
|
||||
* dir_files() lists all files which are contained in the current directory and
|
||||
* which match the masks in PATHNAME. This routine is essentially a wrapper for
|
||||
|
|
@ -975,7 +1024,7 @@ dir_recursive(cl_object base_dir, cl_object directory, cl_object filemask, int f
|
|||
cl_object base_dir;
|
||||
cl_object output;
|
||||
@
|
||||
mask = coerce_to_file_pathname(mask);
|
||||
mask = si_coerce_to_file_pathname(mask);
|
||||
mask = make_absolute_pathname(mask);
|
||||
base_dir = make_base_pathname(mask);
|
||||
output = dir_recursive(base_dir, mask->pathname.directory, mask,
|
||||
|
|
@ -986,7 +1035,7 @@ dir_recursive(cl_object base_dir, cl_object directory, cl_object filemask, int f
|
|||
@(defun ext::getcwd (&optional (change_d_p_d ECL_NIL))
|
||||
cl_object output;
|
||||
@
|
||||
output = cl_parse_namestring(3, current_dir(), ECL_NIL, ECL_NIL);
|
||||
output = cl_parse_namestring(3, ecl_decode_filename(current_dir(), ECL_NIL), ECL_NIL, ECL_NIL);
|
||||
if (!Null(change_d_p_d)) {
|
||||
ECL_SETQ(the_env, @'*default-pathname-defaults*', output);
|
||||
}
|
||||
|
|
@ -1000,51 +1049,45 @@ si_get_library_pathname(void)
|
|||
if (!Null(s)) {
|
||||
goto OUTPUT_UNCHANGED;
|
||||
} else {
|
||||
const char *v = getenv("ECLDIR");
|
||||
ecl_filename_char *v = ecl_getenv(ecl_fstr("ECLDIR"));
|
||||
if (v) {
|
||||
s = ecl_make_constant_base_string(v,-1);
|
||||
s = ecl_make_constant_filename(v,-1);
|
||||
goto OUTPUT;
|
||||
}
|
||||
}
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
{
|
||||
char *buffer;
|
||||
ecl_filename_char *buffer;
|
||||
HMODULE hnd;
|
||||
cl_index len, ep;
|
||||
s = ecl_alloc_adjustable_base_string(cl_core.path_max);
|
||||
buffer = (char*)s->base_string.self;
|
||||
s = ecl_alloc_adjustable_filename(cl_core.path_max);
|
||||
buffer = ecl_filename_self(s);
|
||||
ecl_disable_interrupts();
|
||||
hnd = GetModuleHandle("ecl.dll");
|
||||
len = GetModuleFileName(hnd, buffer, cl_core.path_max-1);
|
||||
len = ecl_GetModuleFileName(hnd, buffer, cl_core.path_max-1);
|
||||
ecl_enable_interrupts();
|
||||
if (len == 0) {
|
||||
FEerror("GetModuleFileName failed (last error = ~S)",
|
||||
1, ecl_make_fixnum(GetLastError()));
|
||||
}
|
||||
s->base_string.fillp = len;
|
||||
/* GetModuleFileName returns a file name. We have to strip
|
||||
* the directory component. */
|
||||
s = cl_make_pathname(8, @':name', ECL_NIL, @':type', ECL_NIL,
|
||||
@':version', ECL_NIL,
|
||||
@':defaults', s);
|
||||
s = ecl_namestring(s, ECL_NAMESTRING_FORCE_BASE_STRING);
|
||||
for (; len > 0 && buffer[len-1] != '\\'; len--);
|
||||
buffer[len] = '\0';
|
||||
s->base_string.fillp = len;
|
||||
}
|
||||
#else
|
||||
s = ecl_make_constant_base_string(ECLDIR "/",-1);
|
||||
#endif
|
||||
OUTPUT:
|
||||
{
|
||||
cl_object true_pathname = cl_probe_file(s);
|
||||
if (Null(true_pathname)) {
|
||||
if (file_kind(ecl_filename_self(s), TRUE) == ECL_NIL) {
|
||||
s = current_dir();
|
||||
} else {
|
||||
/* Produce a string */
|
||||
s = ecl_namestring(s, ECL_NAMESTRING_FORCE_BASE_STRING);
|
||||
}
|
||||
}
|
||||
cl_core.library_pathname = s;
|
||||
cl_core.library_pathname = ecl_decode_filename(s, ECL_NIL);
|
||||
OUTPUT_UNCHANGED:
|
||||
@(return s);
|
||||
@(return cl_core.library_pathname);
|
||||
}
|
||||
|
||||
@(defun ext::chdir (directory &optional (change_d_p_d ECL_T))
|
||||
|
|
@ -1059,7 +1102,7 @@ si_get_library_pathname(void)
|
|||
namestring = ecl_namestring(directory,
|
||||
ECL_NAMESTRING_TRUNCATE_IF_ERROR |
|
||||
ECL_NAMESTRING_FORCE_BASE_STRING);
|
||||
if (safe_chdir((char*)namestring->base_string.self, ECL_NIL) < 0) {
|
||||
if (safe_chdir(ecl_filename_self(namestring), ECL_NIL) < 0) {
|
||||
cl_object c_error = _ecl_strerror(errno);
|
||||
const char *msg = "Can't change the current directory to ~A."
|
||||
"~%C library error: ~S";
|
||||
|
|
@ -1081,7 +1124,18 @@ cl_object
|
|||
si_mkdir(cl_object directory, cl_object mode)
|
||||
{
|
||||
int modeint, ok;
|
||||
cl_object filename = si_coerce_to_base_string(directory);
|
||||
cl_object filename;
|
||||
{
|
||||
/* Ensure a clean string, without trailing slashes,
|
||||
* and null terminated */
|
||||
cl_index last = ecl_length(directory);
|
||||
if (last > 1) {
|
||||
ecl_character c = ecl_char(directory, last-1);
|
||||
if (IS_DIR_SEPARATOR(c))
|
||||
last--;
|
||||
}
|
||||
filename = ecl_encode_filename(directory, ecl_make_fixnum(last));
|
||||
}
|
||||
|
||||
if (ecl_unlikely(!ECL_FIXNUMP(mode) ||
|
||||
ecl_fixnum_minusp(mode) ||
|
||||
|
|
@ -1091,22 +1145,11 @@ si_mkdir(cl_object directory, cl_object mode)
|
|||
ecl_make_fixnum(0777)));
|
||||
}
|
||||
modeint = ecl_fixnum(mode);
|
||||
{
|
||||
/* Ensure a clean string, without trailing slashes,
|
||||
* and null terminated. */
|
||||
cl_index last = filename->base_string.fillp;
|
||||
if (last > 1) {
|
||||
ecl_character c = filename->base_string.self[last-1];
|
||||
if (IS_DIR_SEPARATOR(c))
|
||||
last--;
|
||||
}
|
||||
filename = ecl_subseq(filename, 0, last);
|
||||
}
|
||||
ecl_disable_interrupts();
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
ok = mkdir((char*)filename->base_string.self);
|
||||
ok = ecl_mkdir(ecl_filename_self(filename));
|
||||
#else
|
||||
ok = mkdir((char*)filename->base_string.self, modeint);
|
||||
ok = ecl_mkdir(ecl_filename_self(filename), modeint);
|
||||
#endif
|
||||
ecl_enable_interrupts();
|
||||
|
||||
|
|
@ -1135,9 +1178,9 @@ si_mkstemp(cl_object template)
|
|||
|
||||
#if defined(ECL_MS_WINDOWS_HOST)
|
||||
cl_object phys, dir, file;
|
||||
char strTempDir[MAX_PATH];
|
||||
char strTempFileName[MAX_PATH];
|
||||
char *s;
|
||||
ecl_filename_char strTempDir[MAX_PATH];
|
||||
ecl_filename_char strTempFileName[MAX_PATH];
|
||||
ecl_filename_char *s;
|
||||
int ok;
|
||||
|
||||
phys = cl_translate_logical_pathname(1, template);
|
||||
|
|
@ -1150,36 +1193,34 @@ si_mkstemp(cl_object template)
|
|||
file = cl_file_namestring(phys);
|
||||
|
||||
l = dir->base_string.fillp;
|
||||
memcpy(strTempDir, dir->base_string.self, l);
|
||||
ecl_fstrcpy(strTempDir, ecl_filename_self(dir));
|
||||
strTempDir[l] = 0;
|
||||
for (s = strTempDir; *s; s++)
|
||||
if (*s == '/')
|
||||
*s = '\\';
|
||||
|
||||
ecl_disable_interrupts();
|
||||
ok = GetTempFileName(strTempDir, (char*)file->base_string.self, 0,
|
||||
strTempFileName);
|
||||
ok = ecl_GetTempFileName(strTempDir, ecl_filename_self(file), 0,
|
||||
strTempFileName);
|
||||
ecl_enable_interrupts();
|
||||
if (!ok) {
|
||||
output = ECL_NIL;
|
||||
} else {
|
||||
l = strlen(strTempFileName);
|
||||
output = ecl_alloc_simple_base_string(l);
|
||||
memcpy(output->base_string.self, strTempFileName, l);
|
||||
output = ecl_make_simple_filename(strTempFileName,-1);
|
||||
}
|
||||
#else
|
||||
template = si_coerce_to_filename(template);
|
||||
l = template->base_string.fillp;
|
||||
output = ecl_alloc_simple_base_string(l + 6);
|
||||
memcpy(output->base_string.self, template->base_string.self, l);
|
||||
memcpy(output->base_string.self + l, "XXXXXX", 6);
|
||||
output = ecl_alloc_simple_filename(l + 6);
|
||||
ecl_fstrcat(ecl_fstrcpy(ecl_filename_self(output), ecl_filename_self(template)),
|
||||
ecl_fstr("XXXXXX"));
|
||||
|
||||
ecl_disable_interrupts();
|
||||
# ifdef HAVE_MKSTEMP
|
||||
fd = mkstemp((char*)output->base_string.self);
|
||||
fd = mkstemp(ecl_filename_self(output));
|
||||
# else
|
||||
if (mktemp((char*)output->base_string.self)) {
|
||||
fd = open((char*)output->base_string.self, O_CREAT|O_TRUNC, 0666);
|
||||
if (mktemp(ecl_filename_self(output))) {
|
||||
fd = ecl_open(ecl_filename_self(output), O_CREAT|O_TRUNC, 0666);
|
||||
} else {
|
||||
fd = -1;
|
||||
}
|
||||
|
|
@ -1192,7 +1233,7 @@ si_mkstemp(cl_object template)
|
|||
close(fd);
|
||||
}
|
||||
#endif
|
||||
@(return (Null(output)? output : cl_truename(output)));
|
||||
@(return (Null(output)? output : cl_truename(ecl_decode_filename(output, ECL_NIL))));
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
@ -1211,9 +1252,9 @@ si_copy_file(cl_object orig, cl_object dest)
|
|||
orig = si_coerce_to_filename(orig);
|
||||
dest = si_coerce_to_filename(dest);
|
||||
ecl_disable_interrupts();
|
||||
in = fopen((char*)orig->base_string.self, OPEN_R);
|
||||
in = ecl_fopen(ecl_filename_self(orig), OPEN_R);
|
||||
if (in) {
|
||||
out = fopen((char*)dest->base_string.self, OPEN_W);
|
||||
out = ecl_fopen(ecl_filename_self(dest), OPEN_W);
|
||||
if (out) {
|
||||
unsigned char *buffer = ecl_alloc_atomic(1024);
|
||||
cl_index size;
|
||||
|
|
@ -1235,7 +1276,7 @@ si_chmod(cl_object file, cl_object mode)
|
|||
{
|
||||
mode_t code = ecl_to_uint32_t(mode);
|
||||
cl_object filename = si_coerce_to_filename(file);
|
||||
unlikely_if (chmod((char*)filename->base_string.self, code)) {
|
||||
unlikely_if (ecl_chmod(ecl_filename_self(filename), code)) {
|
||||
cl_object c_error = _ecl_strerror(errno);
|
||||
const char *msg = "Unable to change mode of file ~S to value ~O"
|
||||
"~%C library error: ~S";
|
||||
|
|
|
|||
|
|
@ -185,7 +185,7 @@ the environment variable TMPDIR to a different value." template))
|
|||
(let ((ld-flags (split-program-options *ld-shared-flags*)))
|
||||
#+msvc
|
||||
(setf ld-flags
|
||||
(let ((implib (si::coerce-to-filename
|
||||
(let ((implib (brief-namestring
|
||||
(compile-file-pathname o-pathname :type :lib))))
|
||||
;; MSVC linker options are added at the end, after the
|
||||
;; /link flag, because they are not processed by the
|
||||
|
|
@ -203,7 +203,7 @@ the environment variable TMPDIR to a different value." template))
|
|||
(let ((ld-flags (split-program-options *ld-bundle-flags*)))
|
||||
#+msvc
|
||||
(setf ld-flags
|
||||
(let ((implib (si::coerce-to-filename
|
||||
(let ((implib (brief-namestring
|
||||
(compile-file-pathname o-pathname :type :import-library))))
|
||||
;; MSVC linker options are added at the end, after the
|
||||
;; /link flag, because they are not processed by the
|
||||
|
|
@ -492,9 +492,9 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
|
|||
;;
|
||||
(let* ((tmp-names (safe-mkstemp #P"TMP:ECLINIT"))
|
||||
(tmp-name (first tmp-names))
|
||||
(c-name (si::coerce-to-filename
|
||||
(c-name (brief-namestring
|
||||
(compile-file-pathname tmp-name :type :c)))
|
||||
(o-name (si::coerce-to-filename
|
||||
(o-name (brief-namestring
|
||||
(compile-file-pathname tmp-name :type :object)))
|
||||
submodules
|
||||
c-file)
|
||||
|
|
@ -679,9 +679,9 @@ compiled successfully, returns the pathname of the compiled file"
|
|||
#+dlopen
|
||||
(unless system-p
|
||||
(push o-pathname to-delete)
|
||||
(bundle-cc (si::coerce-to-filename output-file)
|
||||
(bundle-cc (brief-namestring output-file)
|
||||
init-name
|
||||
(list (si::coerce-to-filename o-pathname)))))
|
||||
(list (brief-namestring o-pathname)))))
|
||||
(if (setf true-output-file (probe-file output-file))
|
||||
(cmpprogress "~&;;; Finished compiling ~a.~%;;;~%"
|
||||
(namestring input-pathname))
|
||||
|
|
@ -787,9 +787,9 @@ after compilation."
|
|||
(data-c-dump data-pathname)
|
||||
|
||||
(compiler-cc c-pathname o-pathname)
|
||||
(bundle-cc (si::coerce-to-filename so-pathname)
|
||||
(bundle-cc (brief-namestring so-pathname)
|
||||
init-name
|
||||
(list (si::coerce-to-filename o-pathname)))
|
||||
(list (brief-namestring o-pathname)))
|
||||
(cmp-delete-file c-pathname)
|
||||
(cmp-delete-file h-pathname)
|
||||
(cmp-delete-file o-pathname)
|
||||
|
|
|
|||
|
|
@ -37,10 +37,12 @@
|
|||
;; because it breaks down when using paths such as
|
||||
;; c:/docume~1/juanjo/locals~1/temp/foo.tmp. enough-namestring would
|
||||
;; return /docume~1/juanjo/locals~1/temp/foo.tmp which is not found
|
||||
(when (wild-pathname-p path)
|
||||
(error "Cannot coerce ~A to a physical filename~%" path))
|
||||
#+windows
|
||||
(namestring (si::coerce-to-filename path))
|
||||
(namestring (si::coerce-to-file-pathname path))
|
||||
#-windows
|
||||
(enough-namestring (si::coerce-to-filename path)))
|
||||
(enough-namestring (si::coerce-to-file-pathname path)))
|
||||
|
||||
(defun normalize-build-target-name (target)
|
||||
(ecase target
|
||||
|
|
|
|||
|
|
@ -1406,8 +1406,8 @@ extern ECL_API cl_object cl_wild_pathname_p _ECL_ARGS((cl_narg narg, cl_object p
|
|||
|
||||
extern ECL_API cl_object ecl_make_pathname(cl_object host, cl_object device, cl_object directory, cl_object name, cl_object type, cl_object version, cl_object scase);
|
||||
extern ECL_API cl_object ecl_parse_namestring(cl_object s, cl_index start, cl_index end, cl_index *ep, cl_object default_host);
|
||||
extern ECL_API cl_object coerce_to_physical_pathname(cl_object x);
|
||||
extern ECL_API cl_object coerce_to_file_pathname(cl_object pathname);
|
||||
extern ECL_API cl_object si_coerce_to_physical_pathname(cl_object x);
|
||||
extern ECL_API cl_object si_coerce_to_file_pathname(cl_object pathname);
|
||||
#define ECL_NAMESTRING_TRUNCATE_IF_ERROR 1
|
||||
#define ECL_NAMESTRING_FORCE_BASE_STRING 2
|
||||
extern ECL_API cl_object ecl_namestring(cl_object pname, int truncate_if_impossible);
|
||||
|
|
@ -1923,8 +1923,6 @@ extern ECL_API cl_object cl_user_homedir_pathname _ECL_ARGS((cl_narg narg, ...))
|
|||
extern ECL_API cl_object si_mkstemp(cl_object templ);
|
||||
extern ECL_API cl_object si_rmdir(cl_object directory);
|
||||
|
||||
extern ECL_API cl_object ecl_cstring_to_pathname(char *s);
|
||||
extern ECL_API int ecl_backup_open(const char *filename, int option, int mode);
|
||||
extern ECL_API cl_object ecl_file_len(int f);
|
||||
extern ECL_API cl_object ecl_homedir_pathname(cl_object user);
|
||||
extern ECL_API cl_object si_get_library_pathname(void);
|
||||
|
|
|
|||
130
src/h/internal.h
130
src/h/internal.h
|
|
@ -220,19 +220,6 @@ extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type);
|
|||
|
||||
/* file.d */
|
||||
|
||||
/*
|
||||
* POSIX specifies that the "b" flag is ignored. This is good, because
|
||||
* under MSDOS and Apple's OS we need to open text files in binary mode,
|
||||
* so that we get both the carriage return and the linefeed characters.
|
||||
* Otherwise, it would be complicated to implement file-position and
|
||||
* seek operations.
|
||||
*/
|
||||
#define OPEN_R "rb"
|
||||
#define OPEN_W "wb"
|
||||
#define OPEN_RW "r+b"
|
||||
#define OPEN_A "ab"
|
||||
#define OPEN_RA "a+b"
|
||||
|
||||
/* Windows does not have this flag (POSIX thing) */
|
||||
#ifndef O_CLOEXEC
|
||||
#define O_CLOEXEC 0
|
||||
|
|
@ -501,6 +488,123 @@ extern cl_object mp_get_rwlock_read_wait(cl_object lock);
|
|||
extern cl_object mp_get_rwlock_write_wait(cl_object lock);
|
||||
#endif
|
||||
|
||||
/* unixfsys.d */
|
||||
|
||||
/* Filename encodings: on Unix we use ordinary chars encoded in a user
|
||||
* specified format (usually utf8), while on Windows we use a wchar_t
|
||||
* type.
|
||||
*
|
||||
* Naming conventions:
|
||||
* fstr: null-terminated raw C array with element type char or wchar_t
|
||||
* filename: Lisp base string or vector with element type byte16,
|
||||
* also null-terminated
|
||||
*/
|
||||
#if defined(ECL_MS_WINDOWS_HOST) && defined(ECL_UNICODE)
|
||||
#include <wchar.h>
|
||||
|
||||
typedef wchar_t ecl_filename_char;
|
||||
#define ecl_fstrlen(x) wcslen(x)
|
||||
#define ecl_fstrcpy(x,y) wcscpy(x,y)
|
||||
#define ecl_fstrcat(x,y) wcscat(x,y)
|
||||
#define ecl_fstr(x) L ## x /* wchar_t string constructor prefixed with L */
|
||||
|
||||
cl_object ecl_make_simple_filename(const ecl_filename_char *x, cl_fixnum size);
|
||||
#define ecl_make_constant_filename(x,y) ecl_make_simple_filename(x,y)
|
||||
cl_object ecl_alloc_filename(cl_index len, cl_object adjustable);
|
||||
#define ecl_alloc_adjustable_filename(len) ecl_alloc_filename(len, ECL_T)
|
||||
#define ecl_alloc_simple_filename(len) ecl_alloc_filename(len, ECL_NIL)
|
||||
cl_object ecl_concatenate_filename(cl_object x, cl_object y);
|
||||
#define ecl_filename_self(x) ((ecl_filename_char*)((x)->vector.self.b16))
|
||||
|
||||
#define ecl_chdir _wchdir
|
||||
#define ecl_stat _wstat64
|
||||
#define ecl_fstat _fstat64
|
||||
typedef struct __stat64 ecl_stat_struct;
|
||||
#define ecl_getcwd _wgetcwd
|
||||
#define ecl_access _waccess
|
||||
#define ecl_unlink _wunlink
|
||||
#define ecl_rename _wrename
|
||||
#define ecl_open _wopen
|
||||
#define ecl_fopen _wfopen
|
||||
#define ecl_fdopen _wfdopen
|
||||
#define ecl_rmdir _wrmdir
|
||||
#define ecl_mkdir _wmkdir
|
||||
#define ecl_chmod _wchmod
|
||||
#define ecl_getenv _wgetenv
|
||||
#define ecl_GetFileAttributes GetFileAttributesW
|
||||
#define ecl_MoveFile MoveFileW
|
||||
#define ecl_MoveFileEx MoveFileExW
|
||||
#define ecl_DeleteFile DeleteFileW
|
||||
#define ecl_FindFirstFile FindFirstFileW
|
||||
#define ecl_FindNextFile FindNextFileW
|
||||
#define ecl_WIN32_FIND_DATA WIN32_FIND_DATAW
|
||||
#define ecl_GetTempFileName GetTempFileNameW
|
||||
#define ecl_CopyFile CopyFileW
|
||||
#define ecl_LoadLibrary LoadLibraryW
|
||||
#define ecl_GetModuleFileName GetModuleFileNameW
|
||||
|
||||
#else
|
||||
|
||||
typedef char ecl_filename_char;
|
||||
#define ecl_fstrlen(x) strlen(x)
|
||||
#define ecl_fstrcpy(x,y) strcpy(x,y)
|
||||
#define ecl_fstrcat(x,y) strcat(x,y)
|
||||
#define ecl_fstr(x) x
|
||||
|
||||
#define ecl_make_simple_filename(x,y) ecl_make_simple_base_string((char *)x,y)
|
||||
#define ecl_make_constant_filename(x,y) ecl_make_constant_base_string((char *)x,y)
|
||||
#define ecl_alloc_adjustable_filename(len) ecl_alloc_adjustable_base_string(len)
|
||||
#define ecl_alloc_simple_filename(len) ecl_alloc_simple_base_string(len)
|
||||
#define ecl_concatenate_filename(x,y) si_base_string_concatenate(2,x,y)
|
||||
#define ecl_filename_self(x) ((ecl_filename_char*)((x)->base_string.self))
|
||||
|
||||
#define ecl_chdir chdir
|
||||
#define ecl_stat stat
|
||||
#define ecl_fstat fstat
|
||||
typedef struct stat ecl_stat_struct;
|
||||
#define ecl_getcwd getcwd
|
||||
#define ecl_access access
|
||||
#define ecl_unlink unlink
|
||||
#define ecl_rename rename
|
||||
#define ecl_open open
|
||||
#define ecl_fopen fopen
|
||||
#define ecl_fdopen fdopen
|
||||
#define ecl_rmdir rmdir
|
||||
#define ecl_mkdir mkdir
|
||||
#define ecl_chmod chmod
|
||||
#define ecl_getenv getenv
|
||||
#define ecl_GetFileAttributes GetFileAttributesA
|
||||
#define ecl_MoveFile MoveFileA
|
||||
#define ecl_MoveFileEx MoveFileExA
|
||||
#define ecl_DeleteFile DeleteFileA
|
||||
#define ecl_FindFirstFile FindFirstFileA
|
||||
#define ecl_FindNextFile FindNextFileA
|
||||
#define ecl_WIN32_FIND_DATA WIN32_FIND_DATAA
|
||||
#define ecl_GetTempFileName GetTempFileNameA
|
||||
#define ecl_CopyFile CopyFileA
|
||||
#define ecl_LoadLibrary LoadLibraryA
|
||||
#define ecl_GetModuleFileName GetModuleFileNameA
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* POSIX specifies that the "b" flag is ignored. This is good, because
|
||||
* under MSDOS and Apple's OS we need to open text files in binary mode,
|
||||
* so that we get both the carriage return and the linefeed characters.
|
||||
* Otherwise, it would be complicated to implement file-position and
|
||||
* seek operations.
|
||||
*/
|
||||
#define OPEN_R ecl_fstr("rb")
|
||||
#define OPEN_W ecl_fstr("wb")
|
||||
#define OPEN_RW ecl_fstr("r+b")
|
||||
#define OPEN_A ecl_fstr("ab")
|
||||
#define OPEN_RA ecl_fstr("a+b")
|
||||
|
||||
int ecl_backup_open(const ecl_filename_char *filename, int option, int mode);
|
||||
cl_object ecl_decode_filename(cl_object x, cl_object len);
|
||||
cl_object ecl_encode_filename(cl_object x, cl_object len);
|
||||
|
||||
|
||||
/* unixint.d */
|
||||
|
||||
#define ECL_PI_D 3.14159265358979323846264338327950288
|
||||
|
|
|
|||
|
|
@ -303,7 +303,8 @@ the one used internally by ECL compiled files."
|
|||
#-unicode
|
||||
(warn "EXT:LOAD-ENCODING not available when ECL is built without support for Unicode")
|
||||
#+unicode
|
||||
(let ((filename (make-pathname :name (symbol-name name) :defaults "sys:encodings;")))
|
||||
(let ((ext:*default-external-format* t) ; circularity: processing filenames needs encodings itself
|
||||
(filename (make-pathname :name (symbol-name name) :defaults "sys:encodings;")))
|
||||
(cond ((probe-file filename)
|
||||
(load filename :verbose nil)
|
||||
name)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue