#include <config.h>
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#if !defined (S_ISLNK) && defined (S_IFLNK)
# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
#endif
#if !defined (S_ISFIFO) && defined (S_IFIFO)
# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
#endif
#if !defined (S_ISREG) && defined (S_IFREG)
# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
#endif
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
#include <ctype.h>
#ifdef VMS
#include "vmsdir.h"
#include <perror.h>
#include <stddef.h>
#include <string.h>
#endif
#include <errno.h>
#ifndef vax11c
#ifndef USE_CRT_DLL
extern int errno;
#endif
#endif
#ifdef APOLLO
#include <sys/time.h>
#endif
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "window.h"
#include "blockinput.h"
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
#include <stdlib.h>
#include <fcntl.h>
#endif
#ifdef MSDOS
#include "msdos.h"
#include <sys/param.h>
#if __DJGPP__ >= 2
#include <fcntl.h>
#include <string.h>
#endif
#endif
#ifdef DOS_NT
#define CORRECT_DIR_SEPS(s) \
do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
else unixtodos_filename (s); \
} while (0)
#ifdef MSDOS
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
#define IS_DRIVE(x) isalpha (x)
#endif
#define DRIVE_LETTER(x) (tolower (x))
#endif
#ifdef VMS
#include <file.h>
#include <rmsdef.h>
#include <fab.h>
#include <nam.h>
#endif
#include "systime.h"
#ifdef HPUX
#include <netio.h>
#ifndef HPUX8
#ifndef HPUX9
#include <errnet.h>
#endif
#endif
#endif
#include "commands.h"
extern int use_dialog_box;
extern int use_file_dialog;
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
#ifndef S_ISLNK
# define lstat stat
#endif
#ifndef FILE_SYSTEM_CASE
#define FILE_SYSTEM_CASE(filename) (filename)
#endif
int auto_saving;
int auto_save_mode_bits;
Lisp_Object Qauto_save_coding;
Lisp_Object Vfile_name_coding_system;
Lisp_Object Vdefault_file_name_coding_system;
Lisp_Object Vfile_name_handler_alist;
Lisp_Object Qoperations;
Lisp_Object Qformat_decode, Qformat_annotate_function;
Lisp_Object Vset_auto_coding_function;
Lisp_Object Vafter_insert_file_functions;
Lisp_Object Qafter_insert_file_set_coding;
Lisp_Object Vwrite_region_annotate_functions;
Lisp_Object Qwrite_region_annotate_functions;
Lisp_Object Vwrite_region_annotations_so_far;
Lisp_Object Vauto_save_list_file_name;
Lisp_Object Vread_file_name_function;
Lisp_Object Vread_file_name_predicate;
int read_file_name_completion_ignore_case;
int insert_default_directory;
int vms_stmlf_recfm;
Lisp_Object Vdirectory_sep_char;
#ifdef HAVE_FSYNC
int write_region_inhibit_fsync;
#endif
extern Lisp_Object Vuser_login_name;
#ifdef WINDOWSNT
extern Lisp_Object Vw32_get_true_file_attributes;
#endif
extern int minibuf_level;
extern int minibuffer_auto_raise;
extern int history_delete_duplicates;
static Lisp_Object Vinhibit_file_name_handlers;
static Lisp_Object Vinhibit_file_name_operation;
Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
Lisp_Object Qexcl;
Lisp_Object Qfile_name_history;
Lisp_Object Qcar_less_than_car;
static int a_write P_ ((int, Lisp_Object, int, int,
Lisp_Object *, struct coding_system *));
static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *));
void
report_file_error (string, data)
const char *string;
Lisp_Object data;
{
Lisp_Object errstring;
int errorno = errno;
synchronize_system_messages_locale ();
errstring = code_convert_string_norecord (build_string (strerror (errorno)),
Vlocale_coding_system, 0);
while (1)
switch (errorno)
{
case EEXIST:
xsignal (Qfile_already_exists, Fcons (errstring, data));
break;
default:
if (SREF (errstring, 1) != '/')
SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
xsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
}
}
Lisp_Object
close_file_unwind (fd)
Lisp_Object fd;
{
emacs_close (XFASTINT (fd));
return Qnil;
}
static Lisp_Object
restore_point_unwind (location)
Lisp_Object location;
{
Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
return Qnil;
}
Lisp_Object Qexpand_file_name;
Lisp_Object Qsubstitute_in_file_name;
Lisp_Object Qdirectory_file_name;
Lisp_Object Qfile_name_directory;
Lisp_Object Qfile_name_nondirectory;
Lisp_Object Qunhandled_file_name_directory;
Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
Lisp_Object Qmake_directory_internal;
Lisp_Object Qmake_directory;
Lisp_Object Qdelete_directory;
Lisp_Object Qdelete_file;
Lisp_Object Qrename_file;
Lisp_Object Qadd_name_to_file;
Lisp_Object Qmake_symbolic_link;
Lisp_Object Qfile_exists_p;
Lisp_Object Qfile_executable_p;
Lisp_Object Qfile_readable_p;
Lisp_Object Qfile_writable_p;
Lisp_Object Qfile_symlink_p;
Lisp_Object Qaccess_file;
Lisp_Object Qfile_directory_p;
Lisp_Object Qfile_regular_p;
Lisp_Object Qfile_accessible_directory_p;
Lisp_Object Qfile_modes;
Lisp_Object Qset_file_modes;
Lisp_Object Qset_file_times;
Lisp_Object Qfile_newer_than_file_p;
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
Lisp_Object Qverify_visited_file_modtime;
Lisp_Object Qset_visited_file_modtime;
DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
doc: )
(filename, operation)
Lisp_Object filename, operation;
{
Lisp_Object chain, inhibited_handlers, result;
int pos = -1;
result = Qnil;
CHECK_STRING (filename);
if (EQ (operation, Vinhibit_file_name_operation))
inhibited_handlers = Vinhibit_file_name_handlers;
else
inhibited_handlers = Qnil;
for (chain = Vfile_name_handler_alist; CONSP (chain);
chain = XCDR (chain))
{
Lisp_Object elt;
elt = XCAR (chain);
if (CONSP (elt))
{
Lisp_Object string = XCAR (elt);
int match_pos;
Lisp_Object handler = XCDR (elt);
Lisp_Object operations = Qnil;
if (SYMBOLP (handler))
operations = Fget (handler, Qoperations);
if (STRINGP (string)
&& (match_pos = fast_string_match (string, filename)) > pos
&& (NILP (operations) || ! NILP (Fmemq (operation, operations))))
{
Lisp_Object tem;
handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
{
result = handler;
pos = match_pos;
}
}
}
QUIT;
}
return result;
}
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
#ifndef DOS_NT
register const unsigned char *beg;
#else
register unsigned char *beg;
#endif
register const unsigned char *p;
Lisp_Object handler;
CHECK_STRING (filename);
handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
return call2 (handler, Qfile_name_directory, filename);
filename = FILE_SYSTEM_CASE (filename);
beg = SDATA (filename);
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif
#ifdef DOS_NT
&& !(p[-1] == ':'
&& ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
|| (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
#endif
) p--;
if (p == beg)
return Qnil;
#ifdef DOS_NT
if (p[-1] == ':')
{
unsigned char *res = alloca (MAXPATHLEN + 1);
unsigned char *r = res;
if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
{
strncpy (res, beg, 2);
beg += 2;
r += 2;
}
if (getdefdir (toupper (*beg) - 'A' + 1, r))
{
if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
beg = res;
p = beg + strlen (beg);
}
}
CORRECT_DIR_SEPS (beg);
#endif
return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
Sfile_name_nondirectory, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
register const unsigned char *beg, *p, *end;
Lisp_Object handler;
CHECK_STRING (filename);
handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, filename);
beg = SDATA (filename);
end = p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif
#ifdef DOS_NT
&& !(p[-1] == ':'
&& (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
#endif
)
p--;
return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
}
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
Sunhandled_file_name_directory, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
if (!NILP (handler))
return call2 (handler, Qunhandled_file_name_directory, filename);
return Ffile_name_directory (filename);
}
char *
file_name_as_directory (out, in)
char *out, *in;
{
int size = strlen (in) - 1;
strcpy (out, in);
if (size < 0)
{
out[0] = '.';
out[1] = '/';
out[2] = 0;
return out;
}
#ifdef VMS
if (in[size] == ':' || in[size] == ']' || in[size] == '>')
return out;
else if (! index (in, '/')
&& ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
|| (size > 3 && ! strcmp (&in[size - 3], ".dir"))
|| (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
|| ! strncmp (&in[size - 5], ".dir", 4))
&& (in[size - 1] == '.' || in[size - 1] == ';')
&& in[size] == '1')))
{
register char *p, *dot;
char brack;
p = in + size;
while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
if (p != in)
{
strncpy (out, in, p - in);
out[p - in] = '\0';
if (*p == ':')
{
brack = ']';
strcat (out, ":[");
}
else
{
brack = *p;
strcat (out, ".");
}
p++;
}
else
{
brack = ']';
strcpy (out, "[.");
}
dot = index (p, '.');
if (dot)
{
size = strlen (out) + (dot - p);
strncat (out, p, dot - p);
}
else
{
strcat (out, p);
size = strlen (out);
}
out[size++] = brack;
out[size] = '\0';
}
#else
if (!IS_DIRECTORY_SEP (out[size]))
{
out[size + 1] = '/';
out[size + 2] = '\0';
}
#ifdef DOS_NT
CORRECT_DIR_SEPS (out);
#endif
#endif
return out;
}
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Sfile_name_as_directory, 1, 1, 0,
doc: )
(file)
Lisp_Object file;
{
char *buf;
Lisp_Object handler;
CHECK_STRING (file);
if (NILP (file))
return Qnil;
handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
buf = (char *) alloca (SBYTES (file) + 10);
file_name_as_directory (buf, SDATA (file));
return make_specified_string (buf, -1, strlen (buf),
STRING_MULTIBYTE (file));
}
int
directory_file_name (src, dst)
char *src, *dst;
{
long slen;
#ifdef VMS
long rlen;
char * ptr, * rptr;
char bracket;
struct FAB fab = cc$rms_fab;
struct NAM nam = cc$rms_nam;
char esa[NAM$C_MAXRSS];
#endif
slen = strlen (src);
#ifdef VMS
if (! index (src, '/')
&& (src[slen - 1] == ']'
|| src[slen - 1] == ':'
|| src[slen - 1] == '>'))
{
fab.fab$l_fna = src;
fab.fab$b_fns = slen;
fab.fab$l_nam = &nam;
fab.fab$l_fop = FAB$M_NAM;
nam.nam$l_esa = esa;
nam.nam$b_ess = sizeof esa;
nam.nam$b_nop |= NAM$M_SYNCHK;
if (SYS$PARSE (&fab, 0, 0) == RMS$_NORMAL)
{
slen = nam.nam$b_esl;
if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
slen -= 2;
esa[slen] = '\0';
src = esa;
}
if (src[slen - 1] != ']' && src[slen - 1] != '>')
{
if (src[slen - 1] == ':')
{
ptr = strcpy (dst, src);
while (*ptr)
{
if ('a' <= *ptr && *ptr <= 'z')
*ptr -= 040;
ptr++;
}
dst[slen - 1] = 0;
if (!(src = egetenv (dst)))
return 0;
slen = strlen (src);
if (src[slen - 1] != ']' && src[slen - 1] != '>')
{
strcpy (dst, src);
return 0;
}
}
else
{
strcpy (dst, src);
return 0;
}
}
bracket = src[slen - 1];
ptr = index (src, bracket - 2);
if (ptr == 0)
{
strcpy (dst, src);
return 0;
}
if (!(rptr = rindex (src, '.')))
rptr = ptr;
slen = rptr - src;
strncpy (dst, src, slen);
dst[slen] = '\0';
if (*rptr == '.')
{
dst[slen++] = bracket;
dst[slen] = '\0';
}
else
{
if (dst[slen - 1] == ':'
&& dst[slen - 2] != ':'
&& strcmp (src + slen, "[000000]") == 0)
{
dst[slen - 1] = '\0';
if ((ptr = egetenv (dst))
&& (rlen = strlen (ptr) - 1) > 0
&& (ptr[rlen] == ']' || ptr[rlen] == '>')
&& ptr[rlen - 1] == '.')
{
char * buf = (char *) alloca (strlen (ptr) + 1);
strcpy (buf, ptr);
buf[rlen - 1] = ']';
buf[rlen] = '\0';
return directory_file_name (buf, dst);
}
else
dst[slen - 1] = ':';
}
strcat (dst, "[000000]");
slen += 8;
}
rptr++;
rlen = strlen (rptr) - 1;
strncat (dst, rptr, rlen);
dst[slen + rlen] = '\0';
strcat (dst, ".DIR.1");
return 1;
}
#endif
strcpy (dst, src);
#ifdef APOLLO
if ((slen > 2 && dst[slen - 1] == '/')
|| (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
dst[slen - 1] = 0;
#else
if (slen > 1
&& IS_DIRECTORY_SEP (dst[slen - 1])
#ifdef DOS_NT
&& !IS_ANY_SEP (dst[slen - 2])
#endif
)
dst[slen - 1] = 0;
#endif
#ifdef DOS_NT
CORRECT_DIR_SEPS (dst);
#endif
return 1;
}
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
1, 1, 0,
doc: )
(directory)
Lisp_Object directory;
{
char *buf;
Lisp_Object handler;
CHECK_STRING (directory);
if (NILP (directory))
return Qnil;
handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
if (!NILP (handler))
return call2 (handler, Qdirectory_file_name, directory);
#ifdef VMS
buf = (char *) alloca (SBYTES (directory) + 20 + 255);
#else
buf = (char *) alloca (SBYTES (directory) + 20);
#endif
directory_file_name (SDATA (directory), buf);
return make_specified_string (buf, -1, strlen (buf),
STRING_MULTIBYTE (directory));
}
static char make_temp_name_tbl[64] =
{
'A','B','C','D','E','F','G','H',
'I','J','K','L','M','N','O','P',
'Q','R','S','T','U','V','W','X',
'Y','Z','a','b','c','d','e','f',
'g','h','i','j','k','l','m','n',
'o','p','q','r','s','t','u','v',
'w','x','y','z','0','1','2','3',
'4','5','6','7','8','9','-','_'
};
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
Lisp_Object
make_temp_name (prefix, base64_p)
Lisp_Object prefix;
int base64_p;
{
Lisp_Object val;
int len, clen;
int pid;
unsigned char *p, *data;
char pidbuf[20];
int pidlen;
CHECK_STRING (prefix);
pid = (int) getpid ();
if (base64_p)
{
pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidlen = 3;
}
else
{
#ifdef HAVE_LONG_FILE_NAMES
sprintf (pidbuf, "%d", pid);
pidlen = strlen (pidbuf);
#else
pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidlen = 3;
#endif
}
len = SBYTES (prefix); clen = SCHARS (prefix);
val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
if (!STRING_MULTIBYTE (prefix))
STRING_SET_UNIBYTE (val);
data = SDATA (val);
bcopy(SDATA (prefix), data, len);
p = data + len;
bcopy (pidbuf, p, pidlen);
p += pidlen;
if (!make_temp_name_count_initialized_p)
{
make_temp_name_count = (unsigned) time (NULL);
make_temp_name_count_initialized_p = 1;
}
while (1)
{
struct stat ignored;
unsigned num = make_temp_name_count;
p[0] = make_temp_name_tbl[num & 63], num >>= 6;
p[1] = make_temp_name_tbl[num & 63], num >>= 6;
p[2] = make_temp_name_tbl[num & 63], num >>= 6;
make_temp_name_count += 25229;
make_temp_name_count %= 225307;
if (stat (data, &ignored) < 0)
{
if (errno == ENOENT)
return val;
else
report_file_error ("Cannot create temporary name for prefix",
Fcons (prefix, Qnil));
}
}
error ("Cannot create temporary name for prefix `%s'",
SDATA (prefix));
return Qnil;
}
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
doc: )
(prefix)
Lisp_Object prefix;
{
return make_temp_name (prefix, 0);
}
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
doc: )
(name, default_directory)
Lisp_Object name, default_directory;
{
unsigned char *nm;
register unsigned char *newdir, *p, *o;
int tlen;
unsigned char *target;
struct passwd *pw;
#ifdef VMS
unsigned char * colon = 0;
unsigned char * close = 0;
unsigned char * slash = 0;
unsigned char * brack = 0;
int lbrack = 0, rbrack = 0;
int dots = 0;
#endif
#ifdef DOS_NT
int drive = 0;
int collapse_newdir = 1;
int is_escaped = 0;
#endif
int length;
Lisp_Object handler, result;
int multibyte;
CHECK_STRING (name);
handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
return call3 (handler, Qexpand_file_name, name, default_directory);
if (NILP (default_directory))
default_directory = current_buffer->directory;
if (! STRINGP (default_directory))
{
#ifdef DOS_NT
extern char *emacs_root_dir (void);
default_directory = build_string (emacs_root_dir ());
#else
default_directory = build_string ("/");
#endif
}
if (!NILP (default_directory))
{
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
return call3 (handler, Qexpand_file_name, name, default_directory);
}
o = SDATA (default_directory);
if (! NILP (default_directory) && !EQ (default_directory, name)
#ifdef DOS_NT
&& ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))
#ifdef WINDOWSNT
&& ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
#endif
#else
&& ! (IS_DIRECTORY_SEP (o[0]))
#endif
)
{
struct gcpro gcpro1;
GCPRO1 (name);
default_directory = Fexpand_file_name (default_directory, Qnil);
UNGCPRO;
}
name = FILE_SYSTEM_CASE (name);
nm = SDATA (name);
multibyte = STRING_MULTIBYTE (name);
#ifdef DOS_NT
nm = strcpy (alloca (strlen (nm) + 1), nm);
if (nm[0] == '/' && nm[1] == ':')
{
is_escaped = 1;
nm += 2;
}
if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
{
drive = nm[0];
nm += 2;
}
#ifdef WINDOWSNT
if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
nm++;
#endif
#endif
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
{
drive = 0;
}
#endif
if (
IS_DIRECTORY_SEP (nm[0])
#ifdef MSDOS
&& drive && !is_escaped
#endif
#ifdef WINDOWSNT
&& (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
#endif
#ifdef VMS
|| index (nm, ':')
#endif
)
{
int lose = 0;
p = nm;
while (*p)
{
if (IS_DIRECTORY_SEP (p[0])
&& p[1] == '.'
&& (IS_DIRECTORY_SEP (p[2])
|| p[2] == 0
|| (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
|| p[3] == 0))))
lose = 1;
else if (p > nm
&& IS_DIRECTORY_SEP (p[0])
&& IS_DIRECTORY_SEP (p[1]))
lose = 1;
#ifdef VMS
if (p[0] == '\\')
lose = 1;
if (p[0] == '/') {
if (!slash && p > nm && (brack || colon)) {
nm = (brack ? brack + 1 : colon + 1);
lbrack = rbrack = 0;
brack = 0;
colon = 0;
}
slash = p;
}
if (p[0] == '-')
#ifdef NO_HYPHENS_IN_FILENAMES
if (lbrack == rbrack)
{
if (dots < 2)
p[0] = '_';
}
else
#endif
if (lbrack > rbrack
&& ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
&& (p[1] == '.' || p[1] == ']' || p[1] == '>')))
lose = 1;
#ifdef NO_HYPHENS_IN_FILENAMES
else
p[0] = '_';
#endif
if (p[0] == '[' || p[0] == '<')
lbrack++, brack = 0;
if (p[0] == ']' || p[0] == '>')
rbrack++, brack = p;
if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
lose = 1;
if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
nm = p + 1, lose = 1;
if (p[0] == ':' && (colon || slash))
if (brack)
{
nm = brack + 1;
brack = 0;
}
else if (slash)
nm = slash + 1;
else if (colon && colon[-1] == ':')
colon = p;
else if (colon && colon[-1] != ':')
{
nm = colon + 1;
colon = 0;
}
if (p[0] == ':' && !colon)
{
if (p[1] == ':')
p++;
colon = p;
}
if (lbrack == rbrack)
if (p[0] == ';')
dots = 2;
else if (p[0] == '.')
dots++;
#endif
p++;
}
if (!lose)
{
#ifdef VMS
if (index (nm, '/'))
{
nm = sys_translate_unix (nm);
return make_specified_string (nm, -1, strlen (nm), multibyte);
}
#endif
#ifdef DOS_NT
CORRECT_DIR_SEPS (nm);
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
if (strcmp (nm, SDATA (name)) != 0)
name = make_specified_string (nm, -1, strlen (nm), multibyte);
}
else
#endif
if (strcmp (nm - 2, SDATA (name)) != 0)
{
char temp[] = " :";
name = make_specified_string (nm, -1, p - nm, multibyte);
temp[0] = DRIVE_LETTER (drive);
name = concat2 (build_string (temp), name);
}
return name;
#else
if (nm == SDATA (name))
return name;
return make_specified_string (nm, -1, strlen (nm), multibyte);
#endif
}
}
newdir = 0;
if (nm[0] == '~')
{
if (IS_DIRECTORY_SEP (nm[1])
#ifdef VMS
|| nm[1] == ':'
#endif
|| nm[1] == 0)
{
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
nm++;
#ifdef DOS_NT
collapse_newdir = 0;
#endif
#ifdef VMS
nm++;
#endif
}
else
{
for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)
#ifdef VMS
&& *p != ':'
#endif
); p++);
o = (unsigned char *) alloca (p - nm + 1);
bcopy ((char *) nm, o, p - nm);
o [p - nm] = 0;
BLOCK_INPUT;
pw = (struct passwd *) getpwnam (o + 1);
UNBLOCK_INPUT;
if (pw)
{
newdir = (unsigned char *) pw -> pw_dir;
#ifdef VMS
nm = p + 1;
#else
nm = p;
#ifdef DOS_NT
collapse_newdir = 0;
#endif
#endif
}
}
}
#ifdef DOS_NT
if (!newdir && drive)
{
if (!IS_DIRECTORY_SEP (nm[0]))
{
newdir = alloca (MAXPATHLEN + 1);
if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
newdir = NULL;
}
if (!newdir)
{
newdir = alloca (4);
newdir[0] = DRIVE_LETTER (drive);
newdir[1] = ':';
newdir[2] = '/';
newdir[3] = 0;
}
}
#endif
if (1
#ifndef DOS_NT
&& !IS_DIRECTORY_SEP (nm[0])
#endif
#ifdef WINDOWSNT
&& !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
#endif
#ifdef VMS
&& !index (nm, ':')
#endif
&& !newdir)
{
newdir = SDATA (default_directory);
multibyte |= STRING_MULTIBYTE (default_directory);
#ifdef DOS_NT
if (newdir[0] == '/' && newdir[1] == ':')
{
is_escaped = 1;
newdir += 2;
}
#endif
}
#ifdef DOS_NT
if (newdir)
{
if (
! (IS_DRIVE (newdir[0])
&& IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
#ifdef WINDOWSNT
&& ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
#endif
)
{
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
newdir += 2;
}
if (!IS_DIRECTORY_SEP (nm[0]))
{
char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
file_name_as_directory (tmp, newdir);
strcat (tmp, nm);
nm = tmp;
}
newdir = alloca (MAXPATHLEN + 1);
if (drive)
{
if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
newdir = "/";
}
else
getwd (newdir);
}
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
newdir += 2;
}
if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
{
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
{
newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
p = newdir + 2;
while (*p && !IS_DIRECTORY_SEP (*p)) p++;
p++;
while (*p && !IS_DIRECTORY_SEP (*p)) p++;
*p = 0;
}
else
#endif
newdir = "";
}
}
#endif
if (newdir)
{
length = strlen (newdir);
if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
#ifdef WINDOWSNT
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
)
{
unsigned char *temp = (unsigned char *) alloca (length);
bcopy (newdir, temp, length - 1);
temp[length - 1] = 0;
newdir = temp;
}
tlen = length + 1;
}
else
tlen = 0;
tlen += strlen (nm) + 1;
#ifdef DOS_NT
target = (unsigned char *) alloca (tlen + 4);
target += 4;
#else
target = (unsigned char *) alloca (tlen);
#endif
*target = 0;
if (newdir)
{
#ifndef VMS
if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
{
#ifdef DOS_NT
if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
&& newdir[1] == '\0'))
#endif
strcpy (target, newdir);
}
else
#endif
file_name_as_directory (target, newdir);
}
strcat (target, nm);
#ifdef VMS
if (index (target, '/'))
strcpy (target, sys_translate_unix (target));
#endif
p = target;
o = target;
while (*p)
{
#ifdef VMS
if (*p != ']' && *p != '>' && *p != '-')
{
if (*p == '\\')
p++;
*o++ = *p++;
}
else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
{
p += 2;
if (*p != '.' && *p != '-' && o[-1] != '.')
while (o[-1] != '[' && o[-1] != '<')
o--;
else if (*p == '-' && *o != '.')
*--p = '.';
}
else if (p[0] == '-' && o[-1] == '.'
&& (p[1] == '.' || p[1] == ']' || p[1] == '>'))
{
do
o--;
while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
if (p[1] == '.')
p += 2;
else if (o[-1] == '.')
p++, o--;
}
else
{
#ifdef NO_HYPHENS_IN_FILENAMES
if (*p == '-'
&& o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
&& p[1] != ']' && p[1] != '>' && p[1] != '.')
*p = '_';
#endif
*o++ = *p++;
}
#else
if (!IS_DIRECTORY_SEP (*p))
{
*o++ = *p++;
}
else if (p[1] == '.'
&& (IS_DIRECTORY_SEP (p[2])
|| p[2] == 0))
{
if (o == target && p[2] == '\0')
*o++ = *p;
p += 2;
}
else if (p[1] == '.' && p[2] == '.'
#ifndef DOS_NT
&& o != target
#endif
&& (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
;
if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
++o;
p += 3;
}
else if (p > target && IS_DIRECTORY_SEP (p[1]))
p++;
else
{
*o++ = *p++;
}
#endif
}
#ifdef DOS_NT
#ifdef WINDOWSNT
if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
#endif
{
if (!drive) abort ();
target -= 2;
target[0] = DRIVE_LETTER (drive);
target[1] = ':';
}
if (is_escaped)
{
target -= 2;
target[0] = '/';
target[1] = ':';
}
CORRECT_DIR_SEPS (target);
#endif
result = make_specified_string (target, -1, o - target, multibyte);
handler = Ffind_file_name_handler (result, Qexpand_file_name);
if (!NILP (handler))
return call3 (handler, Qexpand_file_name, result, default_directory);
return result;
}
#if 0
DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert FILENAME to absolute, and canonicalize it.\n\
Second arg DEFAULT is directory to start with if FILENAME is relative\n\
\(does not start with slash); if DEFAULT is nil or missing,\n\
the current buffer's value of default-directory is used.\n\
Filenames containing `.' or `..' as components are simplified;\n\
initial `~/' expands to your home directory.\n\
See also the function `substitute-in-file-name'.")
(name, defalt)
Lisp_Object name, defalt;
{
unsigned char *nm;
register unsigned char *newdir, *p, *o;
int tlen;
unsigned char *target;
struct passwd *pw;
int lose;
#ifdef VMS
unsigned char * colon = 0;
unsigned char * close = 0;
unsigned char * slash = 0;
unsigned char * brack = 0;
int lbrack = 0, rbrack = 0;
int dots = 0;
#endif
CHECK_STRING (name);
#ifdef VMS
name = Fupcase (name);
#endif
nm = SDATA (name);
if (
nm[0] == '/'
#ifdef VMS
|| index (nm, ':')
#endif
)
{
p = nm;
lose = 0;
while (*p)
{
if (p[0] == '/' && p[1] == '/'
#ifdef APOLLO
&& nm != p
#endif
)
nm = p + 1;
if (p[0] == '/' && p[1] == '~')
nm = p + 1, lose = 1;
if (p[0] == '/' && p[1] == '.'
&& (p[2] == '/' || p[2] == 0
|| (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
lose = 1;
#ifdef VMS
if (p[0] == '\\')
lose = 1;
if (p[0] == '/') {
if (!slash && p > nm && (brack || colon)) {
nm = (brack ? brack + 1 : colon + 1);
lbrack = rbrack = 0;
brack = 0;
colon = 0;
}
slash = p;
}
if (p[0] == '-')
#ifndef VMS4_4
if (lbrack == rbrack)
{
if (dots < 2)
p[0] = '_';
}
else
#endif
if (lbrack > rbrack
&& ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
&& (p[1] == '.' || p[1] == ']' || p[1] == '>')))
lose = 1;
#ifndef VMS4_4
else
p[0] = '_';
#endif
if (p[0] == '[' || p[0] == '<')
lbrack++, brack = 0;
if (p[0] == ']' || p[0] == '>')
rbrack++, brack = p;
if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
lose = 1;
if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
nm = p + 1, lose = 1;
if (p[0] == ':' && (colon || slash))
if (brack)
{
nm = brack + 1;
brack = 0;
}
else if (slash)
nm = slash + 1;
else if (colon && colon[-1] == ':')
colon = p;
else if (colon && colon[-1] != ':')
{
nm = colon + 1;
colon = 0;
}
if (p[0] == ':' && !colon)
{
if (p[1] == ':')
p++;
colon = p;
}
if (lbrack == rbrack)
if (p[0] == ';')
dots = 2;
else if (p[0] == '.')
dots++;
#endif
p++;
}
if (!lose)
{
#ifdef VMS
if (index (nm, '/'))
return build_string (sys_translate_unix (nm));
#endif
if (nm == SDATA (name))
return name;
return build_string (nm);
}
}
newdir = 0;
if (nm[0] == '~')
if (nm[1] == '/'
#ifdef VMS
|| nm[1] == ':'
#endif
|| nm[1] == 0)
{
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
nm++;
#ifdef VMS
nm++;
#endif
}
else
{
unsigned char *user = nm + 1;
unsigned char *ptr = (unsigned char *) index (user, '/');
int len = ptr ? ptr - user : strlen (user);
#ifdef VMS
unsigned char *ptr1 = index (user, ':');
if (ptr1 != 0 && ptr1 - user < len)
len = ptr1 - user;
#endif
o = (unsigned char *) alloca (len + 1);
bcopy ((char *) user, o, len);
o[len] = 0;
BLOCK_INPUT;
pw = (struct passwd *) getpwnam (o + 1);
UNBLOCK_INPUT;
if (!pw)
error ("\"%s\" isn't a registered user", o + 1);
newdir = (unsigned char *) pw->pw_dir;
nm += len;
}
if (nm[0] != '/'
#ifdef VMS
&& !index (nm, ':')
#endif
&& !newdir)
{
if (NILP (defalt))
defalt = current_buffer->directory;
CHECK_STRING (defalt);
newdir = SDATA (defalt);
}
tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
target = (unsigned char *) alloca (tlen);
*target = 0;
if (newdir)
{
#ifndef VMS
if (nm[0] == 0 || nm[0] == '/')
strcpy (target, newdir);
else
#endif
file_name_as_directory (target, newdir);
}
strcat (target, nm);
#ifdef VMS
if (index (target, '/'))
strcpy (target, sys_translate_unix (target));
#endif
p = target;
o = target;
while (*p)
{
#ifdef VMS
if (*p != ']' && *p != '>' && *p != '-')
{
if (*p == '\\')
p++;
*o++ = *p++;
}
else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
{
p += 2;
if (*p != '.' && *p != '-' && o[-1] != '.')
while (o[-1] != '[' && o[-1] != '<')
o--;
else if (*p == '-' && *o != '.')
*--p = '.';
}
else if (p[0] == '-' && o[-1] == '.'
&& (p[1] == '.' || p[1] == ']' || p[1] == '>'))
{
do
o--;
while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
if (p[1] == '.')
p += 2;
else if (o[-1] == '.')
p++, o--;
}
else
{
#ifndef VMS4_4
if (*p == '-'
&& o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
&& p[1] != ']' && p[1] != '>' && p[1] != '.')
*p = '_';
#endif
*o++ = *p++;
}
#else
if (*p != '/')
{
*o++ = *p++;
}
else if (!strncmp (p, "//", 2)
#ifdef APOLLO
&& o != target
#endif
)
{
o = target;
p++;
}
else if (p[0] == '/' && p[1] == '.'
&& (p[2] == '/' || p[2] == 0))
p += 2;
else if (!strncmp (p, "/..", 3)
&& o != target
&& (p[3] == '/' || p[3] == 0))
{
while (o != target && *--o != '/')
;
#ifdef APOLLO
if (o == target + 1 && o[-1] == '/' && o[0] == '/')
++o;
else
#endif
if (o == target && *o == '/')
++o;
p += 3;
}
else
{
*o++ = *p++;
}
#endif
}
return make_string (target, o - target);
}
#endif
static int
file_name_absolute_p (filename)
const unsigned char *filename;
{
return
(IS_DIRECTORY_SEP (*filename) || *filename == '~'
#ifdef VMS
|| index (filename, ':') || index (filename, '<')
|| (*filename == '[' && (filename[1] != '-'
|| (filename[2] != '.' && filename[2] != ']'))
&& filename[1] != '.')
#endif
#ifdef DOS_NT
|| (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
&& IS_DIRECTORY_SEP (filename[2]))
#endif
);
}
static unsigned char *
search_embedded_absfilename (nm, endp)
unsigned char *nm, *endp;
{
unsigned char *p, *s;
for (p = nm + 1; p < endp; p++)
{
if ((0
#ifdef VMS
|| p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
#endif
|| IS_DIRECTORY_SEP (p[-1]))
&& file_name_absolute_p (p)
#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
&& !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
#endif
)
{
for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
#ifdef VMS
&& *s != ':'
#endif
); s++);
if (p[0] == '~' && s > p + 1)
{
unsigned char *o = alloca (s - p + 1);
struct passwd *pw;
bcopy (p, o, s - p);
o [s - p] = 0;
BLOCK_INPUT;
pw = getpwnam (o + 1);
UNBLOCK_INPUT;
if (pw)
return p;
}
else
return p;
}
}
return NULL;
}
DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
Ssubstitute_in_file_name, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
unsigned char *nm;
register unsigned char *s, *p, *o, *x, *endp;
unsigned char *target = NULL;
int total = 0;
int substituted = 0;
unsigned char *xnm;
Lisp_Object handler;
CHECK_STRING (filename);
handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
if (!NILP (handler))
return call2 (handler, Qsubstitute_in_file_name, filename);
nm = SDATA (filename);
#ifdef DOS_NT
nm = strcpy (alloca (strlen (nm) + 1), nm);
CORRECT_DIR_SEPS (nm);
substituted = (strcmp (nm, SDATA (filename)) != 0);
#endif
endp = nm + SBYTES (filename);
p = search_embedded_absfilename (nm, endp);
if (p)
return Fsubstitute_in_file_name
(make_specified_string (p, -1, endp - p,
STRING_MULTIBYTE (filename)));
#ifdef VMS
return filename;
#else
for (p = nm; p != endp;)
if (*p != '$')
p++;
else
{
p++;
if (p == endp)
goto badsubst;
else if (*p == '$')
{
p++;
total -= 1;
substituted = 1;
continue;
}
else if (*p == '{')
{
o = ++p;
while (p != endp && *p != '}') p++;
if (*p != '}') goto missingclose;
s = p;
}
else
{
o = p;
while (p != endp && (isalnum (*p) || *p == '_')) p++;
s = p;
}
target = (unsigned char *) alloca (s - o + 1);
strncpy (target, o, s - o);
target[s - o] = 0;
#ifdef DOS_NT
strupr (target);
#endif
o = (unsigned char *) egetenv (target);
if (o)
{
total += strlen (o);
substituted = 1;
}
else if (*p == '}')
goto badvar;
}
if (!substituted)
return filename;
xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
x = xnm;
for (p = nm; *p;)
if (*p != '$')
*x++ = *p++;
else
{
p++;
if (p == endp)
goto badsubst;
else if (*p == '$')
{
*x++ = *p++;
continue;
}
else if (*p == '{')
{
o = ++p;
while (p != endp && *p != '}') p++;
if (*p != '}') goto missingclose;
s = p++;
}
else
{
o = p;
while (p != endp && (isalnum (*p) || *p == '_')) p++;
s = p;
}
target = (unsigned char *) alloca (s - o + 1);
strncpy (target, o, s - o);
target[s - o] = 0;
#ifdef DOS_NT
strupr (target);
#endif
o = (unsigned char *) egetenv (target);
if (!o)
{
*x++ = '$';
strcpy (x, target); x+= strlen (target);
}
else if (STRING_MULTIBYTE (filename))
{
while (*o)
{
int c = unibyte_char_to_multibyte (*o++);
x += CHAR_STRING (c, x);
}
}
else
{
strcpy (x, o);
x += strlen (o);
}
}
*x = 0;
while ((p = search_embedded_absfilename (xnm, x)))
xnm = p;
return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
badsubst:
error ("Bad format environment-variable substitution");
missingclose:
error ("Missing \"}\" in environment-variable substitution");
badvar:
error ("Substituting nonexistent environment variable \"%s\"", target);
#endif
return Qnil;
}
Lisp_Object
expand_and_dir_to_file (filename, defdir)
Lisp_Object filename, defdir;
{
register Lisp_Object absname;
absname = Fexpand_file_name (filename, defdir);
#ifdef VMS
{
register int c = SREF (absname, SBYTES (absname) - 1);
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
#else
if (SCHARS (absname) > 1
&& IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
&& !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
absname = Fdirectory_file_name (absname);
#endif
return absname;
}
void
barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
Lisp_Object absname;
unsigned char *querystring;
int interactive;
struct stat *statptr;
int quick;
{
register Lisp_Object tem, encoded_filename;
struct stat statbuf;
struct gcpro gcpro1;
encoded_filename = ENCODE_FILE (absname);
if (lstat (SDATA (encoded_filename), &statbuf) >= 0)
{
if (! interactive)
xsignal2 (Qfile_already_exists,
build_string ("File already exists"), absname);
GCPRO1 (absname);
tem = format2 ("File %s already exists; %s anyway? ",
absname, build_string (querystring));
if (quick)
tem = Fy_or_n_p (tem);
else
tem = do_yes_or_no_p (tem);
UNGCPRO;
if (NILP (tem))
xsignal2 (Qfile_already_exists,
build_string ("File already exists"), absname);
if (statptr)
*statptr = statbuf;
}
else
{
if (statptr)
statptr->st_mode = 0;
}
return;
}
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
"fCopy file: \nGCopy %s to file: \np\nP",
doc: )
(file, newname, ok_if_already_exists, keep_time, preserve_uid_gid)
Lisp_Object file, newname, ok_if_already_exists, keep_time;
Lisp_Object preserve_uid_gid;
{
int ifd, ofd, n;
char buf[16 * 1024];
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int count = SPECPDL_INDEX ();
int input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
CHECK_STRING (file);
CHECK_STRING (newname);
if (!NILP (Ffile_directory_p (newname)))
newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
else
newname = Fexpand_file_name (newname, Qnil);
file = Fexpand_file_name (file, Qnil);
handler = Ffind_file_name_handler (file, Qcopy_file);
if (NILP (handler))
handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
ok_if_already_exists, keep_time));
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st, 0);
else if (stat (SDATA (encoded_newname), &out_st) < 0)
out_st.st_mode = 0;
#ifdef WINDOWSNT
if (!CopyFile (SDATA (encoded_file),
SDATA (encoded_newname),
FALSE))
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
else if (NILP (keep_time))
{
EMACS_TIME now;
DWORD attributes;
char * filename;
EMACS_GET_TIME (now);
filename = SDATA (encoded_newname);
attributes = GetFileAttributes (filename);
SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
if (set_file_times (filename, now, now))
{
SetFileAttributes (filename, attributes);
xsignal2 (Qfile_date_error,
build_string ("Cannot set file date"), newname);
}
SetFileAttributes (filename, attributes);
}
#else
immediate_quit = 1;
ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
immediate_quit = 0;
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
record_unwind_protect (close_file_unwind, make_number (ifd));
input_file_statable_p = (fstat (ifd, &st) >= 0);
#if !defined (MSDOS) || __DJGPP__ > 1
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
{
errno = 0;
report_file_error ("Input and output files are the same",
Fcons (file, Fcons (newname, Qnil)));
}
#endif
#if defined (S_ISREG) && defined (S_ISLNK)
if (input_file_statable_p)
{
if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode)))
{
#if defined (EISDIR)
errno = EISDIR;
#endif
report_file_error ("Non-regular file", Fcons (file, Qnil));
}
}
#endif
#ifdef VMS
ofd = sys_creat (SDATA (encoded_newname), 0666, ifd);
#else
#ifdef MSDOS
ofd = emacs_open (SDATA (encoded_newname),
O_WRONLY | O_TRUNC | O_CREAT
| (NILP (ok_if_already_exists) ? O_EXCL : 0),
S_IREAD | S_IWRITE);
#else
ofd = emacs_open (SDATA (encoded_newname),
O_WRONLY | O_TRUNC | O_CREAT
| (NILP (ok_if_already_exists) ? O_EXCL : 0),
0666);
#endif
#endif
if (ofd < 0)
report_file_error ("Opening output file", Fcons (newname, Qnil));
record_unwind_protect (close_file_unwind, make_number (ofd));
immediate_quit = 1;
QUIT;
while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
if (emacs_write (ofd, buf, n) != n)
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
#ifndef MSDOS
if (input_file_statable_p)
{
if (! NILP (preserve_uid_gid))
fchown (ofd, st.st_uid, st.st_gid);
fchmod (ofd, st.st_mode & 07777);
}
#endif
if (emacs_close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
if (input_file_statable_p)
{
if (!NILP (keep_time))
{
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
if (set_file_times (SDATA (encoded_newname),
atime, mtime))
xsignal2 (Qfile_date_error,
build_string ("Cannot set file date"), newname);
}
}
emacs_close (ifd);
#if defined (__DJGPP__) && __DJGPP__ > 1
if (input_file_statable_p)
{
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
chmod (SDATA (encoded_newname), st.st_mode & 07777);
}
#endif
#endif
specpdl_ptr = specpdl + count;
UNGCPRO;
return Qnil;
}
DEFUN ("make-directory-internal", Fmake_directory_internal,
Smake_directory_internal, 1, 1, 0,
doc: )
(directory)
Lisp_Object directory;
{
const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
CHECK_STRING (directory);
directory = Fexpand_file_name (directory, Qnil);
handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
if (!NILP (handler))
return call2 (handler, Qmake_directory_internal, directory);
encoded_dir = ENCODE_FILE (directory);
dir = SDATA (encoded_dir);
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
#else
if (mkdir (dir, 0777) != 0)
#endif
report_file_error ("Creating directory", list1 (directory));
return Qnil;
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
doc: )
(directory)
Lisp_Object directory;
{
const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
CHECK_STRING (directory);
directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
handler = Ffind_file_name_handler (directory, Qdelete_directory);
if (!NILP (handler))
return call2 (handler, Qdelete_directory, directory);
encoded_dir = ENCODE_FILE (directory);
dir = SDATA (encoded_dir);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", list1 (directory));
return Qnil;
}
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
Lisp_Object encoded_file;
struct gcpro gcpro1;
GCPRO1 (filename);
if (!NILP (Ffile_directory_p (filename))
&& NILP (Ffile_symlink_p (filename)))
xsignal2 (Qfile_error,
build_string ("Removing old name: is a directory"),
filename);
UNGCPRO;
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qdelete_file);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
encoded_file = ENCODE_FILE (filename);
if (0 > unlink (SDATA (encoded_file)))
report_file_error ("Removing old name", list1 (filename));
return Qnil;
}
static Lisp_Object
internal_delete_file_1 (ignore)
Lisp_Object ignore;
{
return Qt;
}
int
internal_delete_file (filename)
Lisp_Object filename;
{
Lisp_Object tem;
tem = internal_condition_case_1 (Fdelete_file, filename,
Qt, internal_delete_file_1);
return NILP (tem);
}
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
"fRename file: \nGRename %s to file: \np",
doc: )
(file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object encoded_file, encoded_newname, symlink_target;
symlink_target = encoded_file = encoded_newname = Qnil;
GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
CHECK_STRING (file);
CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
if ((!NILP (Ffile_directory_p (newname)))
#ifdef DOS_NT
&& (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
#endif
)
newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
else
newname = Fexpand_file_name (newname, Qnil);
handler = Ffind_file_name_handler (file, Qrename_file);
if (NILP (handler))
handler = Ffind_file_name_handler (newname, Qrename_file);
if (!NILP (handler))
RETURN_UNGCPRO (call4 (handler, Qrename_file,
file, newname, ok_if_already_exists));
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
#ifdef DOS_NT
if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
#endif
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
#ifndef BSD4_1
if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
#else
if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
|| 0 > unlink (SDATA (encoded_file)))
#endif
{
if (errno == EXDEV)
{
#ifdef S_IFLNK
symlink_target = Ffile_symlink_p (file);
if (! NILP (symlink_target))
Fmake_symbolic_link (symlink_target, newname,
NILP (ok_if_already_exists) ? Qnil : Qt);
else
#endif
Fcopy_file (file, newname,
NILP (ok_if_already_exists) ? Qnil : Qt,
Qt, Qt);
Fdelete_file (file);
}
else
report_file_error ("Renaming", list2 (file, newname));
}
UNGCPRO;
return Qnil;
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
"fAdd name to file: \nGName to add to %s: \np",
doc: )
(file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
GCPRO4 (file, newname, encoded_file, encoded_newname);
encoded_file = encoded_newname = Qnil;
CHECK_STRING (file);
CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
if (!NILP (Ffile_directory_p (newname)))
newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
else
newname = Fexpand_file_name (newname, Qnil);
handler = Ffind_file_name_handler (file, Qadd_name_to_file);
if (!NILP (handler))
RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
newname, ok_if_already_exists));
handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
if (!NILP (handler))
RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
newname, ok_if_already_exists));
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0, 0);
unlink (SDATA (newname));
if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
report_file_error ("Adding new name", list2 (file, newname));
UNGCPRO;
return Qnil;
}
#ifdef S_IFLNK
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
"FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
doc: )
(filename, linkname, ok_if_already_exists)
Lisp_Object filename, linkname, ok_if_already_exists;
{
Lisp_Object handler;
Lisp_Object encoded_filename, encoded_linkname;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
encoded_filename = encoded_linkname = Qnil;
CHECK_STRING (filename);
CHECK_STRING (linkname);
if (SREF (filename, 0) == '~')
filename = Fexpand_file_name (filename, Qnil);
if (!NILP (Ffile_directory_p (linkname)))
linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
else
linkname = Fexpand_file_name (linkname, Qnil);
handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
if (!NILP (handler))
RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
linkname, ok_if_already_exists));
handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
if (!NILP (handler))
RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
linkname, ok_if_already_exists));
encoded_filename = ENCODE_FILE (filename);
encoded_linkname = ENCODE_FILE (linkname);
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
if (0 > symlink (SDATA (encoded_filename),
SDATA (encoded_linkname)))
{
if (errno == EEXIST)
{
unlink (SDATA (encoded_linkname));
if (0 <= symlink (SDATA (encoded_filename),
SDATA (encoded_linkname)))
{
UNGCPRO;
return Qnil;
}
}
report_file_error ("Making symbolic link", list2 (filename, linkname));
}
UNGCPRO;
return Qnil;
}
#endif
#ifdef VMS
DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
doc: )
(name, string)
Lisp_Object name;
Lisp_Object string;
{
CHECK_STRING (name);
if (NILP (string))
delete_logical_name (SDATA (name));
else
{
CHECK_STRING (string);
if (SCHARS (string) == 0)
delete_logical_name (SDATA (name));
else
define_logical_name (SDATA (name), SDATA (string));
}
return string;
}
#endif
#ifdef HPUX_NET
DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
doc: )
(path, login)
Lisp_Object path, login;
{
int netresult;
CHECK_STRING (path);
CHECK_STRING (login);
netresult = netunam (SDATA (path), SDATA (login));
if (netresult == -1)
return Qnil;
else
return Qt;
}
#endif
DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
CHECK_STRING (filename);
return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil;
}
static int
check_executable (filename)
char *filename;
{
#ifdef DOS_NT
int len = strlen (filename);
char *suffix;
struct stat st;
if (stat (filename, &st) < 0)
return 0;
#if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
return ((st.st_mode & S_IEXEC) != 0);
#else
return (S_ISREG (st.st_mode)
&& len >= 5
&& (stricmp ((suffix = filename + len-4), ".com") == 0
|| stricmp (suffix, ".exe") == 0
|| stricmp (suffix, ".bat") == 0)
|| (st.st_mode & S_IFMT) == S_IFDIR);
#endif
#else
#ifdef HAVE_EUIDACCESS
return (euidaccess (filename, 1) >= 0);
#else
return (access (filename, 1) >= 0);
#endif
#endif
}
static int
check_writable (filename)
char *filename;
{
#ifdef MSDOS
struct stat st;
if (stat (filename, &st) < 0)
return 0;
return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR);
#else
#ifdef HAVE_EUIDACCESS
return (euidaccess (filename, 2) >= 0);
#else
return (access (filename, 2) >= 0);
#endif
#endif
}
DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (absname, Qfile_exists_p);
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, absname);
absname = ENCODE_FILE (absname);
return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (absname, Qfile_executable_p);
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, absname);
absname = ENCODE_FILE (absname);
return (check_executable (SDATA (absname)) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
int desc;
int flags;
struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (absname, Qfile_readable_p);
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, absname);
absname = ENCODE_FILE (absname);
#if defined(DOS_NT) || defined(macintosh)
if (access (SDATA (absname), 0) == 0)
return Qt;
return Qnil;
#else
flags = O_RDONLY;
#if defined (S_ISFIFO) && defined (O_NONBLOCK)
desc = stat (SDATA (absname), &statbuf);
if (desc < 0)
return Qnil;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
desc = emacs_open (SDATA (absname), flags, 0);
if (desc < 0)
return Qnil;
emacs_close (desc);
return Qt;
#endif
}
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object absname, dir, encoded;
Lisp_Object handler;
struct stat statbuf;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (absname, Qfile_writable_p);
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
if (stat (SDATA (encoded), &statbuf) >= 0)
return (check_writable (SDATA (encoded))
? Qt : Qnil);
dir = Ffile_name_directory (absname);
#ifdef VMS
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
#endif
#ifdef MSDOS
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
#endif
dir = ENCODE_FILE (dir);
#ifdef WINDOWSNT
if (stat (SDATA (dir), &statbuf) < 0)
return Qnil;
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
#else
return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
? Qt : Qnil);
#endif
}
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
doc: )
(filename, string)
Lisp_Object filename, string;
{
Lisp_Object handler, encoded_filename, absname;
int fd;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
CHECK_STRING (string);
handler = Ffind_file_name_handler (absname, Qaccess_file);
if (!NILP (handler))
return call3 (handler, Qaccess_file, absname, string);
encoded_filename = ENCODE_FILE (absname);
fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
if (fd < 0)
report_file_error (SDATA (string), Fcons (filename, Qnil));
emacs_close (fd);
return Qnil;
}
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
#ifdef S_IFLNK
{
char *buf;
int bufsize;
int valsize;
Lisp_Object val;
filename = ENCODE_FILE (filename);
bufsize = 50;
buf = NULL;
do
{
bufsize *= 2;
buf = (char *) xrealloc (buf, bufsize);
bzero (buf, bufsize);
errno = 0;
valsize = readlink (SDATA (filename), buf, bufsize);
if (valsize == -1)
{
#ifdef ERANGE
if (errno == ERANGE)
valsize = bufsize;
else
#endif
{
xfree (buf);
return Qnil;
}
}
}
while (valsize >= bufsize);
val = make_string (buf, valsize);
if (buf[0] == '/' && index (buf, ':'))
val = concat2 (build_string ("/:"), val);
xfree (buf);
val = DECODE_FILE (val);
return val;
}
#else
return Qnil;
#endif
}
DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
register Lisp_Object absname;
struct stat st;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, current_buffer->directory);
handler = Ffind_file_name_handler (absname, Qfile_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, absname);
absname = ENCODE_FILE (absname);
if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
}
DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
int tem;
struct gcpro gcpro1;
handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
GCPRO1 (filename);
tem = (NILP (Ffile_directory_p (filename))
|| NILP (Ffile_executable_p (filename)));
UNGCPRO;
return tem ? Qnil : Qt;
}
DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
register Lisp_Object absname;
struct stat st;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, current_buffer->directory);
handler = Ffind_file_name_handler (absname, Qfile_regular_p);
if (!NILP (handler))
return call2 (handler, Qfile_regular_p, absname);
absname = ENCODE_FILE (absname);
#ifdef WINDOWSNT
{
int result;
Lisp_Object tem = Vw32_get_true_file_attributes;
Vw32_get_true_file_attributes = Qt;
result = stat (SDATA (absname), &st);
Vw32_get_true_file_attributes = tem;
if (result < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
}
#else
if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
#endif
}
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
doc: )
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
struct stat st;
Lisp_Object handler;
absname = expand_and_dir_to_file (filename, current_buffer->directory);
handler = Ffind_file_name_handler (absname, Qfile_modes);
if (!NILP (handler))
return call2 (handler, Qfile_modes, absname);
absname = ENCODE_FILE (absname);
if (stat (SDATA (absname), &st) < 0)
return Qnil;
#if defined (MSDOS) && __DJGPP__ < 2
if (check_executable (SDATA (absname)))
st.st_mode |= S_IEXEC;
#endif
return make_number (st.st_mode & 07777);
}
DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
doc: )
(filename, mode)
Lisp_Object filename, mode;
{
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
absname = Fexpand_file_name (filename, current_buffer->directory);
CHECK_NUMBER (mode);
handler = Ffind_file_name_handler (absname, Qset_file_modes);
if (!NILP (handler))
return call3 (handler, Qset_file_modes, absname, mode);
encoded_absname = ENCODE_FILE (absname);
if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
return Qnil;
}
DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
doc: )
(mode)
Lisp_Object mode;
{
CHECK_NUMBER (mode);
umask ((~ XINT (mode)) & 0777);
return Qnil;
}
DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
doc: )
()
{
int realmask;
Lisp_Object value;
realmask = umask (0);
umask (realmask);
XSETINT (value, (~ realmask) & 0777);
return value;
}
extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
doc: )
(filename, time)
Lisp_Object filename, time;
{
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
time_t sec;
int usec;
if (! lisp_time_argument (time, &sec, &usec))
error ("Invalid time specification");
absname = Fexpand_file_name (filename, current_buffer->directory);
handler = Ffind_file_name_handler (absname, Qset_file_times);
if (!NILP (handler))
return call3 (handler, Qset_file_times, absname, time);
encoded_absname = ENCODE_FILE (absname);
{
EMACS_TIME t;
EMACS_SET_SECS (t, sec);
EMACS_SET_USECS (t, usec);
if (set_file_times (SDATA (encoded_absname), t, t))
{
#ifdef DOS_NT
struct stat st;
if (stat (SDATA (encoded_absname), &st) == 0
&& (st.st_mode & S_IFMT) == S_IFDIR)
return Qnil;
#endif
report_file_error ("Setting file times", Fcons (absname, Qnil));
return Qnil;
}
}
return Qt;
}
#ifdef HAVE_SYNC
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
doc: )
()
{
sync ();
return Qnil;
}
#endif
DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
doc: )
(file1, file2)
Lisp_Object file1, file2;
{
Lisp_Object absname1, absname2;
struct stat st;
int mtime1;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
CHECK_STRING (file1);
CHECK_STRING (file2);
absname1 = Qnil;
GCPRO2 (absname1, file2);
absname1 = expand_and_dir_to_file (file1, current_buffer->directory);
absname2 = expand_and_dir_to_file (file2, current_buffer->directory);
UNGCPRO;
handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
if (NILP (handler))
handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
GCPRO2 (absname1, absname2);
absname1 = ENCODE_FILE (absname1);
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
if (stat (SDATA (absname1), &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
if (stat (SDATA (absname2), &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
}
#ifdef DOS_NT
Lisp_Object Qfind_buffer_file_type;
#endif
#ifndef READ_BUF_SIZE
#define READ_BUF_SIZE (64 << 10)
#endif
extern void adjust_markers_for_delete P_ ((int, int, int, int));
static Lisp_Object
decide_coding_unwind (unwind_data)
Lisp_Object unwind_data;
{
Lisp_Object multibyte, undo_list, buffer;
multibyte = XCAR (unwind_data);
unwind_data = XCDR (unwind_data);
undo_list = XCAR (unwind_data);
buffer = XCDR (unwind_data);
if (current_buffer != XBUFFER (buffer))
set_buffer_internal (XBUFFER (buffer));
adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
adjust_overlays_for_delete (BEG, Z - BEG);
BUF_INTERVALS (current_buffer) = 0;
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
current_buffer->enable_multibyte_characters = multibyte;
current_buffer->undo_list = undo_list;
return Qnil;
}
static int non_regular_fd;
static int non_regular_inserted;
static int non_regular_nbytes;
static Lisp_Object
read_non_regular ()
{
int nbytes;
immediate_quit = 1;
QUIT;
nbytes = emacs_read (non_regular_fd,
BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
non_regular_nbytes);
immediate_quit = 0;
return make_number (nbytes);
}
static Lisp_Object
read_non_regular_quit ()
{
return Qnil;
}
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
doc: )
(filename, visit, beg, end, replace)
Lisp_Object filename, visit, beg, end, replace;
{
struct stat st;
register int fd;
int inserted = 0;
register int how_much;
register int unprocessed;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object handler, val, insval, orig_filename;
Lisp_Object p;
int total = 0;
int not_regular = 0;
unsigned char read_buf[READ_BUF_SIZE];
struct coding_system coding;
unsigned char buffer[1 << 14];
int replace_handled = 0;
int set_coding_system = 0;
int coding_system_decided = 0;
int read_quit = 0;
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
int we_locked_file = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
if (!NILP (current_buffer->read_only))
Fbarf_if_buffer_read_only ();
val = Qnil;
p = Qnil;
orig_filename = Qnil;
GCPRO4 (filename, val, p, orig_filename);
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
if (!NILP (handler))
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
if (CONSP (val) && CONSP (XCDR (val)))
inserted = XINT (XCAR (XCDR (val)));
goto handled;
}
orig_filename = filename;
filename = ENCODE_FILE (filename);
fd = -1;
#ifdef WINDOWSNT
{
Lisp_Object tem = Vw32_get_true_file_attributes;
Vw32_get_true_file_attributes = Qt;
total = stat (SDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
if (total < 0)
#else
#ifndef APOLLO
if (stat (SDATA (filename), &st) < 0)
#else
if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif
#endif
{
if (fd >= 0) emacs_close (fd);
badopen:
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
st.st_mtime = -1;
how_much = 0;
if (!NILP (Vcoding_system_for_read))
Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
goto notfound;
}
#ifdef S_IFREG
if (!S_ISREG (st.st_mode))
{
not_regular = 1;
if (! NILP (visit))
goto notfound;
if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
xsignal2 (Qfile_error,
build_string ("not a regular file"), orig_filename);
}
#endif
if (fd < 0)
if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
goto badopen;
if (!NILP (replace))
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (close_file_unwind, make_number (fd));
if (! not_regular && st.st_size < 0)
error ("Maximum buffer size exceeded");
current_buffer->clip_changed = 1;
if (!NILP (visit))
{
if (!NILP (beg) || !NILP (end))
error ("Attempt to visit less than an entire file");
if (BEG < Z && NILP (replace))
error ("Cannot do file visiting in a non-empty buffer");
}
if (!NILP (beg))
CHECK_NUMBER (beg);
else
XSETFASTINT (beg, 0);
if (!NILP (end))
CHECK_NUMBER (end);
else
{
if (! not_regular)
{
XSETINT (end, st.st_size);
if (XINT (end) != st.st_size
|| ((int) st.st_size * 4) / 4 != st.st_size)
error ("Maximum buffer size exceeded");
if (st.st_size == 0)
XSETINT (end, READ_BUF_SIZE);
}
}
if (EQ (Vcoding_system_for_read, Qauto_save_coding))
{
setup_coding_system (Qemacs_mule, &coding);
coding.flags = 1;
coding.src_multibyte = 0;
coding.dst_multibyte
= !NILP (current_buffer->enable_multibyte_characters);
coding.eol_type = CODING_EOL_LF;
coding_system_decided = 1;
}
else if (BEG < Z)
{
Lisp_Object val;
val = Qnil;
if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else
{
if (! not_regular && ! NILP (Vset_auto_coding_function))
{
int nread;
if (st.st_size <= (1024 * 4))
nread = emacs_read (fd, read_buf, 1024 * 4);
else
{
nread = emacs_read (fd, read_buf, 1024);
if (nread >= 0)
{
if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
nread += emacs_read (fd, read_buf + nread, 1024 * 3);
}
}
if (nread < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
else if (nread > 0)
{
struct buffer *prev = current_buffer;
Lisp_Object buffer;
struct buffer *buf;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
buf = XBUFFER (buffer);
delete_all_overlays (buf);
buf->directory = current_buffer->directory;
buf->read_only = Qnil;
buf->filename = Qnil;
buf->undo_list = Qt;
eassert (buf->overlays_before == NULL);
eassert (buf->overlays_after == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
buf->enable_multibyte_characters = Qnil;
insert_1_both (read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
val = call2 (Vset_auto_coding_function,
filename, make_number (nread));
set_buffer_internal (prev);
specpdl_ptr--;
if (lseek (fd, 0, 0) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
}
if (NILP (val))
{
Lisp_Object args[6], coding_systems;
args[0] = Qinsert_file_contents, args[1] = orig_filename;
args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
coding_systems = Ffind_operation_coding_system (6, args);
if (CONSP (coding_systems))
val = XCAR (coding_systems);
}
}
setup_coding_system (Fcheck_coding_system (val), &coding);
set_coding_system = 1;
if (NILP (current_buffer->enable_multibyte_characters)
&& ! NILP (val))
setup_raw_text_coding_system (&coding);
coding.src_multibyte = 0;
coding.dst_multibyte
= !NILP (current_buffer->enable_multibyte_characters);
coding_system_decided = 1;
}
if (!NILP (replace)
&& BEGV < ZV
&& !(coding.common_flags & CODING_REQUIRE_DECODING_MASK))
{
int same_at_start = BEGV_BYTE;
int same_at_end = ZV_BYTE;
int overlap;
int giveup_match_end = 0;
if (XINT (beg) != 0)
{
if (lseek (fd, XINT (beg), 0) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
immediate_quit = 1;
QUIT;
while (1)
{
int nread, bufpos;
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
if (coding.type == coding_type_undecided)
detect_coding (&coding, buffer, nread);
if (coding.common_flags & CODING_REQUIRE_DECODING_MASK)
{
giveup_match_end = 1;
break;
}
if (coding.eol_type == CODING_EOL_UNDECIDED)
detect_eol (&coding, buffer, nread);
if (coding.eol_type != CODING_EOL_UNDECIDED
&& coding.eol_type != CODING_EOL_LF)
{
giveup_match_end = 1;
break;
}
bufpos = 0;
while (bufpos < nread && same_at_start < ZV_BYTE
&& FETCH_BYTE (same_at_start) == buffer[bufpos])
same_at_start++, bufpos++;
if (bufpos != nread)
break;
}
immediate_quit = 0;
if (same_at_start - BEGV_BYTE == XINT (end))
{
emacs_close (fd);
specpdl_ptr--;
del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
}
immediate_quit = 1;
QUIT;
while (!giveup_match_end)
{
int total_read, nread, bufpos, curpos, trial;
curpos = XINT (end) - (ZV_BYTE - same_at_end);
if (curpos == 0)
break;
trial = min (curpos, sizeof buffer);
if (lseek (fd, curpos - trial, 0) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
total_read = nread = 0;
while (total_read < trial)
{
nread = emacs_read (fd, buffer + total_read, trial - total_read);
if (nread < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
total_read += nread;
}
bufpos = total_read;
while (bufpos > 0 && same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1])
same_at_end--, bufpos--;
if (bufpos != 0)
{
if (same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) >= 0200
&& ! NILP (current_buffer->enable_multibyte_characters)
&& (CODING_MAY_REQUIRE_DECODING (&coding)))
giveup_match_end = 1;
break;
}
if (nread == 0)
break;
}
immediate_quit = 0;
if (! giveup_match_end)
{
int temp;
if (! NILP (current_buffer->enable_multibyte_characters))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
same_at_start--;
if (! NILP (current_buffer->enable_multibyte_characters))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
same_at_end++;
overlap = (same_at_start - BEGV_BYTE
- (same_at_end + st.st_size - ZV));
if (overlap > 0)
same_at_end += overlap;
XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE));
XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end));
del_range_byte (same_at_start, same_at_end, 0);
temp = BYTE_TO_CHAR (same_at_start);
SET_PT_BOTH (temp, same_at_start);
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
replace_handled = 1;
}
}
if (!NILP (replace) && ! replace_handled && BEGV < ZV)
{
int same_at_start = BEGV_BYTE;
int same_at_end = ZV_BYTE;
int overlap;
int bufpos;
int bufsize = 2 * st.st_size;
unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize);
int temp;
if (lseek (fd, XINT (beg), 0) < 0)
{
xfree (conversion_buffer);
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
total = st.st_size;
how_much = 0;
inserted = 0;
unprocessed = 0;
while (how_much < total)
{
int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
unsigned char *destination = read_buf + unprocessed;
int this;
immediate_quit = 1;
QUIT;
this = emacs_read (fd, destination, trytry);
immediate_quit = 0;
if (this < 0 || this + unprocessed == 0)
{
how_much = this;
break;
}
how_much += this;
if (CODING_MAY_REQUIRE_DECODING (&coding))
{
int require, result;
this += unprocessed;
require = decoding_buffer_size (&coding, this);
if (inserted + require + 2 * (total - how_much) > bufsize)
{
bufsize = inserted + require + 2 * (total - how_much);
conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize);
}
if (how_much >= total)
coding.mode |= CODING_MODE_LAST_BLOCK;
if (coding.composing != COMPOSITION_DISABLED)
coding_allocate_composition_data (&coding, BEGV);
result = decode_coding (&coding, read_buf,
conversion_buffer + inserted,
this, bufsize - inserted);
unprocessed = this - coding.consumed;
bcopy (read_buf + coding.consumed, read_buf, unprocessed);
if (!NILP (current_buffer->enable_multibyte_characters))
this = coding.produced;
else
this = str_as_unibyte (conversion_buffer + inserted,
coding.produced);
}
inserted += this;
}
if (how_much < 0)
{
xfree (conversion_buffer);
coding_free_composition_data (&coding);
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
}
bufpos = 0;
while (bufpos < inserted && same_at_start < same_at_end
&& FETCH_BYTE (same_at_start) == conversion_buffer[bufpos])
same_at_start++, bufpos++;
if (bufpos == inserted)
{
xfree (conversion_buffer);
coding_free_composition_data (&coding);
emacs_close (fd);
specpdl_ptr--;
del_range_byte (same_at_start, same_at_end, 0);
inserted = 0;
goto handled;
}
if (! NILP (current_buffer->enable_multibyte_characters))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
same_at_start--;
bufpos = inserted;
while (bufpos > 0 && same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
same_at_end--, bufpos--;
if (! NILP (current_buffer->enable_multibyte_characters))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
same_at_end++;
overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
if (overlap > 0)
same_at_end += overlap;
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
if (same_at_end != same_at_start)
{
del_range_byte (same_at_start, same_at_end, 0);
temp = GPT;
same_at_start = GPT_BYTE;
}
else
{
temp = BYTE_TO_CHAR (same_at_start);
}
SET_PT_BOTH (temp, same_at_start);
insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted,
0, 0, 0);
if (coding.cmp_data && coding.cmp_data->used)
coding_restore_composition (&coding, Fcurrent_buffer ());
coding_free_composition_data (&coding);
inserted = PT - temp;
SET_PT_BOTH (temp, same_at_start);
xfree (conversion_buffer);
emacs_close (fd);
specpdl_ptr--;
goto handled;
}
if (! not_regular)
{
register Lisp_Object temp;
total = XINT (end) - XINT (beg);
XSETINT (temp, total);
if (total != XINT (temp))
error ("Maximum buffer size exceeded");
}
else
total = READ_BUF_SIZE;
if (NILP (visit) && inserted > 0)
{
#ifdef CLASH_DETECTION
if (!NILP (current_buffer->file_truename)
&& !NILP (current_buffer->filename)
&& SAVE_MODIFF >= MODIFF)
we_locked_file = 1;
#endif
prepare_to_modify_buffer (GPT, GPT, NULL);
}
move_gap (PT);
if (GAP_SIZE < total)
make_gap (total - GAP_SIZE);
if (XINT (beg) != 0 || !NILP (replace))
{
if (lseek (fd, XINT (beg), 0) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
how_much = 0;
inserted = 0;
{
int gap_size = GAP_SIZE;
while (how_much < total)
{
int trytry = min (total - how_much, READ_BUF_SIZE);
int this;
if (not_regular)
{
Lisp_Object val;
if (gap_size < trytry)
{
make_gap (total - gap_size);
gap_size = GAP_SIZE;
}
non_regular_fd = fd;
non_regular_inserted = inserted;
non_regular_nbytes = trytry;
val = internal_condition_case_1 (read_non_regular, Qnil, Qerror,
read_non_regular_quit);
if (NILP (val))
{
read_quit = 1;
break;
}
this = XINT (val);
}
else
{
immediate_quit = 1;
QUIT;
this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
immediate_quit = 0;
}
if (this <= 0)
{
how_much = this;
break;
}
gap_size -= this;
if (! not_regular)
how_much += this;
inserted += this;
}
}
if (inserted == 0)
{
#ifdef CLASH_DETECTION
if (we_locked_file)
unlock_file (current_buffer->file_truename);
#endif
Vdeactivate_mark = old_Vdeactivate_mark;
}
else
Vdeactivate_mark = Qt;
GAP_SIZE -= inserted;
GPT += inserted;
GPT_BYTE += inserted;
ZV += inserted;
ZV_BYTE += inserted;
Z += inserted;
Z_BYTE += inserted;
if (GAP_SIZE > 0)
*GPT_ADDR = 0;
emacs_close (fd);
specpdl_ptr--;
if (how_much < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
notfound:
if (! coding_system_decided)
{
Lisp_Object val;
val = Qnil;
if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else
{
Lisp_Object unwind_data;
int count = SPECPDL_INDEX ();
unwind_data = Fcons (current_buffer->enable_multibyte_characters,
Fcons (current_buffer->undo_list,
Fcurrent_buffer ()));
current_buffer->enable_multibyte_characters = Qnil;
current_buffer->undo_list = Qt;
record_unwind_protect (decide_coding_unwind, unwind_data);
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
{
val = call2 (Vset_auto_coding_function,
filename, make_number (inserted));
}
if (NILP (val))
{
Lisp_Object args[6], coding_systems;
args[0] = Qinsert_file_contents, args[1] = orig_filename;
args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
coding_systems = Ffind_operation_coding_system (6, args);
if (CONSP (coding_systems))
val = XCAR (coding_systems);
}
unbind_to (count, Qnil);
inserted = Z_BYTE - BEG_BYTE;
}
{
struct coding_system temp_coding;
setup_coding_system (Fcheck_coding_system (val), &temp_coding);
bcopy (&temp_coding, &coding, sizeof coding);
}
set_coding_system = 1;
if (NILP (current_buffer->enable_multibyte_characters)
&& ! NILP (val))
setup_raw_text_coding_system (&coding);
coding.src_multibyte = 0;
coding.dst_multibyte
= !NILP (current_buffer->enable_multibyte_characters);
}
if (!NILP (visit)
&& NILP (replace)
&& (coding.type == coding_type_no_conversion
|| coding.type == coding_type_raw_text))
{
current_buffer->enable_multibyte_characters = Qnil;
coding.dst_multibyte = 0;
}
if (inserted > 0 || coding.type == coding_type_ccl)
{
if (CODING_MAY_REQUIRE_DECODING (&coding))
{
code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
&coding, 0, 0);
inserted = coding.produced_char;
}
else
adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
inserted);
}
#ifdef DOS_NT
if ((coding.eol_type == CODING_EOL_UNDECIDED
|| coding.eol_type == CODING_EOL_LF)
&& ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
else
current_buffer->buffer_file_type = Qnil;
#endif
handled:
if (!NILP (visit))
{
if (!EQ (current_buffer->undo_list, Qt))
current_buffer->undo_list = Qnil;
#ifdef APOLLO
stat (SDATA (filename), &st);
#endif
if (NILP (handler))
{
current_buffer->modtime = st.st_mtime;
current_buffer->filename = orig_filename;
}
SAVE_MODIFF = MODIFF;
current_buffer->auto_save_modified = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
#ifdef CLASH_DETECTION
if (NILP (handler))
{
if (!NILP (current_buffer->file_truename))
unlock_file (current_buffer->file_truename);
unlock_file (filename);
}
#endif
if (not_regular)
xsignal2 (Qfile_error,
build_string ("not a regular file"), orig_filename);
}
if (set_coding_system)
Vlast_coding_system_used = coding.symbol;
if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
{
insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
visit);
if (! NILP (insval))
{
CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
}
}
if (inserted > 0)
{
int empty_undo_list_p = 0;
if (!NILP (visit))
{
empty_undo_list_p = NILP (current_buffer->undo_list);
current_buffer->undo_list = Qt;
}
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
if (!NILP (visit))
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
if (inserted > 0 && total > 0
&& (NILP (visit) || !NILP (replace)))
{
signal_after_change (PT, 0, inserted);
update_compositions (PT, PT, CHECK_BORDER);
}
p = Vafter_insert_file_functions;
while (CONSP (p))
{
insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
}
QUIT;
p = XCDR (p);
}
if (!NILP (visit)
&& current_buffer->modtime == -1)
{
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
}
if (read_quit)
Fsignal (Qquit, Qnil);
if (NILP (val))
val = Fcons (orig_filename,
Fcons (make_number (inserted),
Qnil));
RETURN_UNGCPRO (unbind_to (count, val));
}
static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object));
static Lisp_Object
build_annotations_unwind (buf)
Lisp_Object buf;
{
Lisp_Object tembuf;
if (XBUFFER (buf) == current_buffer)
return Qnil;
tembuf = Fcurrent_buffer ();
Fset_buffer (buf);
Fkill_buffer (tembuf);
return Qnil;
}
void
choose_write_coding_system (start, end, filename,
append, visit, lockname, coding)
Lisp_Object start, end, filename, append, visit, lockname;
struct coding_system *coding;
{
Lisp_Object val;
if (auto_saving
&& NILP (Fstring_equal (current_buffer->filename,
current_buffer->auto_save_file_name)))
{
setup_coding_system (Qemacs_mule, coding);
coding->flags = 1;
coding->eol_type = CODING_EOL_LF;
goto done_setup_coding;
}
else if (!NILP (Vcoding_system_for_write))
{
val = Vcoding_system_for_write;
if (coding_system_require_warning
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
val = call5 (Vselect_safe_coding_system_function,
start, end, Fcons (Qt, Fcons (val, Qnil)),
Qnil, filename);
}
else
{
int using_default_coding = 0;
int force_raw_text = 0;
val = current_buffer->buffer_file_coding_system;
if (NILP (val)
|| NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
{
val = Qnil;
if (NILP (current_buffer->enable_multibyte_characters))
force_raw_text = 1;
}
if (NILP (val))
{
Lisp_Object args[7], coding_systems;
args[0] = Qwrite_region; args[1] = start; args[2] = end;
args[3] = filename; args[4] = append; args[5] = visit;
args[6] = lockname;
coding_systems = Ffind_operation_coding_system (7, args);
if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
val = XCDR (coding_systems);
}
if (NILP (val)
&& !NILP (current_buffer->buffer_file_coding_system))
{
val = current_buffer->buffer_file_coding_system;
using_default_coding = 1;
}
if (!force_raw_text
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
val = call5 (Vselect_safe_coding_system_function,
start, end, val, Qnil, filename);
setup_coding_system (Fcheck_coding_system (val), coding);
if (coding->eol_type == CODING_EOL_UNDECIDED
&& !using_default_coding)
{
if (! EQ (default_buffer_file_coding.symbol,
buffer_defaults.buffer_file_coding_system))
setup_coding_system (buffer_defaults.buffer_file_coding_system,
&default_buffer_file_coding);
if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
{
Lisp_Object subsidiaries;
coding->eol_type = default_buffer_file_coding.eol_type;
subsidiaries = Fget (coding->symbol, Qeol_type);
if (VECTORP (subsidiaries)
&& XVECTOR (subsidiaries)->size == 3)
coding->symbol
= XVECTOR (subsidiaries)->contents[coding->eol_type];
}
}
if (force_raw_text)
setup_raw_text_coding_system (coding);
goto done_setup_coding;
}
setup_coding_system (Fcheck_coding_system (val), coding);
done_setup_coding:
if (coding->eol_type == CODING_EOL_UNDECIDED)
coding->eol_type = system_eol_type;
if (!STRINGP (start) && !NILP (current_buffer->selective_display))
coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
}
DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
"r\nFWrite region to file: \ni\ni\ni\np",
doc: )
(start, end, filename, append, visit, lockname, mustbenew)
Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
{
register int desc;
int failure;
int save_errno = 0;
const unsigned char *fn;
struct stat st;
int tem;
int count = SPECPDL_INDEX ();
int count1;
#ifdef VMS
unsigned char *fname = 0;
#endif
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
Lisp_Object encoded_filename;
int visiting = (EQ (visit, Qt) || STRINGP (visit));
int quietly = !NILP (visit);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
#ifdef DOS_NT
int buffer_file_type = O_BINARY;
#endif
struct coding_system coding;
if (current_buffer->base_buffer && visiting)
error ("Cannot do file visiting in an indirect buffer");
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
visit_file = Qnil;
GCPRO5 (start, filename, visit, visit_file, lockname);
filename = Fexpand_file_name (filename, Qnil);
if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
else
visit_file = filename;
if (NILP (lockname))
lockname = visit_file;
annotations = Qnil;
handler = Ffind_file_name_handler (filename, Qwrite_region);
if (NILP (handler) && STRINGP (visit))
handler = Ffind_file_name_handler (visit, Qwrite_region);
if (!NILP (handler))
{
Lisp_Object val;
val = call6 (handler, Qwrite_region, start, end,
filename, append, visit);
if (visiting)
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
}
UNGCPRO;
return val;
}
record_unwind_protect (save_restriction_restore, save_restriction_save ());
if (NILP (start))
{
XSETFASTINT (start, BEG);
XSETFASTINT (end, Z);
Fwiden ();
}
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
if (!STRINGP (start))
{
annotations = build_annotations (start, end);
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
XSETFASTINT (end, ZV);
}
}
UNGCPRO;
GCPRO5 (start, filename, annotations, visit_file, lockname);
choose_write_coding_system (start, end, filename,
append, visit, lockname, &coding);
Vlast_coding_system_used = coding.symbol;
given_buffer = current_buffer;
if (! STRINGP (start))
{
annotations = build_annotations_2 (start, end,
coding.pre_write_conversion, annotations);
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
XSETFASTINT (end, ZV);
}
}
#ifdef CLASH_DETECTION
if (!auto_saving)
{
#if 0
if (!visiting && EQ (Ffile_locked_p (lockname), Qt))
call2 (intern ("ask-user-about-lock"), filename, Vuser_login_name);
#endif
lock_file (lockname);
}
#endif
encoded_filename = ENCODE_FILE (filename);
fn = SDATA (encoded_filename);
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
#else
desc = emacs_open (fn, O_WRONLY, 0);
#endif
if (desc < 0 && (NILP (append) || errno == ENOENT))
#ifdef VMS
if (auto_saving)
{
vms_truncate (fn);
desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
? SDATA (current_buffer->filename) : 0,
fn);
}
else
{
Lisp_Object temp_name;
temp_name = Ffile_name_directory (filename);
if (!NILP (temp_name))
{
temp_name = Fmake_temp_name (concat2 (temp_name,
build_string ("$$SAVE$$")));
fname = SDATA (filename);
fn = SDATA (temp_name);
desc = creat_copy_attrs (fname, fn);
if (desc < 0)
{
fn = fname;
fname = 0;
desc = creat (fn, 0666);
#if 0
if (desc < 0)
{
vms_truncate (fn);
desc = emacs_open (fn, O_RDWR, 0);
}
#endif
}
}
else
desc = creat (fn, 0666);
}
#else
#ifdef DOS_NT
desc = emacs_open (fn,
O_WRONLY | O_CREAT | buffer_file_type
| (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
S_IREAD | S_IWRITE);
#else
desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
| (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
auto_saving ? auto_save_mode_bits : 0666);
#endif
#endif
if (desc < 0)
{
#ifdef CLASH_DETECTION
save_errno = errno;
if (!auto_saving) unlock_file (lockname);
errno = save_errno;
#endif
UNGCPRO;
report_file_error ("Opening output file", Fcons (filename, Qnil));
}
record_unwind_protect (close_file_unwind, make_number (desc));
if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
{
long ret;
if (NUMBERP (append))
ret = lseek (desc, XINT (append), 1);
else
ret = lseek (desc, 0, 2);
if (ret < 0)
{
#ifdef CLASH_DETECTION
if (!auto_saving) unlock_file (lockname);
#endif
UNGCPRO;
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
}
UNGCPRO;
#ifdef VMS
if (GPT > BEG && GPT_ADDR[-1] != '\n')
move_gap (find_next_newline (GPT, 1));
#else
if (INTEGERP (start)
&& coding.type == coding_type_iso2022
&& coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
&& GPT > BEG && GPT_ADDR[-1] != '\n')
{
int opoint = PT, opoint_byte = PT_BYTE;
scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0);
move_gap_both (PT, PT_BYTE);
SET_PT_BOTH (opoint, opoint_byte);
}
#endif
failure = 0;
immediate_quit = 1;
if (STRINGP (start))
{
failure = 0 > a_write (desc, start, 0, SCHARS (start),
&annotations, &coding);
save_errno = errno;
}
else if (XINT (start) != XINT (end))
{
tem = CHAR_TO_BYTE (XINT (start));
if (XINT (start) < GPT)
{
failure = 0 > a_write (desc, Qnil, XINT (start),
min (GPT, XINT (end)) - XINT (start),
&annotations, &coding);
save_errno = errno;
}
if (XINT (end) > GPT && !failure)
{
tem = max (XINT (start), GPT);
failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem,
&annotations, &coding);
save_errno = errno;
}
}
else
{
coding.mode |= CODING_MODE_LAST_BLOCK;
failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
save_errno = errno;
}
if (CODING_REQUIRE_FLUSHING (&coding)
&& !(coding.mode & CODING_MODE_LAST_BLOCK)
&& ! failure)
{
coding.mode |= CODING_MODE_LAST_BLOCK;
failure = 0 > e_write (desc, Qnil, 0, 0, &coding);
save_errno = errno;
}
immediate_quit = 0;
#ifdef HAVE_FSYNC
if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
{
if (errno != EINTR)
failure = 1, save_errno = errno;
}
#endif
#if 0
#ifndef VMS
#ifndef APOLLO
#define FOO
fstat (desc, &st);
#endif
#endif
#endif
if (emacs_close (desc) < 0)
failure = 1, save_errno = errno;
#ifdef VMS
if (fname)
{
if (!failure)
failure = (rename (fn, fname) != 0), save_errno = errno;
fn = fname;
}
#endif
#ifndef FOO
stat (fn, &st);
#endif
specpdl_ptr = specpdl + count1;
visit_file = unbind_to (count, visit_file);
#ifdef CLASH_DETECTION
if (!auto_saving)
unlock_file (lockname);
#endif
if (visiting)
current_buffer->modtime = st.st_mtime;
if (failure)
error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
if (visiting)
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
update_mode_lines++;
}
else if (quietly)
{
if (auto_saving
&& ! NILP (Fstring_equal (current_buffer->filename,
current_buffer->auto_save_file_name)))
SAVE_MODIFF = MODIFF;
return Qnil;
}
if (!auto_saving)
message_with_string ((INTEGERP (append)
? "Updated %s"
: ! NILP (append)
? "Added to %s"
: "Wrote %s"),
visit_file, 1);
return Qnil;
}
Lisp_Object merge ();
DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
doc: )
(a, b)
Lisp_Object a, b;
{
return Flss (Fcar (a), Fcar (b));
}
static Lisp_Object
build_annotations (start, end)
Lisp_Object start, end;
{
Lisp_Object annotations;
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
int i, used_global = 0;
XSETBUFFER (original_buffer, current_buffer);
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
if (EQ (Qt, XCAR (p)) && !used_global)
{
Lisp_Object arg[2];
used_global = 1;
arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
arg[1] = XCDR (p);
p = Fappend (2, arg);
continue;
}
Vwrite_region_annotations_so_far = annotations;
res = call2 (XCAR (p), start, end);
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
XSETFASTINT (end, ZV);
annotations = Qnil;
}
Flength (res);
annotations = merge (annotations, res, Qcar_less_than_car);
p = XCDR (p);
}
if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
p = current_buffer->auto_save_file_format;
else
p = current_buffer->file_format;
for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
Vwrite_region_annotations_so_far = annotations;
res = call5 (Qformat_annotate_function, XCAR (p), start, end,
original_buffer, make_number (i));
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
XSETFASTINT (end, ZV);
annotations = Qnil;
}
if (CONSP (res))
annotations = merge (annotations, res, Qcar_less_than_car);
}
UNGCPRO;
return annotations;
}
static Lisp_Object
build_annotations_2 (start, end, pre_write_conversion, annotations)
Lisp_Object start, end, pre_write_conversion, annotations;
{
struct gcpro gcpro1;
Lisp_Object res;
GCPRO1 (annotations);
if (!NILP (pre_write_conversion))
{
struct buffer *given_buffer = current_buffer;
Vwrite_region_annotations_so_far = annotations;
res = call2 (pre_write_conversion, start, end);
Flength (res);
annotations = (current_buffer != given_buffer
? res
: merge (annotations, res, Qcar_less_than_car));
}
UNGCPRO;
return annotations;
}
static int
a_write (desc, string, pos, nchars, annot, coding)
int desc;
Lisp_Object string;
register int nchars;
int pos;
Lisp_Object *annot;
struct coding_system *coding;
{
Lisp_Object tem;
int nextpos;
int lastpos = pos + nchars;
while (NILP (*annot) || CONSP (*annot))
{
tem = Fcar_safe (Fcar (*annot));
nextpos = pos - 1;
if (INTEGERP (tem))
nextpos = XFASTINT (tem);
if (! (nextpos >= pos && nextpos <= lastpos))
return e_write (desc, string, pos, lastpos, coding);
if (nextpos > pos)
{
if (0 > e_write (desc, string, pos, nextpos, coding))
return -1;
pos = nextpos;
}
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
return -1;
}
*annot = Fcdr (*annot);
}
return 0;
}
#ifndef WRITE_BUF_SIZE
#define WRITE_BUF_SIZE (16 * 1024)
#endif
static int
e_write (desc, string, start, end, coding)
int desc;
Lisp_Object string;
int start, end;
struct coding_system *coding;
{
register char *addr;
register int nbytes;
char buf[WRITE_BUF_SIZE];
int return_val = 0;
if (start >= end)
coding->composing = COMPOSITION_DISABLED;
if (coding->composing != COMPOSITION_DISABLED)
coding_save_composition (coding, start, end, string);
if (STRINGP (string))
{
addr = SDATA (string);
nbytes = SBYTES (string);
coding->src_multibyte = STRING_MULTIBYTE (string);
}
else if (start < end)
{
addr = CHAR_POS_ADDR (start);
nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
coding->src_multibyte
= !NILP (current_buffer->enable_multibyte_characters);
}
else
{
addr = "";
nbytes = 0;
coding->src_multibyte = 1;
}
while (1)
{
int result;
result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE);
if (coding->produced > 0)
{
coding->produced -= emacs_write (desc, buf, coding->produced);
if (coding->produced)
{
return_val = -1;
break;
}
}
nbytes -= coding->consumed;
addr += coding->consumed;
if (result == CODING_FINISH_INSUFFICIENT_SRC
&& nbytes > 0)
{
nbytes -= emacs_write (desc, addr, nbytes);
if (nbytes)
{
return_val = -1;
break;
}
}
if (nbytes <= 0)
break;
start += coding->consumed_char;
if (coding->cmp_data)
coding_adjust_composition_offset (coding, start);
}
if (coding->cmp_data)
coding_free_composition_data (coding);
return return_val;
}
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
Sverify_visited_file_modtime, 1, 1, 0,
doc: )
(buf)
Lisp_Object buf;
{
struct buffer *b;
struct stat st;
Lisp_Object handler;
Lisp_Object filename;
CHECK_BUFFER (buf);
b = XBUFFER (buf);
if (!STRINGP (b->filename)) return Qt;
if (b->modtime == 0) return Qt;
handler = Ffind_file_name_handler (b->filename,
Qverify_visited_file_modtime);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
filename = ENCODE_FILE (b->filename);
if (stat (SDATA (filename), &st) < 0)
{
if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
st.st_mtime = -1;
else
st.st_mtime = 0;
}
if (st.st_mtime == b->modtime
|| (st.st_mtime > 0 && b->modtime > 0
&& (st.st_mtime == b->modtime + 1
|| st.st_mtime == b->modtime - 1)))
return Qt;
return Qnil;
}
DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
Sclear_visited_file_modtime, 0, 0, 0,
doc: )
()
{
current_buffer->modtime = 0;
return Qnil;
}
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
doc: )
()
{
Lisp_Object tcons;
tcons = long_to_cons ((unsigned long) current_buffer->modtime);
if (CONSP (tcons))
return list2 (XCAR (tcons), XCDR (tcons));
return tcons;
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
Sset_visited_file_modtime, 0, 1, 0,
doc: )
(time_list)
Lisp_Object time_list;
{
if (!NILP (time_list))
current_buffer->modtime = cons_to_long (time_list);
else
{
register Lisp_Object filename;
struct stat st;
Lisp_Object handler;
filename = Fexpand_file_name (current_buffer->filename, Qnil);
handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
if (!NILP (handler))
return call2 (handler, Qset_visited_file_modtime, Qnil);
filename = ENCODE_FILE (filename);
if (stat (SDATA (filename), &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
return Qnil;
}
Lisp_Object
auto_save_error (error)
Lisp_Object error;
{
Lisp_Object args[3], msg;
int i, nbytes;
struct gcpro gcpro1;
char *msgbuf;
USE_SAFE_ALLOCA;
ring_bell ();
args[0] = build_string ("Auto-saving %s: %s");
args[1] = current_buffer->name;
args[2] = Ferror_message_string (error);
msg = Fformat (3, args);
GCPRO1 (msg);
nbytes = SBYTES (msg);
SAFE_ALLOCA (msgbuf, char *, nbytes);
bcopy (SDATA (msg), msgbuf, nbytes);
for (i = 0; i < 3; ++i)
{
if (i == 0)
message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
else
message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
Fsleep_for (make_number (1), Qnil);
}
SAFE_FREE ();
UNGCPRO;
return Qnil;
}
Lisp_Object
auto_save_1 ()
{
struct stat st;
Lisp_Object modes;
auto_save_mode_bits = 0666;
if (! NILP (current_buffer->filename))
{
if (stat (SDATA (current_buffer->filename), &st) >= 0)
auto_save_mode_bits = st.st_mode | 0600;
else if ((modes = Ffile_modes (current_buffer->filename),
INTEGERP (modes)))
auto_save_mode_bits = XINT (modes) | 0600;
}
return
Fwrite_region (Qnil, Qnil,
current_buffer->auto_save_file_name,
Qnil, Qlambda, Qnil, Qnil);
}
static Lisp_Object
do_auto_save_unwind (arg)
Lisp_Object arg;
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
auto_saving = 0;
if (stream != NULL)
{
BLOCK_INPUT;
fclose (stream);
UNBLOCK_INPUT;
}
return Qnil;
}
static Lisp_Object
do_auto_save_unwind_1 (value)
Lisp_Object value;
{
minibuffer_auto_raise = XINT (value);
return Qnil;
}
static Lisp_Object
do_auto_save_make_dir (dir)
Lisp_Object dir;
{
Lisp_Object mode;
call2 (Qmake_directory, dir, Qt);
XSETFASTINT (mode, 0700);
return Fset_file_modes (dir, mode);
}
static Lisp_Object
do_auto_save_eh (ignore)
Lisp_Object ignore;
{
return Qnil;
}
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
doc: )
(no_message, current_only)
Lisp_Object no_message, current_only;
{
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf;
int auto_saved = 0;
int do_handled_files;
Lisp_Object oquit;
FILE *stream = NULL;
int count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
int old_message_p = 0;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
max_specpdl_size = specpdl_size + 40;
if (minibuf_level)
no_message = Qt;
if (NILP (no_message))
{
old_message_p = push_message ();
record_unwind_protect (pop_message_unwind, Qnil);
}
oquit = Vquit_flag;
Vquit_flag = Qnil;
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("auto-save-hook"));
if (STRINGP (Vauto_save_list_file_name))
{
Lisp_Object listfile;
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
if (!NILP (Vrun_hooks))
{
Lisp_Object dir;
dir = Qnil;
GCPRO2 (dir, listfile);
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
internal_condition_case_1 (do_auto_save_make_dir,
dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
do_auto_save_eh);
UNGCPRO;
}
stream = fopen (SDATA (listfile), "w");
}
record_unwind_protect (do_auto_save_unwind,
make_save_value (stream, 0));
record_unwind_protect (do_auto_save_unwind_1,
make_number (minibuffer_auto_raise));
minibuffer_auto_raise = 0;
auto_saving = 1;
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
{
buf = XCDR (XCAR (tail));
b = XBUFFER (buf);
if (STRINGP (b->auto_save_file_name)
&& stream != NULL && do_handled_files == 0)
{
BLOCK_INPUT;
if (!NILP (b->filename))
{
fwrite (SDATA (b->filename), 1,
SBYTES (b->filename), stream);
}
putc ('\n', stream);
fwrite (SDATA (b->auto_save_file_name), 1,
SBYTES (b->auto_save_file_name), stream);
putc ('\n', stream);
UNBLOCK_INPUT;
}
if (!NILP (current_only)
&& b != current_buffer)
continue;
if (b->base_buffer)
continue;
if (STRINGP (b->auto_save_file_name)
&& BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
&& b->auto_save_modified < BUF_MODIFF (b)
&& XINT (b->save_length) >= 0
&& (do_handled_files
|| NILP (Ffind_file_name_handler (b->auto_save_file_name,
Qwrite_region))))
{
EMACS_TIME before_time, after_time;
EMACS_GET_TIME (before_time);
if (b->auto_save_failure_time >= 0
&& EMACS_SECS (before_time) - b->auto_save_failure_time < 1200)
continue;
if ((XFASTINT (b->save_length) * 10
> (BUF_Z (b) - BUF_BEG (b)) * 13)
&& XFASTINT (b->save_length) > 5000
&& !EQ (b->filename, Qnil)
&& NILP (no_message))
{
minibuffer_auto_raise = orig_minibuffer_auto_raise;
message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
b->name, 1);
minibuffer_auto_raise = 0;
XSETINT (b->save_length, -1);
Fsleep_for (make_number (1), Qnil);
continue;
}
set_buffer_internal (b);
if (!auto_saved && NILP (no_message))
message1 ("Auto-saving...");
internal_condition_case (auto_save_1, Qt, auto_save_error);
auto_saved++;
b->auto_save_modified = BUF_MODIFF (b);
XSETFASTINT (current_buffer->save_length, Z - BEG);
set_buffer_internal (old);
EMACS_GET_TIME (after_time);
if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
b->auto_save_failure_time = EMACS_SECS (after_time);
}
}
record_auto_save ();
if (auto_saved && NILP (no_message))
{
if (old_message_p)
{
sit_for (make_number (1), 0, 0);
restore_message ();
}
else
message1 ("Auto-saving...done");
}
Vquit_flag = oquit;
unbind_to (count, Qnil);
return Qnil;
}
DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
Sset_buffer_auto_saved, 0, 0, 0,
doc: )
()
{
current_buffer->auto_save_modified = MODIFF;
XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->auto_save_failure_time = -1;
return Qnil;
}
DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
Sclear_buffer_auto_save_failure, 0, 0, 0,
doc: )
()
{
current_buffer->auto_save_failure_time = -1;
return Qnil;
}
DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
0, 0, 0,
doc: )
()
{
return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil;
}
extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
static Lisp_Object
double_dollars (val)
Lisp_Object val;
{
register const unsigned char *old;
register unsigned char *new;
register int n;
int osize, count;
osize = SBYTES (val);
for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
old = SDATA (val);
val = make_uninit_multibyte_string (SCHARS (val) + count,
osize + count);
new = SDATA (val);
for (n = osize; n > 0; n--)
if (*old != '$')
*new++ = *old++;
else
{
*new++ = '$';
*new++ = '$';
old++;
}
}
return val;
}
static Lisp_Object
read_file_name_cleanup (arg)
Lisp_Object arg;
{
return (current_buffer->directory = arg);
}
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
3, 3, 0,
doc: )
(string, dir, action)
Lisp_Object string, dir, action;
{
Lisp_Object name, specdir, realdir, val, orig_string;
int changed;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
CHECK_STRING (string);
realdir = dir;
name = string;
orig_string = Qnil;
specdir = Qnil;
changed = 0;
GCPRO5 (string, realdir, name, specdir, orig_string);
if (SCHARS (string) == 0)
{
if (EQ (action, Qlambda))
{
UNGCPRO;
return Qnil;
}
}
else
{
orig_string = string;
string = Fsubstitute_in_file_name (string);
changed = NILP (Fstring_equal (string, orig_string));
name = Ffile_name_nondirectory (string);
val = Ffile_name_directory (string);
if (! NILP (val))
realdir = Fexpand_file_name (val, realdir);
}
if (NILP (action))
{
specdir = Ffile_name_directory (string);
val = Ffile_name_completion (name, realdir, Vread_file_name_predicate);
UNGCPRO;
if (!STRINGP (val))
{
if (changed)
return double_dollars (string);
return val;
}
if (!NILP (specdir))
val = concat2 (specdir, val);
#ifndef VMS
return double_dollars (val);
#else
return val;
#endif
}
UNGCPRO;
if (EQ (action, Qt))
{
Lisp_Object all = Ffile_name_all_completions (name, realdir);
Lisp_Object comp;
int count;
if (NILP (Vread_file_name_predicate)
|| EQ (Vread_file_name_predicate, Qfile_exists_p))
return all;
#ifndef VMS
if (EQ (Vread_file_name_predicate, Qfile_directory_p))
{
for (comp = Qnil; CONSP (all); all = XCDR (all))
{
Lisp_Object tem = XCAR (all);
int len;
if (STRINGP (tem)
&& (len = SBYTES (tem), len > 0)
&& IS_DIRECTORY_SEP (SREF (tem, len-1)))
comp = Fcons (tem, comp);
}
}
else
#endif
{
Lisp_Object tem;
GCPRO3 (all, comp, specdir);
count = SPECPDL_INDEX ();
record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
current_buffer->directory = realdir;
for (comp = Qnil; CONSP (all); all = XCDR (all))
{
tem = call1 (Vread_file_name_predicate, XCAR (all));
if (!NILP (tem))
comp = Fcons (XCAR (all), comp);
}
unbind_to (count, Qnil);
UNGCPRO;
}
return Fnreverse (comp);
}
#ifdef VMS
if (SCHARS (name) == 0)
return Qt;
#endif
string = Fexpand_file_name (string, dir);
if (!NILP (Vread_file_name_predicate))
return call1 (Vread_file_name_predicate, string);
return Ffile_exists_p (string);
}
DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
Snext_read_file_uses_dialog_p, 0, 0, 0,
doc: )
()
{
#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& use_file_dialog
&& have_menus_p ())
return Qt;
#endif
return Qnil;
}
DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
doc: )
(prompt, dir, default_filename, mustmatch, initial, predicate)
Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
{
Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
Lisp_Object decoded_homedir;
int replace_in_history = 0;
int add_to_history = 0;
int count;
if (NILP (dir))
dir = current_buffer->directory;
if (NILP (Ffile_name_absolute_p (dir)))
dir = Fexpand_file_name (dir, Qnil);
if (NILP (default_filename))
default_filename
= (!NILP (initial)
? Fexpand_file_name (initial, dir)
: current_buffer->filename);
homedir = (char *) egetenv ("HOME");
#ifdef DOS_NT
if (homedir != 0)
{
homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
CORRECT_DIR_SEPS (homedir);
}
#endif
if (homedir != 0)
decoded_homedir
= DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
if (homedir != 0
&& STRINGP (dir)
&& !strncmp (SDATA (decoded_homedir), SDATA (dir),
SBYTES (decoded_homedir))
&& IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
{
dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
dir = concat2 (build_string ("~"), dir);
}
if (homedir != 0
&& STRINGP (default_filename)
&& !strncmp (SDATA (decoded_homedir), SDATA (default_filename),
SBYTES (decoded_homedir))
&& IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
{
default_filename
= Fsubstring (default_filename,
make_number (SCHARS (decoded_homedir)), Qnil);
default_filename = concat2 (build_string ("~"), default_filename);
}
if (!NILP (default_filename))
{
CHECK_STRING (default_filename);
default_filename = double_dollars (default_filename);
}
if (insert_default_directory && STRINGP (dir))
{
insdef = dir;
if (!NILP (initial))
{
Lisp_Object args[2], pos;
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
pos = make_number (SCHARS (double_dollars (dir)));
insdef = Fcons (double_dollars (insdef), pos);
}
else
insdef = double_dollars (insdef);
}
else if (STRINGP (initial))
insdef = Fcons (double_dollars (initial), make_number (0));
else
insdef = Qnil;
if (!NILP (Vread_file_name_function))
{
Lisp_Object args[7];
GCPRO2 (insdef, default_filename);
args[0] = Vread_file_name_function;
args[1] = prompt;
args[2] = dir;
args[3] = default_filename;
args[4] = mustmatch;
args[5] = initial;
args[6] = predicate;
RETURN_UNGCPRO (Ffuncall (7, args));
}
count = SPECPDL_INDEX ();
specbind (intern ("completion-ignore-case"),
read_file_name_completion_ignore_case ? Qt : Qnil);
specbind (intern ("minibuffer-completing-file-name"), Qt);
specbind (intern ("read-file-name-predicate"),
(NILP (predicate) ? Qfile_exists_p : predicate));
GCPRO2 (insdef, default_filename);
#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
if (! NILP (Fnext_read_file_uses_dialog_p ()))
{
Lisp_Object file;
file = Ffile_name_nondirectory (dir);
if (SCHARS (file) && NILP (default_filename))
{
default_filename = file;
dir = Ffile_name_directory (dir);
}
if (!NILP(default_filename))
default_filename = Fexpand_file_name (default_filename, dir);
val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
add_to_history = 1;
}
else
#endif
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch, insdef,
Qfile_name_history, default_filename, Qnil);
tem = Fsymbol_value (Qfile_name_history);
if (CONSP (tem) && EQ (XCAR (tem), val))
replace_in_history = 1;
if (EQ (val, default_filename))
{
if (! replace_in_history)
add_to_history = 1;
val = empty_string;
}
unbind_to (count, Qnil);
UNGCPRO;
if (NILP (val))
error ("No file name specified");
tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
if (!NILP (tem) && !NILP (default_filename))
val = default_filename;
val = Fsubstitute_in_file_name (val);
if (replace_in_history)
{
Lisp_Object val1 = double_dollars (val);
tem = Fsymbol_value (Qfile_name_history);
if (history_delete_duplicates)
XSETCDR (tem, Fdelete (val1, XCDR(tem)));
XSETCAR (tem, val1);
}
else if (add_to_history)
{
Lisp_Object val1 = double_dollars (val);
tem = Fsymbol_value (Qfile_name_history);
if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
{
if (history_delete_duplicates) tem = Fdelete (val1, tem);
Fset (Qfile_name_history, Fcons (val1, tem));
}
}
return val;
}
void
init_fileio_once ()
{
XSETFASTINT (Vdirectory_sep_char, '/');
}
void
syms_of_fileio ()
{
Qoperations = intern ("operations");
Qexpand_file_name = intern ("expand-file-name");
Qsubstitute_in_file_name = intern ("substitute-in-file-name");
Qdirectory_file_name = intern ("directory-file-name");
Qfile_name_directory = intern ("file-name-directory");
Qfile_name_nondirectory = intern ("file-name-nondirectory");
Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
Qmake_directory_internal = intern ("make-directory-internal");
Qmake_directory = intern ("make-directory");
Qdelete_directory = intern ("delete-directory");
Qdelete_file = intern ("delete-file");
Qrename_file = intern ("rename-file");
Qadd_name_to_file = intern ("add-name-to-file");
Qmake_symbolic_link = intern ("make-symbolic-link");
Qfile_exists_p = intern ("file-exists-p");
Qfile_executable_p = intern ("file-executable-p");
Qfile_readable_p = intern ("file-readable-p");
Qfile_writable_p = intern ("file-writable-p");
Qfile_symlink_p = intern ("file-symlink-p");
Qaccess_file = intern ("access-file");
Qfile_directory_p = intern ("file-directory-p");
Qfile_regular_p = intern ("file-regular-p");
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
Qfile_modes = intern ("file-modes");
Qset_file_modes = intern ("set-file-modes");
Qset_file_times = intern ("set-file-times");
Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
Qinsert_file_contents = intern ("insert-file-contents");
Qwrite_region = intern ("write-region");
Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
Qauto_save_coding = intern ("auto-save-coding");
staticpro (&Qoperations);
staticpro (&Qexpand_file_name);
staticpro (&Qsubstitute_in_file_name);
staticpro (&Qdirectory_file_name);
staticpro (&Qfile_name_directory);
staticpro (&Qfile_name_nondirectory);
staticpro (&Qunhandled_file_name_directory);
staticpro (&Qfile_name_as_directory);
staticpro (&Qcopy_file);
staticpro (&Qmake_directory_internal);
staticpro (&Qmake_directory);
staticpro (&Qdelete_directory);
staticpro (&Qdelete_file);
staticpro (&Qrename_file);
staticpro (&Qadd_name_to_file);
staticpro (&Qmake_symbolic_link);
staticpro (&Qfile_exists_p);
staticpro (&Qfile_executable_p);
staticpro (&Qfile_readable_p);
staticpro (&Qfile_writable_p);
staticpro (&Qaccess_file);
staticpro (&Qfile_symlink_p);
staticpro (&Qfile_directory_p);
staticpro (&Qfile_regular_p);
staticpro (&Qfile_accessible_directory_p);
staticpro (&Qfile_modes);
staticpro (&Qset_file_modes);
staticpro (&Qset_file_times);
staticpro (&Qfile_newer_than_file_p);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
staticpro (&Qset_visited_file_modtime);
staticpro (&Qauto_save_coding);
Qfile_name_history = intern ("file-name-history");
Fset (Qfile_name_history, Qnil);
staticpro (&Qfile_name_history);
Qfile_error = intern ("file-error");
staticpro (&Qfile_error);
Qfile_already_exists = intern ("file-already-exists");
staticpro (&Qfile_already_exists);
Qfile_date_error = intern ("file-date-error");
staticpro (&Qfile_date_error);
Qexcl = intern ("excl");
staticpro (&Qexcl);
#ifdef DOS_NT
Qfind_buffer_file_type = intern ("find-buffer-file-type");
staticpro (&Qfind_buffer_file_type);
#endif
DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
doc: );
Vfile_name_coding_system = Qnil;
DEFVAR_LISP ("default-file-name-coding-system",
&Vdefault_file_name_coding_system,
doc: );
Vdefault_file_name_coding_system = Qnil;
Qformat_decode = intern ("format-decode");
staticpro (&Qformat_decode);
Qformat_annotate_function = intern ("format-annotate-function");
staticpro (&Qformat_annotate_function);
Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding");
staticpro (&Qafter_insert_file_set_coding);
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
Fput (Qfile_error, Qerror_conditions,
list2 (Qfile_error, Qerror));
Fput (Qfile_error, Qerror_message,
build_string ("File error"));
Fput (Qfile_already_exists, Qerror_conditions,
list3 (Qfile_already_exists, Qfile_error, Qerror));
Fput (Qfile_already_exists, Qerror_message,
build_string ("File already exists"));
Fput (Qfile_date_error, Qerror_conditions,
list3 (Qfile_date_error, Qfile_error, Qerror));
Fput (Qfile_date_error, Qerror_message,
build_string ("Cannot set file date"));
DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function,
doc: );
Vread_file_name_function = Qnil;
DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate,
doc: );
Vread_file_name_predicate = Qnil;
DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case,
doc: );
#if defined VMS || defined DOS_NT || defined MAC_OS
read_file_name_completion_ignore_case = 1;
#else
read_file_name_completion_ignore_case = 0;
#endif
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
doc: );
insert_default_directory = 1;
DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
doc: );
vms_stmlf_recfm = 0;
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
doc: );
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
doc: );
Vfile_name_handler_alist = Qnil;
DEFVAR_LISP ("set-auto-coding-function",
&Vset_auto_coding_function,
doc: );
Vset_auto_coding_function = Qnil;
DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
doc: );
Vafter_insert_file_functions = Qnil;
DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
doc: );
Vwrite_region_annotate_functions = Qnil;
staticpro (&Qwrite_region_annotate_functions);
Qwrite_region_annotate_functions
= intern ("write-region-annotate-functions");
DEFVAR_LISP ("write-region-annotations-so-far",
&Vwrite_region_annotations_so_far,
doc: );
Vwrite_region_annotations_so_far = Qnil;
DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
doc: );
Vinhibit_file_name_handlers = Qnil;
DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
doc: );
Vinhibit_file_name_operation = Qnil;
DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
doc: );
Vauto_save_list_file_name = Qnil;
#ifdef HAVE_FSYNC
DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
doc: );
write_region_inhibit_fsync = 0;
#endif
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
defsubr (&Sunhandled_file_name_directory);
defsubr (&Sfile_name_as_directory);
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_name);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);
defsubr (&Smake_directory_internal);
defsubr (&Sdelete_directory);
defsubr (&Sdelete_file);
defsubr (&Srename_file);
defsubr (&Sadd_name_to_file);
#ifdef S_IFLNK
defsubr (&Smake_symbolic_link);
#endif
#ifdef VMS
defsubr (&Sdefine_logical_name);
#endif
#ifdef HPUX_NET
defsubr (&Ssysnetunam);
#endif
defsubr (&Sfile_name_absolute_p);
defsubr (&Sfile_exists_p);
defsubr (&Sfile_executable_p);
defsubr (&Sfile_readable_p);
defsubr (&Sfile_writable_p);
defsubr (&Saccess_file);
defsubr (&Sfile_symlink_p);
defsubr (&Sfile_directory_p);
defsubr (&Sfile_accessible_directory_p);
defsubr (&Sfile_regular_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
defsubr (&Sset_file_times);
defsubr (&Sset_default_file_modes);
defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sinsert_file_contents);
defsubr (&Swrite_region);
defsubr (&Scar_less_than_car);
defsubr (&Sverify_visited_file_modtime);
defsubr (&Sclear_visited_file_modtime);
defsubr (&Svisited_file_modtime);
defsubr (&Sset_visited_file_modtime);
defsubr (&Sdo_auto_save);
defsubr (&Sset_buffer_auto_saved);
defsubr (&Sclear_buffer_auto_save_failure);
defsubr (&Srecent_auto_save_p);
defsubr (&Sread_file_name_internal);
defsubr (&Sread_file_name);
defsubr (&Snext_read_file_uses_dialog_p);
#ifdef HAVE_SYNC
defsubr (&Sunix_sync);
#endif
}