#define _GNU_SOURCE
#include <config.h>
#if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
#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 VMS
#include "vms-pwd.h"
#else
#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
#ifndef USG
#ifndef VMS
#ifndef BSD4_1
#ifndef WINDOWSNT
#define HAVE_FSYNC
#endif
#endif
#endif
#endif
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "window.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;
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
#ifndef S_ISLNK
# define lstat stat
#endif
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
int auto_saving;
int auto_save_mode_bits;
Lisp_Object Vfile_name_coding_system;
Lisp_Object Vdefault_file_name_coding_system;
Lisp_Object Vfile_name_handler_alist;
Lisp_Object Vauto_save_file_format;
Lisp_Object Qformat_decode, Qformat_annotate_function;
Lisp_Object Vset_auto_coding_function;
Lisp_Object Vafter_insert_file_functions;
Lisp_Object Vwrite_region_annotate_functions;
Lisp_Object Vwrite_region_annotations_so_far;
Lisp_Object Vauto_save_list_file_name;
int insert_default_directory;
int vms_stmlf_recfm;
Lisp_Object Vdirectory_sep_char;
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;
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)
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:
Fsignal (Qfile_already_exists, Fcons (errstring, data));
break;
default:
if (XSTRING (errstring)->data[1] != '/')
XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
Fsignal (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 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,
"Return FILENAME's handler function for OPERATION, if it has one.\n\
Otherwise, return nil.\n\
A file name is handled if one of the regular expressions in\n\
`file-name-handler-alist' matches it.\n\n\
If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
any handlers that are members of `inhibit-file-name-handlers',\n\
but we still do run any other handlers. This lets handlers\n\
use the standard functions without calling themselves recursively.")
(filename, operation)
Lisp_Object filename, operation;
{
Lisp_Object chain, inhibited_handlers;
CHECK_STRING (filename, 0);
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;
string = XCAR (elt);
if (STRINGP (string) && fast_string_match (string, filename) >= 0)
{
Lisp_Object handler, tem;
handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
return handler;
}
}
QUIT;
}
return Qnil;
}
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
1, 1, 0,
"Return the directory component in file name FILENAME.\n\
Return nil if FILENAME does not include a directory.\n\
Otherwise return a directory spec.\n\
Given a Unix syntax file name, returns a string ending in slash;\n\
on VMS, perhaps instead a string ending in `:', `]' or `>'.")
(filename)
Lisp_Object filename;
{
register unsigned char *beg;
register unsigned char *p;
Lisp_Object handler;
CHECK_STRING (filename, 0);
handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
return call2 (handler, Qfile_name_directory, filename);
#ifdef FILE_SYSTEM_CASE
filename = FILE_SYSTEM_CASE (filename);
#endif
beg = XSTRING (filename)->data;
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
p = beg + STRING_BYTES (XSTRING (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
if (STRING_MULTIBYTE (filename))
return make_string (beg, p - beg);
return make_unibyte_string (beg, p - beg);
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
Sfile_name_nondirectory, 1, 1, 0,
"Return file name FILENAME sans its directory.\n\
For example, in a Unix-syntax file name,\n\
this is everything after the last slash,\n\
or the entire name if it contains no slash.")
(filename)
Lisp_Object filename;
{
register unsigned char *beg, *p, *end;
Lisp_Object handler;
CHECK_STRING (filename, 0);
handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, filename);
beg = XSTRING (filename)->data;
end = p = beg + STRING_BYTES (XSTRING (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--;
if (STRING_MULTIBYTE (filename))
return make_string (p, end - p);
return make_unibyte_string (p, end - p);
}
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
Sunhandled_file_name_directory, 1, 1, 0,
"Return a directly usable directory name somehow associated with FILENAME.\n\
A `directly usable' directory name is one that may be used without the\n\
intervention of any file handler.\n\
If FILENAME is a directly usable file itself, return\n\
\(file-name-directory FILENAME).\n\
The `call-process' and `start-process' functions use this function to\n\
get a current directory to run processes in.")
(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] = DIRECTORY_SEP;
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,
"Return a string representing file FILENAME interpreted as a directory.\n\
This operation exists because a directory is also a file, but its name as\n\
a directory is different from its name as a file.\n\
The result can be used as the value of `default-directory'\n\
or passed as second argument to `expand-file-name'.\n\
For a Unix-syntax file name, just appends a slash.\n\
On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
(file)
Lisp_Object file;
{
char *buf;
Lisp_Object handler;
CHECK_STRING (file, 0);
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 (STRING_BYTES (XSTRING (file)) + 10);
return build_string (file_name_as_directory (buf, XSTRING (file)->data));
}
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,
"Returns the file name of the directory named DIRECTORY.\n\
This is the name of the file that holds the data for the directory DIRECTORY.\n\
This operation exists because a directory is also a file, but its name as\n\
a directory is different from its name as a file.\n\
In Unix-syntax, this function just removes the final slash.\n\
On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
it returns a file name such as \"[X]Y.DIR.1\".")
(directory)
Lisp_Object directory;
{
char *buf;
Lisp_Object handler;
CHECK_STRING (directory, 0);
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 (STRING_BYTES (XSTRING (directory)) + 20 + 255);
#else
buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);
#endif
directory_file_name (XSTRING (directory)->data, buf);
return build_string (buf);
}
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;
int pid;
unsigned char *p, *data;
char pidbuf[20];
int pidlen;
CHECK_STRING (prefix, 0);
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 = XSTRING (prefix)->size;
val = make_uninit_string (len + 3 + pidlen);
data = XSTRING (val)->data;
bcopy(XSTRING (prefix)->data, 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'",
XSTRING (prefix)->data);
return Qnil;
}
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
"Generate temporary file name (string) starting with PREFIX (a string).\n\
The Emacs process number forms part of the result,\n\
so there is no danger of generating a name being used by another process.\n\
\n\
In addition, this function makes an attempt to choose a name\n\
which has no existing file. To make this work,\n\
PREFIX should be an absolute file name.\n\
\n\
There is a race condition between calling `make-temp-name' and creating the\n\
file which opens all kinds of security holes. For that reason, you should\n\
probably use `make-temp-file' instead.")
(prefix)
Lisp_Object prefix;
{
return make_temp_name (prefix, 0);
}
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert filename NAME to absolute, and canonicalize it.\n\
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
the current buffer's value of default-directory is used.\n\
File name components that are `.' are removed, and \n\
so are file name components followed by `..', along with the `..' itself;\n\
note that these simplifications are done without checking the resulting\n\
file names in the file system.\n\
An initial `~/' expands to your home directory.\n\
An initial `~USER/' expands to USER's home directory.\n\
See also the function `substitute-in-file-name'.")
(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;
CHECK_STRING (name, 0);
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))
default_directory = build_string ("/");
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 = XSTRING (default_directory)->data;
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;
}
#ifdef VMS
name = Fupcase (name);
#endif
#ifdef FILE_SYSTEM_CASE
name = FILE_SYSTEM_CASE (name);
#endif
nm = XSTRING (name)->data;
#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] == '-')
#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
#ifdef DOS_NT
CORRECT_DIR_SEPS (nm);
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
if (strcmp (nm, XSTRING (name)->data) != 0)
name = build_string (nm);
}
else
#endif
if (strcmp (nm - 2, XSTRING (name)->data) != 0)
{
name = make_string (nm - 2, p - nm + 2);
XSTRING (name)->data[0] = DRIVE_LETTER (drive);
XSTRING (name)->data[1] = ':';
}
return name;
#else
if (nm == XSTRING (name)->data)
return name;
return build_string (nm);
#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;
pw = (struct passwd *) getpwnam (o + 1);
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 = XSTRING (default_directory)->data;
#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]) && 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]) && 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
{
#ifndef VMS4_4
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 (IS_DIRECTORY_SEP (p[0])
&& p[1] == '.'
&& (IS_DIRECTORY_SEP (p[2])
|| p[2] == 0))
{
if (o == target && p[2] == '\0')
*o++ = *p;
p += 2;
}
else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
&& o != target
&& (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[0]) && IS_DIRECTORY_SEP (p[1]))
{
*o++ = *p++;
while (IS_DIRECTORY_SEP (*p))
++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
return make_string (target, o - target);
}
#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, 0);
#ifdef VMS
name = Fupcase (name);
#endif
nm = XSTRING (name)->data;
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 == XSTRING (name)->data)
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;
pw = (struct passwd *) getpwnam (o + 1);
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, 1);
newdir = XSTRING (defalt)->data;
}
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
DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
Ssubstitute_in_file_name, 1, 1, 0,
"Substitute environment variables referred to in FILENAME.\n\
`$FOO' where FOO is an environment variable name means to substitute\n\
the value of that variable. The variable name should be terminated\n\
with a character not a letter, digit or underscore; otherwise, enclose\n\
the entire variable name in braces.\n\
If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
On VMS, `$' substitution is not done; this function does little and only\n\
duplicates what `expand-file-name' does.")
(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, 0);
handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
if (!NILP (handler))
return call2 (handler, Qsubstitute_in_file_name, filename);
nm = XSTRING (filename)->data;
#ifdef DOS_NT
nm = strcpy (alloca (strlen (nm) + 1), nm);
CORRECT_DIR_SEPS (nm);
substituted = (strcmp (nm, XSTRING (filename)->data) != 0);
#endif
endp = nm + STRING_BYTES (XSTRING (filename));
for (p = nm; p != endp; p++)
{
if ((p[0] == '~'
#if defined (APOLLO) || defined (WINDOWSNT)
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
#else
|| IS_DIRECTORY_SEP (p[0])
#endif
)
&& p != nm
&& (0
#ifdef VMS
|| p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
#endif
|| IS_DIRECTORY_SEP (p[-1])))
{
nm = p;
substituted = 1;
}
#ifdef DOS_NT
else if (IS_DRIVE (p[0]) && p[1] == ':'
&& p > nm && IS_DIRECTORY_SEP (p[-1]))
{
nm = p;
substituted = 1;
}
#endif
}
#ifdef VMS
return build_string (nm);
#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) goto badvar;
total += strlen (o);
substituted = 1;
}
if (!substituted)
return filename;
xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (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)
goto badvar;
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;
for (p = xnm; p != x; p++)
if ((p[0] == '~'
#if defined (APOLLO) || defined (WINDOWSNT)
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
#else
|| IS_DIRECTORY_SEP (p[0])
#endif
)
&& p != xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
#ifdef DOS_NT
else if (IS_DRIVE (p[0]) && p[1] == ':'
&& p > xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
#endif
if (STRING_MULTIBYTE (filename))
return make_string (xnm, x - xnm);
return make_unibyte_string (xnm, x - xnm);
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 = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
#else
if (XSTRING (absname)->size > 1
&& IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1])
&& !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (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 (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
GCPRO1 (absname);
tem = format1 ("File %s already exists; %s anyway? ",
XSTRING (absname)->data, querystring);
if (quick)
tem = Fy_or_n_p (tem);
else
tem = do_yes_or_no_p (tem);
UNGCPRO;
if (NILP (tem))
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
if (statptr)
*statptr = statbuf;
}
else
{
if (statptr)
statptr->st_mode = 0;
}
return;
}
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
"fCopy file: \nFCopy %s to file: \np\nP",
"Copy FILE to NEWNAME. Both args must be strings.\n\
Signals a `file-already-exists' error if file NEWNAME already exists,\n\
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
A number as third arg means request confirmation if NEWNAME already exists.\n\
This is what happens in interactive use with M-x.\n\
Fourth arg KEEP-TIME non-nil means give the new file the same\n\
last-modified time as the old one. (This works on only some systems.)\n\
A prefix arg makes KEEP-TIME non-nil.")
(file, newname, ok_if_already_exists, keep_time)
Lisp_Object file, newname, ok_if_already_exists, keep_time;
{
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_ptr - specpdl;
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, 0);
CHECK_STRING (newname, 1);
file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, 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 (encoded_newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st, 0);
else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
out_st.st_mode = 0;
#ifdef WINDOWSNT
if (!CopyFile (XSTRING (encoded_file)->data,
XSTRING (encoded_newname)->data,
FALSE))
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
else if (NILP (keep_time))
{
EMACS_TIME now;
EMACS_GET_TIME (now);
if (set_file_times (XSTRING (encoded_newname)->data,
now, now))
Fsignal (Qfile_date_error,
Fcons (build_string ("Cannot set file date"),
Fcons (newname, Qnil)));
}
#else
ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 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 (DOS_NT) || __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 (XSTRING (encoded_newname)->data, 0666, ifd);
#else
#ifdef MSDOS
ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE);
#else
ofd = creat (XSTRING (encoded_newname)->data, 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;
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 (XSTRING (encoded_newname)->data,
atime, mtime))
Fsignal (Qfile_date_error,
Fcons (build_string ("Cannot set file date"),
Fcons (newname, Qnil)));
}
#ifndef MSDOS
chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
#else
#if defined (__DJGPP__) && __DJGPP__ > 1
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
#endif
#endif
}
emacs_close (ifd);
#endif
specpdl_ptr = specpdl + count;
UNGCPRO;
return Qnil;
}
DEFUN ("make-directory-internal", Fmake_directory_internal,
Smake_directory_internal, 1, 1, 0,
"Create a new directory named DIRECTORY.")
(directory)
Lisp_Object directory;
{
unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
CHECK_STRING (directory, 0);
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 = XSTRING (encoded_dir)->data;
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
#else
if (mkdir (dir, 0777) != 0)
#endif
report_file_error ("Creating directory", Flist (1, &directory));
return Qnil;
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
"Delete the directory named DIRECTORY.")
(directory)
Lisp_Object directory;
{
unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
CHECK_STRING (directory, 0);
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 = XSTRING (encoded_dir)->data;
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &directory));
return Qnil;
}
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
"Delete file named FILENAME.\n\
If file has multiple names, it continues to exist with the other names.")
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
Lisp_Object encoded_file;
CHECK_STRING (filename, 0);
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 (XSTRING (encoded_file)->data))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
}
static Lisp_Object
internal_delete_file_1 (ignore)
Lisp_Object ignore;
{
return Qt;
}
int
internal_delete_file (filename)
Lisp_Object filename;
{
return NILP (internal_condition_case_1 (Fdelete_file, filename,
Qt, internal_delete_file_1));
}
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
"fRename file: \nFRename %s to file: \np",
"Rename FILE as NEWNAME. Both args strings.\n\
If file has names other than FILE, it continues to have those names.\n\
Signals a `file-already-exists' error if a file NEWNAME already exists\n\
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
A number as third arg means request confirmation if NEWNAME already exists.\n\
This is what happens in interactive use with M-x.")
(file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object encoded_file, encoded_newname;
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
file = Fexpand_file_name (file, Qnil);
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 (encoded_newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
#ifndef BSD4_1
if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
#else
if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)
|| 0 > unlink (XSTRING (encoded_file)->data))
#endif
{
if (errno == EXDEV)
{
Fcopy_file (file, newname,
NILP (ok_if_already_exists) ? Qnil : Qt, Qt);
Fdelete_file (file);
}
else
#ifdef NO_ARG_ARRAY
{
args[0] = file;
args[1] = newname;
report_file_error ("Renaming", Flist (2, args));
}
#else
report_file_error ("Renaming", Flist (2, &file));
#endif
}
UNGCPRO;
return Qnil;
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
"fAdd name to file: \nFName to add to %s: \np",
"Give FILE additional name NEWNAME. Both args strings.\n\
Signals a `file-already-exists' error if a file NEWNAME already exists\n\
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
A number as third arg means request confirmation if NEWNAME already exists.\n\
This is what happens in interactive use with M-x.")
(file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
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, 0);
CHECK_STRING (newname, 1);
file = Fexpand_file_name (file, Qnil);
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 (encoded_newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0, 0);
unlink (XSTRING (newname)->data);
if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
{
#ifdef NO_ARG_ARRAY
args[0] = file;
args[1] = newname;
report_file_error ("Adding new name", Flist (2, args));
#else
report_file_error ("Adding new name", Flist (2, &file));
#endif
}
UNGCPRO;
return Qnil;
}
#ifdef S_IFLNK
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
"FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
"Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
Signals a `file-already-exists' error if a file LINKNAME already exists\n\
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
A number as third arg means request confirmation if LINKNAME already exists.\n\
This happens for interactive use with M-x.")
(filename, linkname, ok_if_already_exists)
Lisp_Object filename, linkname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
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, 0);
CHECK_STRING (linkname, 1);
if (XSTRING (filename)->data[0] == '~')
filename = Fexpand_file_name (filename, Qnil);
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 (encoded_linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
if (0 > symlink (XSTRING (encoded_filename)->data,
XSTRING (encoded_linkname)->data))
{
if (errno == EEXIST)
{
unlink (XSTRING (encoded_linkname)->data);
if (0 <= symlink (XSTRING (encoded_filename)->data,
XSTRING (encoded_linkname)->data))
{
UNGCPRO;
return Qnil;
}
}
#ifdef NO_ARG_ARRAY
args[0] = filename;
args[1] = linkname;
report_file_error ("Making symbolic link", Flist (2, args));
#else
report_file_error ("Making symbolic link", Flist (2, &filename));
#endif
}
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: ",
"Define the job-wide logical name NAME to have the value STRING.\n\
If STRING is nil or a null string, the logical name NAME is deleted.")
(name, string)
Lisp_Object name;
Lisp_Object string;
{
CHECK_STRING (name, 0);
if (NILP (string))
delete_logical_name (XSTRING (name)->data);
else
{
CHECK_STRING (string, 1);
if (XSTRING (string)->size == 0)
delete_logical_name (XSTRING (name)->data);
else
define_logical_name (XSTRING (name)->data, XSTRING (string)->data);
}
return string;
}
#endif
#ifdef HPUX_NET
DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
"Open a network connection to PATH using LOGIN as the login string.")
(path, login)
Lisp_Object path, login;
{
int netresult;
CHECK_STRING (path, 0);
CHECK_STRING (login, 0);
netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
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,
"Return t if file FILENAME specifies an absolute file name.\n\
On Unix, this is a name starting with a `/' or a `~'.")
(filename)
Lisp_Object filename;
{
unsigned char *ptr;
CHECK_STRING (filename, 0);
ptr = XSTRING (filename)->data;
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
#ifdef VMS
|| index (ptr, ':') || index (ptr, '<')
|| (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
&& ptr[1] != '.')
#endif
#ifdef DOS_NT
|| (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
#endif
)
return Qt;
else
return 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,
"Return t if file FILENAME exists. (This does not mean you can read it.)\n\
See also `file-readable-p' and `file-attributes'.")
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
struct stat statbuf;
CHECK_STRING (filename, 0);
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 (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
"Return t if FILENAME can be executed by you.\n\
For a directory, this means you can access files in that directory.")
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
CHECK_STRING (filename, 0);
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 (XSTRING (absname)->data) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
"Return t if file FILENAME exists and you can read it.\n\
See also `file-exists-p' and `file-attributes'.")
(filename)
Lisp_Object filename;
{
Lisp_Object absname;
Lisp_Object handler;
int desc;
int flags;
struct stat statbuf;
CHECK_STRING (filename, 0);
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 (XSTRING (absname)->data, 0) == 0)
return Qt;
return Qnil;
#else
flags = O_RDONLY;
#if defined (S_ISFIFO) && defined (O_NONBLOCK)
desc = stat (XSTRING (absname)->data, &statbuf);
if (desc < 0)
return Qnil;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
desc = emacs_open (XSTRING (absname)->data, 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,
"Return t if file FILENAME can be written or created by you.")
(filename)
Lisp_Object filename;
{
Lisp_Object absname, dir, encoded;
Lisp_Object handler;
struct stat statbuf;
CHECK_STRING (filename, 0);
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 (XSTRING (encoded)->data, &statbuf) >= 0)
return (check_writable (XSTRING (encoded)->data)
? 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 (XSTRING (dir)->data, &statbuf) < 0)
return Qnil;
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
#else
return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
? Qt : Qnil);
#endif
}
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
"Access file FILENAME, and get an error if that does not work.\n\
The second argument STRING is used in the error message.\n\
If there is no error, we return nil.")
(filename, string)
Lisp_Object filename, string;
{
Lisp_Object handler, encoded_filename;
int fd;
CHECK_STRING (filename, 0);
CHECK_STRING (string, 1);
handler = Ffind_file_name_handler (filename, Qaccess_file);
if (!NILP (handler))
return call3 (handler, Qaccess_file, filename, string);
encoded_filename = ENCODE_FILE (filename);
fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
if (fd < 0)
report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
emacs_close (fd);
return Qnil;
}
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
"Return non-nil if file FILENAME is the name of a symbolic link.\n\
The value is the name of the file to which it is linked.\n\
Otherwise returns nil.")
(filename)
Lisp_Object filename;
{
#ifdef S_IFLNK
char *buf;
int bufsize;
int valsize;
Lisp_Object val;
Lisp_Object handler;
CHECK_STRING (filename, 0);
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);
filename = ENCODE_FILE (filename);
bufsize = 50;
buf = NULL;
do
{
bufsize *= 2;
buf = (char *) xrealloc (buf, bufsize);
bzero (buf, bufsize);
errno = 0;
valsize = readlink (XSTRING (filename)->data, 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,
"Return t if FILENAME names an existing directory.\n\
Symbolic links to directories count as directories.\n\
See `file-symlink-p' to distinguish symlinks.")
(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 (XSTRING (absname)->data, &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,
"Return t if file FILENAME is the name of a directory as a file,\n\
and files in that directory can be opened by you. In order to use a\n\
directory as a buffer's current directory, this predicate must return true.\n\
A directory name spec may be given instead; then the value is t\n\
if the directory so specified exists and really is a readable and\n\
searchable directory.")
(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,
"Return t if file FILENAME is the name of a regular file.\n\
This is the sort of file that holds an ordinary stream of data bytes.")
(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 (XSTRING (absname)->data, &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 (XSTRING (absname)->data, &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,
"Return mode bits of file named FILENAME, as an integer.")
(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 (XSTRING (absname)->data, &st) < 0)
return Qnil;
#if defined (MSDOS) && __DJGPP__ < 2
if (check_executable (XSTRING (absname)->data))
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,
"Set mode bits of file named FILENAME to MODE (an integer).\n\
Only the 12 low bits of MODE are used.")
(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, 1);
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 (XSTRING (encoded_absname)->data, 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,
"Set the file permission bits for newly created files.\n\
The argument MODE should be an integer; only the low 9 bits are used.\n\
This setting is inherited by subprocesses.")
(mode)
Lisp_Object mode;
{
CHECK_NUMBER (mode, 0);
umask ((~ XINT (mode)) & 0777);
return Qnil;
}
DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
"Return the default file protection for created files.\n\
The value is an integer.")
()
{
int realmask;
Lisp_Object value;
realmask = umask (0);
umask (realmask);
XSETINT (value, (~ realmask) & 0777);
return value;
}
#ifdef __NetBSD__
#define unix 42
#endif
#ifdef unix
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
"Tell Unix to finish all pending disk updates.")
()
{
sync ();
return Qnil;
}
#endif
DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
"Return t if file FILE1 is newer than file FILE2.\n\
If FILE1 does not exist, the answer is nil;\n\
otherwise, if FILE2 does not exist, the answer is t.")
(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, 0);
CHECK_STRING (file2, 0);
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 (XSTRING (absname1)->data, &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
if (stat (XSTRING (absname2)->data, &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 - 1 + non_regular_inserted,
non_regular_nbytes);
Fsignal (Qquit, Qnil);
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,
"Insert contents of file FILENAME after point.\n\
Returns list of absolute file name and number of bytes inserted.\n\
If second argument VISIT is non-nil, the buffer's visited filename\n\
and last save file modtime are set, and it is marked unmodified.\n\
If visiting and the file does not exist, visiting is completed\n\
before the error is signaled.\n\
The optional third and fourth arguments BEG and END\n\
specify what portion of the file to insert.\n\
These arguments count bytes in the file, not characters in the buffer.\n\
If VISIT is non-nil, BEG and END must be nil.\n\
\n\
If optional fifth argument REPLACE is non-nil,\n\
it means replace the current buffer contents (in the accessible portion)\n\
with the file contents. This is better than simply deleting and inserting\n\
the whole thing because (1) it preserves some marker positions\n\
and (2) it puts less data in the undo list.\n\
When REPLACE is non-nil, the value is the number of characters actually read,\n\
which is often less than the number of characters to be read.\n\
\n\
This does code conversion according to the value of\n\
`coding-system-for-read' or `file-coding-system-alist',\n\
and sets the variable `last-coding-system-used' to the coding system\n\
actually used.")
(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 = BINDING_STACK_SIZE ();
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 gap_size;
int read_quit = 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, 0);
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 (XSTRING (filename)->data, &st);
Vw32_get_true_file_attributes = tem;
}
if (total < 0)
#else
#ifndef APOLLO
if (stat (XSTRING (filename)->data, &st) < 0)
#else
if ((fd = emacs_open (XSTRING (filename)->data, 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))
Fsignal (Qfile_error,
Fcons (build_string ("not a regular file"),
Fcons (orig_filename, Qnil)));
}
#endif
if (fd < 0)
if ((fd = emacs_open (XSTRING (filename)->data, 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 ("File size is negative");
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, 0);
else
XSETFASTINT (beg, 0);
if (!NILP (end))
CHECK_NUMBER (end, 0);
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 (BEG < Z)
{
Lisp_Object val;
val = Qnil;
if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else if (! NILP (replace))
val = current_buffer->buffer_file_coding_system;
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",
XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (nread > 0)
{
struct buffer *prev = current_buffer;
int count1;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
count1 = specpdl_ptr - specpdl;
temp_output_buffer_setup (" *code-converting-work*");
set_buffer_internal (XBUFFER (Vstandard_output));
current_buffer->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);
unbind_to (count1, Qnil);
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",
XSTRING (orig_filename)->data, 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",
XSTRING (orig_filename)->data, 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);
if (how_much == -1)
error ("IO error reading %s: %s",
XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
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);
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 -= (Z_BYTE - same_at_end) + (same_at_start - BEG_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 - BEG_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;
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) && total > 0)
prepare_to_modify_buffer (PT, PT, 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 - 1 + inserted, trytry);
immediate_quit = 0;
}
if (this <= 0)
{
how_much = this;
break;
}
gap_size -= this;
if (! not_regular)
how_much += this;
inserted += this;
}
}
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",
XSTRING (orig_filename)->data, 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_ptr - specpdl;
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 (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 (XSTRING (filename)->data, &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)
Fsignal (Qfile_error,
Fcons (build_string ("not a regular file"),
Fcons (orig_filename, Qnil)));
}
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, 0);
inserted = XFASTINT (insval);
if (!NILP (visit))
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
if (set_coding_system)
Vlast_coding_system_used = coding.symbol;
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 (!NILP (p))
{
insval = call1 (Fcar (p), make_number (inserted));
if (!NILP (insval))
{
CHECK_NUMBER (insval, 0);
inserted = XFASTINT (insval);
}
QUIT;
p = Fcdr (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,
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;
}
DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
"r\nFWrite region to file: \ni\ni\ni\np",
"Write current region into specified file.\n\
When called from a program, takes three arguments:\n\
START, END and FILENAME. START and END are buffer positions.\n\
Optional fourth argument APPEND if non-nil means\n\
append to existing file contents (if any). If it is an integer,\n\
seek to that offset in the file before writing.\n\
Optional fifth argument VISIT if t means\n\
set the last-save-file-modtime of buffer to this file's modtime\n\
and mark buffer not modified.\n\
If VISIT is a string, it is a second file name;\n\
the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
VISIT is also the file name to lock and unlock for clash detection.\n\
If VISIT is neither t nor nil nor a string,\n\
that means do not print the \"Wrote file\" message.\n\
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
use for locking and unlocking, overriding FILENAME and VISIT.\n\
The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
for an existing file with the same name. If MUSTBENEW is `excl',\n\
that means to get an error if the file already exists; never overwrite.\n\
If MUSTBENEW is neither nil nor `excl', that means ask for\n\
confirmation before overwriting, but do go ahead and overwrite the file\n\
if the user confirms.\n\
Kludgy feature: if START is a string, then that string is written\n\
to the file, instead of any buffer contents, and END is ignored.\n\
\n\
This does code conversion according to the value of\n\
`coding-system-for-write', `buffer-file-coding-system', or\n\
`file-coding-system-alist', and sets the variable\n\
`last-coding-system-used' to the coding system actually used.")
(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;
unsigned char *fn;
struct stat st;
int tem;
int count = specpdl_ptr - specpdl;
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);
GCPRO4 (start, filename, visit, lockname);
{
Lisp_Object val;
if (auto_saving)
val = Qnil;
else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
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 = call3 (Vselect_safe_coding_system_function, start, end, val);
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 (!STRINGP (start) && !NILP (current_buffer->selective_display))
coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
}
Vlast_coding_system_used = coding.symbol;
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;
UNGCPRO;
annotations = Qnil;
if (NILP (lockname))
lockname = visit_file;
GCPRO5 (start, filename, annotations, visit_file, lockname);
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;
}
if (NILP (start))
{
XSETFASTINT (start, BEG);
XSETFASTINT (end, Z);
}
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
count1 = specpdl_ptr - specpdl;
given_buffer = current_buffer;
annotations = build_annotations (start, end, coding.pre_write_conversion);
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 = XSTRING (encoded_filename)->data;
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)
? XSTRING (current_buffer->filename)->data : 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 = XSTRING (filename)->data;
fn = XSTRING (temp_name)->data;
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, XSTRING (start)->size,
&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 && 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", XSTRING (filename)->data,
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)
return Qnil;
if (!auto_saving)
message_with_string ("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,
"Return t if (car A) is numerically less than (car B).")
(a, b)
Lisp_Object a, b;
{
return Flss (Fcar (a), Fcar (b));
}
static Lisp_Object
build_annotations (start, end, pre_write_conversion)
Lisp_Object start, end, pre_write_conversion;
{
Lisp_Object annotations;
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
int i;
XSETBUFFER (original_buffer, current_buffer);
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
while (!NILP (p))
{
struct buffer *given_buffer = current_buffer;
Vwrite_region_annotations_so_far = annotations;
res = call2 (Fcar (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 = Fcdr (p);
}
if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
p = Vauto_save_file_format;
else
p = current_buffer->file_format;
for (i = 0; !NILP (p); p = Fcdr (p), ++i)
{
struct buffer *given_buffer = current_buffer;
Vwrite_region_annotations_so_far = annotations;
res = call5 (Qformat_annotate_function, Fcar (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);
}
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, XSTRING (tem)->size, 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 = XSTRING (string)->data;
nbytes = STRING_BYTES (XSTRING (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,
"Return t if last mod time of BUF's visited file matches what BUF records.\n\
This means that the file has not been changed since it was visited or saved.")
(buf)
Lisp_Object buf;
{
struct buffer *b;
struct stat st;
Lisp_Object handler;
Lisp_Object filename;
CHECK_BUFFER (buf, 0);
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 (XSTRING (filename)->data, &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,
"Clear out records of last mod time of visited file.\n\
Next attempt to save will certainly not complain of a discrepancy.")
()
{
current_buffer->modtime = 0;
return Qnil;
}
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
"Return the current buffer's recorded visited file modification time.\n\
The value is a list of the form (HIGH . LOW), like the time values\n\
that `file-attributes' returns.")
()
{
return long_to_cons ((unsigned long) current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
Sset_visited_file_modtime, 0, 1, 0,
"Update buffer's recorded modification time from the visited file's time.\n\
Useful if the buffer was not read from the file normally\n\
or if the file itself has been changed for some known benign reason.\n\
An argument specifies the modification time value to use\n\
\(instead of that of the visited file), in the form of a list\n\
\(HIGH . LOW) or (HIGH LOW).")
(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 (XSTRING (filename)->data, &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;
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 = STRING_BYTES (XSTRING (msg));
for (i = 0; i < 3; ++i)
{
if (i == 0)
message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
else
message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
Fsleep_for (make_number (1), Qnil);
}
UNGCPRO;
return Qnil;
}
Lisp_Object
auto_save_1 ()
{
struct stat st;
if (! NILP (current_buffer->filename)
&& stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
auto_save_mode_bits = st.st_mode | 0600;
else
auto_save_mode_bits = 0666;
return
Fwrite_region (Qnil, Qnil,
current_buffer->auto_save_file_name,
Qnil, Qlambda, Qnil, Qnil);
}
static Lisp_Object
do_auto_save_unwind (stream)
Lisp_Object stream;
{
auto_saving = 0;
if (!NILP (stream))
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
| XFASTINT (XCDR (stream))));
pop_message ();
return Qnil;
}
static Lisp_Object
do_auto_save_unwind_1 (value)
Lisp_Object value;
{
minibuffer_auto_raise = XINT (value);
return Qnil;
}
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
"Auto-save all buffers that need it.\n\
This is all buffers that have auto-saving enabled\n\
and are changed since last auto-saved.\n\
Auto-saving writes the buffer into a file\n\
so that your editing is not lost if the system crashes.\n\
This file is not the file you visited; that changes only when you save.\n\
Normally we run the normal hook `auto-save-hook' before saving.\n\n\
A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
A non-nil CURRENT-ONLY argument means save only current buffer.")
(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;
Lisp_Object lispstream;
int count = specpdl_ptr - specpdl;
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
int message_p = push_message ();
oquit = Vquit_flag;
Vquit_flag = Qnil;
if (minibuf_level)
no_message = Qt;
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 = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
call2 (Qmake_directory, dir, Qt);
}
stream = fopen (XSTRING (listfile)->data, "w");
if (stream != NULL)
{
lispstream = Fcons (Qnil, Qnil);
XSETFASTINT (XCAR (lispstream), (EMACS_UINT)stream >> 16);
XSETFASTINT (XCDR (lispstream), (EMACS_UINT)stream & 0xffff);
}
else
lispstream = Qnil;
}
else
{
stream = NULL;
lispstream = Qnil;
}
record_unwind_protect (do_auto_save_unwind, lispstream);
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)
{
if (!NILP (b->filename))
{
fwrite (XSTRING (b->filename)->data, 1,
STRING_BYTES (XSTRING (b->filename)), stream);
}
putc ('\n', stream);
fwrite (XSTRING (b->auto_save_file_name)->data, 1,
STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);
putc ('\n', stream);
}
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 turned off there",
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 (message_p)
{
sit_for (1, 0, 0, 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,
"Mark current buffer as auto-saved with its current text.\n\
No auto-save file will be written until the buffer changes again.")
()
{
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,
"Clear any record of a recent auto-save failure in the current buffer.")
()
{
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,
"Return t if buffer has been auto-saved since last read in or saved.")
()
{
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 unsigned char *old, *new;
register int n;
int osize, count;
osize = STRING_BYTES (XSTRING (val));
for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
old = XSTRING (val)->data;
val = make_uninit_multibyte_string (XSTRING (val)->size + count,
osize + count);
new = XSTRING (val)->data;
for (n = osize; n > 0; n--)
if (*old != '$')
*new++ = *old++;
else
{
*new++ = '$';
*new++ = '$';
old++;
}
}
return val;
}
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
3, 3, 0,
"Internal subroutine for read-file-name. Do not call this.")
(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, 0);
realdir = dir;
name = string;
orig_string = Qnil;
specdir = Qnil;
changed = 0;
GCPRO5 (string, realdir, name, specdir, orig_string);
if (XSTRING (string)->size == 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);
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))
return Ffile_name_all_completions (name, realdir);
#ifdef VMS
if (XSTRING (name)->size == 0)
return Qt;
#endif
return Ffile_exists_p (string);
}
DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
"Read file name, prompting with PROMPT and completing in directory DIR.\n\
Value is not expanded---you must call `expand-file-name' yourself.\n\
Default name to DEFAULT-FILENAME if user enters a null string.\n\
(If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
except that if INITIAL is specified, that combined with DIR is used.)\n\
Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
Non-nil and non-t means also require confirmation after completion.\n\
Fifth arg INITIAL specifies text to start with.\n\
DIR defaults to current buffer's directory default.\n\
\n\
If this command was invoked with the mouse, use a file dialog box if\n\
`use-dialog-box' is non-nil, and the window system or X toolkit in use\n\
provides a file dialog box..")
(prompt, dir, default_filename, mustmatch, initial)
Lisp_Object prompt, dir, default_filename, mustmatch, initial;
{
Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
int replace_in_history = 0;
int add_to_history = 0;
int count;
if (NILP (dir))
dir = current_buffer->directory;
if (NILP (default_filename))
{
if (! NILP (initial))
default_filename = Fexpand_file_name (initial, dir);
else
default_filename = 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
&& STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
&& IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
{
dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
XSTRING (dir)->data[0] = '~';
}
if (homedir != 0
&& STRINGP (default_filename)
&& !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
&& IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
{
default_filename
= make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,
STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);
XSTRING (default_filename)->data[0] = '~';
}
if (!NILP (default_filename))
{
CHECK_STRING (default_filename, 3);
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 (XSTRING (double_dollars (dir))->size);
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;
count = specpdl_ptr - specpdl;
#ifdef VMS
specbind (intern ("completion-ignore-case"), Qt);
#endif
specbind (intern ("minibuffer-completing-file-name"), Qt);
GCPRO2 (insdef, default_filename);
#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
{
Lisp_Object file;
file = Ffile_name_nondirectory (dir);
if (XSTRING (file)->size && 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);
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 = build_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;
else if (XSTRING (val)->size == 0 && NILP (insdef))
{
if (!NILP (default_filename))
val = default_filename;
else
error ("No default file name");
}
val = Fsubstitute_in_file_name (val);
if (replace_in_history)
XCAR (Fsymbol_value (Qfile_name_history)) = double_dollars (val);
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)))
Fset (Qfile_name_history,
Fcons (val1, tem));
}
return val;
}
void
init_fileio_once ()
{
XSETFASTINT (Vdirectory_sep_char, '/');
}
void
syms_of_fileio ()
{
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");
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");
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 (&Qfile_newer_than_file_p);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
staticpro (&Qset_visited_file_modtime);
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,
"*Coding system for encoding file names.\n\
If it is nil, default-file-name-coding-system (which see) is used.");
Vfile_name_coding_system = Qnil;
DEFVAR_LISP ("default-file-name-coding-system",
&Vdefault_file_name_coding_system,
"Default coding system for encoding file names.\n\
This variable is used only when file-name-coding-system is nil.\n\
\n\
This variable is set/changed by the command set-language-environment.\n\
User should not set this variable manually,\n\
instead use file-name-coding-system to get a constant encoding\n\
of file names regardless of the current language environment.");
Vdefault_file_name_coding_system = Qnil;
DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format,
"*Format in which to write auto-save files.\n\
Should be a list of symbols naming formats that are defined in `format-alist'.\n\
If it is t, which is the default, auto-save files are written in the\n\
same format as a regular save would use.");
Vauto_save_file_format = Qt;
Qformat_decode = intern ("format-decode");
staticpro (&Qformat_decode);
Qformat_annotate_function = intern ("format-annotate-function");
staticpro (&Qformat_annotate_function);
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
Fput (Qfile_error, Qerror_conditions,
Fcons (Qfile_error, Fcons (Qerror, Qnil)));
Fput (Qfile_error, Qerror_message,
build_string ("File error"));
Fput (Qfile_already_exists, Qerror_conditions,
Fcons (Qfile_already_exists,
Fcons (Qfile_error, Fcons (Qerror, Qnil))));
Fput (Qfile_already_exists, Qerror_message,
build_string ("File already exists"));
Fput (Qfile_date_error, Qerror_conditions,
Fcons (Qfile_date_error,
Fcons (Qfile_error, Fcons (Qerror, Qnil))));
Fput (Qfile_date_error, Qerror_message,
build_string ("Cannot set file date"));
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
"*Non-nil means when reading a filename start with default dir in minibuffer.");
insert_default_directory = 1;
DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
"*Non-nil means write new files with record format `stmlf'.\n\
nil means use format `var'. This variable is meaningful only on VMS.");
vms_stmlf_recfm = 0;
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
"Directory separator character for built-in functions that return file names.\n\
The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
This variable affects the built-in functions only on Windows,\n\
on other platforms, it is initialized so that Lisp code can find out\n\
what the normal separator is.\n\
\n\
WARNING: This variable is deprecated and will be removed in the near\n\
future. DO NOT USE IT.");
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
"*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
If a file name matches REGEXP, then all I/O on that file is done by calling\n\
HANDLER.\n\
\n\
The first argument given to HANDLER is the name of the I/O primitive\n\
to be handled; the remaining arguments are the arguments that were\n\
passed to that primitive. For example, if you do\n\
(file-exists-p FILENAME)\n\
and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
(funcall HANDLER 'file-exists-p FILENAME)\n\
The function `find-file-name-handler' checks this list for a handler\n\
for its argument.");
Vfile_name_handler_alist = Qnil;
DEFVAR_LISP ("set-auto-coding-function",
&Vset_auto_coding_function,
"If non-nil, a function to call to decide a coding system of file.\n\
Two arguments are passed to this function: the file name\n\
and the length of a file contents following the point.\n\
This function should return a coding system to decode the file contents.\n\
It should check the file name against `auto-coding-alist'.\n\
If no coding system is decided, it should check a coding system\n\
specified in the heading lines with the format:\n\
-*- ... coding: CODING-SYSTEM; ... -*-\n\
or local variable spec of the tailing lines with `coding:' tag.");
Vset_auto_coding_function = Qnil;
DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
"A list of functions to be called at the end of `insert-file-contents'.\n\
Each is passed one argument, the number of bytes inserted. It should return\n\
the new byte count, and leave point the same. If `insert-file-contents' is\n\
intercepted by a handler from `file-name-handler-alist', that handler is\n\
responsible for calling the after-insert-file-functions if appropriate.");
Vafter_insert_file_functions = Qnil;
DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
"A list of functions to be called at the start of `write-region'.\n\
Each is passed two arguments, START and END as for `write-region'.\n\
These are usually two numbers but not always; see the documentation\n\
for `write-region'. The function should return a list of pairs\n\
of the form (POSITION . STRING), consisting of strings to be effectively\n\
inserted at the specified positions of the file being written (1 means to\n\
insert before the first byte written). The POSITIONs must be sorted into\n\
increasing order. If there are several functions in the list, the several\n\
lists are merged destructively.");
Vwrite_region_annotate_functions = Qnil;
DEFVAR_LISP ("write-region-annotations-so-far",
&Vwrite_region_annotations_so_far,
"When an annotation function is called, this holds the previous annotations.\n\
These are the annotations made by other annotation functions\n\
that were already called. See also `write-region-annotate-functions'.");
Vwrite_region_annotations_so_far = Qnil;
DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
"A list of file name handlers that temporarily should not be used.\n\
This applies only to the operation `inhibit-file-name-operation'.");
Vinhibit_file_name_handlers = Qnil;
DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
"The operation for which `inhibit-file-name-handlers' is applicable.");
Vinhibit_file_name_operation = Qnil;
DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
"File name in which we write a list of all auto save file names.\n\
This variable is initialized automatically from `auto-save-list-file-prefix'\n\
shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
a non-nil value.");
Vauto_save_list_file_name = Qnil;
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_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);
#ifdef unix
defsubr (&Sunix_sync);
#endif
}