#include <config.h>
-#if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
+#if defined (USG5) || defined (BSD_SYSTEM) || defined (GNU_LINUX)
#include <fcntl.h>
#endif
/* File name in which we write a list of all our auto save files. */
Lisp_Object Vauto_save_list_file_name;
+/* Function to call to read a file name. */
+Lisp_Object Vread_file_name_function;
+
+/* Current predicate used by read_file_name_internal. */
+Lisp_Object Vread_file_name_predicate;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
\f
void
report_file_error (string, data)
- char *string;
+ const char *string;
Lisp_Object data;
{
Lisp_Object errstring;
default:
/* System error messages are capitalized. Downcase the initial
unless it is followed by a slash. */
- if (XSTRING (errstring)->data[1] != '/')
- XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+ if (SREF (errstring, 1) != '/')
+ SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
Fsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
Lisp_Object filename, operation;
{
/* This function must not munge the match data. */
- Lisp_Object chain, inhibited_handlers;
+ Lisp_Object chain, inhibited_handlers, result;
+ int pos = -1;
- CHECK_STRING (filename, 0);
+ result = Qnil;
+ CHECK_STRING (filename);
if (EQ (operation, Vinhibit_file_name_operation))
inhibited_handlers = Vinhibit_file_name_handlers;
if (CONSP (elt))
{
Lisp_Object string;
+ int match_pos;
string = XCAR (elt);
- if (STRINGP (string) && fast_string_match (string, filename) >= 0)
+ if (STRINGP (string)
+ && (match_pos = fast_string_match (string, filename)) > pos)
{
Lisp_Object handler, tem;
handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
- return handler;
+ {
+ result = handler;
+ pos = match_pos;
+ }
}
}
QUIT;
}
- return Qnil;
+ return result;
}
\f
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
(filename)
Lisp_Object filename;
{
- register unsigned char *beg;
- register unsigned char *p;
+ register const unsigned char *beg;
+ register const unsigned char *p;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
#ifdef FILE_SYSTEM_CASE
filename = FILE_SYSTEM_CASE (filename);
#endif
- beg = XSTRING (filename)->data;
+ beg = SDATA (filename);
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
- p = beg + STRING_BYTES (XSTRING (filename));
+ p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
(filename)
Lisp_Object filename;
{
- register unsigned char *beg, *p, *end;
+ register const unsigned char *beg, *p, *end;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, filename);
- beg = XSTRING (filename)->data;
- end = p = beg + STRING_BYTES (XSTRING (filename));
+ beg = SDATA (filename);
+ end = p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
/* For Unix syntax, Append a slash if necessary */
if (!IS_DIRECTORY_SEP (out[size]))
{
- out[size + 1] = DIRECTORY_SEP;
+ /* Cannot use DIRECTORY_SEP, which could have any value */
+ out[size + 1] = '/';
out[size + 2] = '\0';
}
#ifdef DOS_NT
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Sfile_name_as_directory, 1, 1, 0,
- doc: /* Return a string representing file FILENAME interpreted as a directory.
+ doc: /* Return a string representing the file name FILE interpreted as a directory.
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
The result can be used as the value of `default-directory'
char *buf;
Lisp_Object handler;
- CHECK_STRING (file, 0);
+ CHECK_STRING (file);
if (NILP (file))
return Qnil;
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));
+ buf = (char *) alloca (SBYTES (file) + 10);
+ return build_string (file_name_as_directory (buf, SDATA (file)));
}
\f
/*
char *buf;
Lisp_Object handler;
- CHECK_STRING (directory, 0);
+ CHECK_STRING (directory);
if (NILP (directory))
return Qnil;
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
chars long, so grab that much extra space... - sss */
- buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255);
+ buf = (char *) alloca (SBYTES (directory) + 20 + 255);
#else
- buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);
+ buf = (char *) alloca (SBYTES (directory) + 20);
#endif
- directory_file_name (XSTRING (directory)->data, buf);
+ directory_file_name (SDATA (directory), buf);
return build_string (buf);
}
char pidbuf[20];
int pidlen;
- CHECK_STRING (prefix, 0);
+ CHECK_STRING (prefix);
/* VAL is created by adding 6 characters to PREFIX. The first
three are the PID of this process, in base 64, and the second
#endif
}
- len = XSTRING (prefix)->size;
+ len = SCHARS (prefix);
val = make_uninit_string (len + 3 + pidlen);
- data = XSTRING (val)->data;
- bcopy(XSTRING (prefix)->data, data, len);
+ data = SDATA (val);
+ bcopy(SDATA (prefix), data, len);
p = data + len;
bcopy (pidbuf, p, pidlen);
}
error ("Cannot create temporary name for prefix `%s'",
- XSTRING (prefix)->data);
+ SDATA (prefix));
return Qnil;
}
There is a race condition between calling `make-temp-name' and creating the
file which opens all kinds of security holes. For that reason, you should
-probably use `make-temp-file' instead. */)
+probably use `make-temp-file' instead, except in three circumstances:
+
+* If you are creating the file in the user's home directory.
+* If you are creating a directory rather than an ordinary file.
+* If you are taking special precautions as `make-temp-file' does. */)
(prefix)
Lisp_Object prefix;
{
int length;
Lisp_Object handler;
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (NILP (default_directory))
default_directory = current_buffer->directory;
if (! STRINGP (default_directory))
- default_directory = build_string ("/");
+ {
+#ifdef DOS_NT
+ /* "/" is not considered a root directory on DOS_NT, so using "/"
+ here causes an infinite recursion in, e.g., the following:
+
+ (let (default-directory)
+ (expand-file-name "a"))
+
+ To avoid this, we set default_directory to the root of the
+ current drive. */
+ extern char *emacs_root_dir (void);
+
+ default_directory = build_string (emacs_root_dir ());
+#else
+ default_directory = build_string ("/");
+#endif
+ }
if (!NILP (default_directory))
{
return call3 (handler, Qexpand_file_name, name, default_directory);
}
- o = XSTRING (default_directory)->data;
+ o = SDATA (default_directory);
/* Make sure DEFAULT_DIRECTORY is properly expanded.
It would be better to do this down below where we actually use
name = FILE_SYSTEM_CASE (name);
#endif
- nm = XSTRING (name)->data;
+ nm = SDATA (name);
#ifdef DOS_NT
/* We will force directory separators to be either all \ or /, so make
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
- if (strcmp (nm, XSTRING (name)->data) != 0)
+ if (strcmp (nm, SDATA (name)) != 0)
name = build_string (nm);
}
else
#endif
/* drive must be set, so this is okay */
- if (strcmp (nm - 2, XSTRING (name)->data) != 0)
+ if (strcmp (nm - 2, SDATA (name)) != 0)
{
name = make_string (nm - 2, p - nm + 2);
- XSTRING (name)->data[0] = DRIVE_LETTER (drive);
- XSTRING (name)->data[1] = ':';
+ SSET (name, 0, DRIVE_LETTER (drive));
+ SSET (name, 1, ':');
}
return name;
#else /* not DOS_NT */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
return build_string (nm);
#endif /* not DOS_NT */
#endif
&& !newdir)
{
- newdir = XSTRING (default_directory)->data;
+ newdir = SDATA (default_directory);
#ifdef DOS_NT
/* Note if special escape prefix is present, but remove for now. */
if (newdir[0] == '/' && newdir[1] == ':')
}
#if 0
+/* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
+ This is the old version of expand-file-name, before it was thoroughly
+ rewritten for Emacs 10.31. We leave this version here commented-out,
+ because the code is very complex and likely to have subtle bugs. If
+ bugs _are_ found, it might be of interest to look at the old code and
+ see what did it do in the relevant situation.
+
+ Don't remove this code: it's true that it will be accessible via CVS,
+ but a few years from deletion, people will forget it is there. */
+
/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert FILENAME to absolute, and canonicalize it.\n\
int dots = 0;
#endif /* VMS */
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
#ifdef VMS
/* Filenames on VMS are always upper case. */
name = Fupcase (name);
#endif
- nm = XSTRING (name)->data;
+ nm = SDATA (name);
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
if (index (nm, '/'))
return build_string (sys_translate_unix (nm));
#endif /* VMS */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
return build_string (nm);
}
{
if (NILP (defalt))
defalt = current_buffer->directory;
- CHECK_STRING (defalt, 1);
- newdir = XSTRING (defalt)->data;
+ CHECK_STRING (defalt);
+ newdir = SDATA (defalt);
}
/* Now concatenate the directory and name to new space in the stack frame */
int total = 0;
int substituted = 0;
unsigned char *xnm;
+ struct passwd *pw;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (!NILP (handler))
return call2 (handler, Qsubstitute_in_file_name, filename);
- nm = XSTRING (filename)->data;
+ nm = SDATA (filename);
#ifdef DOS_NT
nm = strcpy (alloca (strlen (nm) + 1), nm);
CORRECT_DIR_SEPS (nm);
- substituted = (strcmp (nm, XSTRING (filename)->data) != 0);
+ substituted = (strcmp (nm, SDATA (filename)) != 0);
#endif
- endp = nm + STRING_BYTES (XSTRING (filename));
+ endp = nm + SBYTES (filename);
/* If /~ or // appears, discard everything through first slash. */
#endif /* VMS */
|| IS_DIRECTORY_SEP (p[-1])))
{
- nm = p;
- substituted = 1;
+ for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
+#ifdef VMS
+ && *s != ':'
+#endif /* VMS */
+ ); s++);
+ if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
+ {
+ o = (unsigned char *) alloca (s - p + 1);
+ bcopy ((char *) p, o, s - p);
+ o [s - p] = 0;
+
+ pw = (struct passwd *) getpwnam (o + 1);
+ }
+ /* If we have ~/ or ~user and `user' exists, discard
+ everything up to ~. But if `user' does not exist, leave
+ ~user alone, it might be a literal file name. */
+ if (IS_DIRECTORY_SEP (p[0]) || s == p + 1 || pw)
+ {
+ nm = p;
+ substituted = 1;
+ }
}
#ifdef DOS_NT
/* see comment in expand-file-name about drive specifiers */
/* Get variable value */
o = (unsigned char *) egetenv (target);
- if (!o) goto badvar;
- total += strlen (o);
- substituted = 1;
+ if (o)
+ {
+ total += strlen (o);
+ substituted = 1;
+ }
+ else if (*p == '}')
+ goto badvar;
}
if (!substituted)
/* If substitution required, recopy the string and do it */
/* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1);
+ xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
/* Get variable value */
o = (unsigned char *) egetenv (target);
if (!o)
- goto badvar;
-
- if (STRING_MULTIBYTE (filename))
+ {
+ *x++ = '$';
+ strcpy (x, target); x+= strlen (target);
+ }
+ else if (STRING_MULTIBYTE (filename))
{
/* If the original string is multibyte,
convert what we substitute into multibyte. */
absname = Fexpand_file_name (filename, defdir);
#ifdef VMS
{
- register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];
+ register int c = SREF (absname, SBYTES (absname) - 1);
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
#else
/* Remove final slash, if any (unless this is the root dir).
stat behaves differently depending! */
- 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]))
+ if (SCHARS (absname) > 1
+ && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
+ && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
#endif
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)
+ if (stat (SDATA (encoded_filename), &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fcons (absname, Qnil)));
GCPRO1 (absname);
tem = format1 ("File %s already exists; %s anyway? ",
- XSTRING (absname)->data, querystring);
+ SDATA (absname), querystring);
if (quick)
tem = Fy_or_n_p (tem);
else
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
- CHECK_STRING (file, 0);
- CHECK_STRING (newname, 1);
+ CHECK_STRING (file);
+ CHECK_STRING (newname);
if (!NILP (Ffile_directory_p (newname)))
newname = Fexpand_file_name (file, newname);
|| 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)
+ else if (stat (SDATA (encoded_newname), &out_st) < 0)
out_st.st_mode = 0;
#ifdef WINDOWSNT
- if (!CopyFile (XSTRING (encoded_file)->data,
- XSTRING (encoded_newname)->data,
+ if (!CopyFile (SDATA (encoded_file),
+ SDATA (encoded_newname),
FALSE))
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
else if (NILP (keep_time))
{
EMACS_TIME now;
+ DWORD attributes;
+ char * filename;
+
EMACS_GET_TIME (now);
- if (set_file_times (XSTRING (encoded_newname)->data,
- now, now))
- Fsignal (Qfile_date_error,
- Fcons (build_string ("Cannot set file date"),
- Fcons (newname, Qnil)));
+ filename = SDATA (encoded_newname);
+
+ /* Ensure file is writable while its modified time is set. */
+ attributes = GetFileAttributes (filename);
+ SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
+ if (set_file_times (filename, now, now))
+ {
+ /* Restore original attributes. */
+ SetFileAttributes (filename, attributes);
+ Fsignal (Qfile_date_error,
+ Fcons (build_string ("Cannot set file date"),
+ Fcons (newname, Qnil)));
+ }
+ /* Restore original attributes. */
+ SetFileAttributes (filename, attributes);
}
#else /* not WINDOWSNT */
- ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);
+ ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
#ifdef VMS
/* Create the copy file with the same record format as the input file */
- ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd);
+ ofd = sys_creat (SDATA (encoded_newname), 0666, ifd);
#else
#ifdef MSDOS
/* System's default file type was set to binary by _fmode in emacs.c. */
- ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE);
+ ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE);
#else /* not MSDOS */
- ofd = creat (XSTRING (encoded_newname)->data, 0666);
+ ofd = creat (SDATA (encoded_newname), 0666);
#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
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,
+ if (set_file_times (SDATA (encoded_newname),
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);
+ chmod (SDATA (encoded_newname), st.st_mode & 07777);
#else /* MSDOS */
#if defined (__DJGPP__) && __DJGPP__ > 1
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
get only the READ bit, which will make the copied file read-only,
so it's better not to chmod at all. */
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
- chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
+ chmod (SDATA (encoded_newname), st.st_mode & 07777);
#endif /* DJGPP version 2 or newer */
#endif /* MSDOS */
}
(directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
- CHECK_STRING (directory, 0);
+ CHECK_STRING (directory);
directory = Fexpand_file_name (directory, Qnil);
handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
(directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
- CHECK_STRING (directory, 0);
+ CHECK_STRING (directory);
directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
handler = Ffind_file_name_handler (directory, Qdelete_directory);
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &directory));
Lisp_Object handler;
Lisp_Object encoded_file;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qdelete_file);
encoded_file = ENCODE_FILE (filename);
- if (0 > unlink (XSTRING (encoded_file)->data))
+ if (0 > unlink (SDATA (encoded_file)))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
}
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
- CHECK_STRING (file, 0);
- CHECK_STRING (newname, 1);
+ CHECK_STRING (file);
+ CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
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))
+ if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
#else
- if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)
- || 0 > unlink (XSTRING (encoded_file)->data))
+ if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
+ || 0 > unlink (SDATA (encoded_file)))
#endif
{
if (errno == EXDEV)
GCPRO4 (file, newname, encoded_file, encoded_newname);
encoded_file = encoded_newname = Qnil;
- CHECK_STRING (file, 0);
- CHECK_STRING (newname, 1);
+ CHECK_STRING (file);
+ CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
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))
+ unlink (SDATA (newname));
+ if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
{
#ifdef NO_ARG_ARRAY
args[0] = file;
GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
encoded_filename = encoded_linkname = Qnil;
- CHECK_STRING (filename, 0);
- CHECK_STRING (linkname, 1);
+ CHECK_STRING (filename);
+ CHECK_STRING (linkname);
/* If the link target has a ~, we must expand it to get
a truly valid file name. Otherwise, do not expand;
we want to permit links to relative file names. */
- if (XSTRING (filename)->data[0] == '~')
+ if (SREF (filename, 0) == '~')
filename = Fexpand_file_name (filename, Qnil);
linkname = Fexpand_file_name (linkname, Qnil);
|| 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 (0 > symlink (SDATA (encoded_filename),
+ SDATA (encoded_linkname)))
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (XSTRING (encoded_linkname)->data);
- if (0 <= symlink (XSTRING (encoded_filename)->data,
- XSTRING (encoded_linkname)->data))
+ unlink (SDATA (encoded_linkname));
+ if (0 <= symlink (SDATA (encoded_filename),
+ SDATA (encoded_linkname)))
{
UNGCPRO;
return Qnil;
Lisp_Object name;
Lisp_Object string;
{
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
if (NILP (string))
- delete_logical_name (XSTRING (name)->data);
+ delete_logical_name (SDATA (name));
else
{
- CHECK_STRING (string, 1);
+ CHECK_STRING (string);
- if (XSTRING (string)->size == 0)
- delete_logical_name (XSTRING (name)->data);
+ if (SCHARS (string) == 0)
+ delete_logical_name (SDATA (name));
else
- define_logical_name (XSTRING (name)->data, XSTRING (string)->data);
+ define_logical_name (SDATA (name), SDATA (string));
}
return string;
{
int netresult;
- CHECK_STRING (path, 0);
- CHECK_STRING (login, 0);
+ CHECK_STRING (path);
+ CHECK_STRING (login);
- netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
+ netresult = netunam (SDATA (path), SDATA (login));
if (netresult == -1)
return Qnil;
(filename)
Lisp_Object filename;
{
- unsigned char *ptr;
+ const unsigned char *ptr;
- CHECK_STRING (filename, 0);
- ptr = XSTRING (filename)->data;
+ CHECK_STRING (filename);
+ ptr = SDATA (filename);
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
#ifdef VMS
/* ??? This criterion is probably wrong for '<'. */
Lisp_Object handler;
struct stat statbuf;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
absname = ENCODE_FILE (absname);
- return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil;
+ return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
Lisp_Object absname;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
absname = ENCODE_FILE (absname);
- return (check_executable (XSTRING (absname)->data) ? Qt : Qnil);
+ return (check_executable (SDATA (absname)) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
int flags;
struct stat statbuf;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
#if defined(DOS_NT) || defined(macintosh)
/* Under MS-DOS, Windows, and Macintosh, open does not work for
directories. */
- if (access (XSTRING (absname)->data, 0) == 0)
+ if (access (SDATA (absname), 0) == 0)
return Qt;
return Qnil;
#else /* not DOS_NT and not macintosh */
/* Opening a fifo without O_NONBLOCK can wait.
We don't want to wait. But we don't want to mess wth O_NONBLOCK
except in the case of a fifo, on a system which handles it. */
- desc = stat (XSTRING (absname)->data, &statbuf);
+ desc = stat (SDATA (absname), &statbuf);
if (desc < 0)
return Qnil;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = emacs_open (XSTRING (absname)->data, flags, 0);
+ desc = emacs_open (SDATA (absname), flags, 0);
if (desc < 0)
return Qnil;
emacs_close (desc);
Lisp_Object handler;
struct stat statbuf;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
- if (stat (XSTRING (encoded)->data, &statbuf) >= 0)
- return (check_writable (XSTRING (encoded)->data)
+ if (stat (SDATA (encoded), &statbuf) >= 0)
+ return (check_writable (SDATA (encoded))
? Qt : Qnil);
dir = Ffile_name_directory (absname);
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- if (stat (XSTRING (dir)->data, &statbuf) < 0)
+ if (stat (SDATA (dir), &statbuf) < 0)
return Qnil;
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
#else
- return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
+ return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
? Qt : Qnil);
#endif
}
(filename, string)
Lisp_Object filename, string;
{
- Lisp_Object handler, encoded_filename;
+ Lisp_Object handler, encoded_filename, absname;
int fd;
- CHECK_STRING (filename, 0);
- CHECK_STRING (string, 1);
+ CHECK_STRING (filename);
+ absname = Fexpand_file_name (filename, Qnil);
+
+ CHECK_STRING (string);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename, Qaccess_file);
+ handler = Ffind_file_name_handler (absname, Qaccess_file);
if (!NILP (handler))
- return call3 (handler, Qaccess_file, filename, string);
+ return call3 (handler, Qaccess_file, absname, string);
- encoded_filename = ENCODE_FILE (filename);
+ encoded_filename = ENCODE_FILE (absname);
- fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
+ fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
if (fd < 0)
- report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
+ report_file_error (SDATA (string), Fcons (filename, Qnil));
emacs_close (fd);
return Qnil;
Lisp_Object val;
Lisp_Object handler;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
bzero (buf, bufsize);
errno = 0;
- valsize = readlink (XSTRING (filename)->data, buf, bufsize);
+ valsize = readlink (SDATA (filename), buf, bufsize);
if (valsize == -1)
{
#ifdef ERANGE
absname = ENCODE_FILE (absname);
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
}
DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
- doc: /* Return t if file FILENAME is the name of a directory as a file,
-and files in that directory can be opened by you. In order to use a
+ doc: /* Return t if file FILENAME names a directory you can open.
+For the value to be t, FILENAME must specify the name of a directory as a file,
+and the directory must allow you to open files in it. In order to use a
directory as a buffer's current directory, this predicate must return true.
A directory name spec may be given instead; then the value is t
if the directory so specified exists and really is a readable and
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- result = stat (XSTRING (absname)->data, &st);
+ result = stat (SDATA (absname), &st);
Vw32_get_true_file_attributes = tem;
if (result < 0)
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
}
#else
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
#endif
absname = ENCODE_FILE (absname);
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
#if defined (MSDOS) && __DJGPP__ < 2
- if (check_executable (XSTRING (absname)->data))
+ if (check_executable (SDATA (absname)))
st.st_mode |= S_IEXEC;
#endif /* MSDOS && __DJGPP__ < 2 */
Lisp_Object handler;
absname = Fexpand_file_name (filename, current_buffer->directory);
- CHECK_NUMBER (mode, 1);
+ CHECK_NUMBER (mode);
/* If the file name has special constructs in it,
call the corresponding file handler. */
encoded_absname = ENCODE_FILE (absname);
- if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0)
+ if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
return Qnil;
(mode)
Lisp_Object mode;
{
- CHECK_NUMBER (mode, 0);
+ CHECK_NUMBER (mode);
umask ((~ XINT (mode)) & 0777);
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
- CHECK_STRING (file1, 0);
- CHECK_STRING (file2, 0);
+ CHECK_STRING (file1);
+ CHECK_STRING (file2);
absname1 = Qnil;
GCPRO2 (absname1, file2);
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
- if (stat (XSTRING (absname1)->data, &st) < 0)
+ if (stat (SDATA (absname1), &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
- if (stat (XSTRING (absname2)->data, &st) < 0)
+ if (stat (SDATA (absname2), &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
immediate_quit = 1;
QUIT;
nbytes = emacs_read (non_regular_fd,
- BEG_ADDR + PT_BYTE - 1 + non_regular_inserted,
+ BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
non_regular_nbytes);
- Fsignal (Qquit, Qnil);
immediate_quit = 0;
return make_number (nbytes);
}
int inserted = 0;
register int how_much;
register int unprocessed;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object handler, val, insval, orig_filename;
Lisp_Object p;
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))
GCPRO4 (filename, val, p, orig_filename);
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- total = stat (XSTRING (filename)->data, &st);
+ total = stat (SDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
if (total < 0)
#else
#ifndef APOLLO
- if (stat (XSTRING (filename)->data, &st) < 0)
+ if (stat (SDATA (filename), &st) < 0)
#else
- if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0
+ if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
#endif /* WINDOWSNT */
#endif
if (fd < 0)
- if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)
+ if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
}
if (!NILP (beg))
- CHECK_NUMBER (beg, 0);
+ CHECK_NUMBER (beg);
else
XSETFASTINT (beg, 0);
if (!NILP (end))
- CHECK_NUMBER (end, 0);
+ CHECK_NUMBER (end);
else
{
if (! not_regular)
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread > 0)
{
struct buffer *prev = current_buffer;
- int count1;
+ Lisp_Object buffer;
+ struct buffer *buf;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- /* The call to temp_output_buffer_setup binds
- standard-output. */
- count1 = specpdl_ptr - specpdl;
- temp_output_buffer_setup (" *code-converting-work*");
+ buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
+ buf = XBUFFER (buffer);
+
+ buf->directory = current_buffer->directory;
+ buf->read_only = Qnil;
+ buf->filename = Qnil;
+ buf->undo_list = Qt;
+ buf->overlays_before = Qnil;
+ buf->overlays_after = Qnil;
- set_buffer_internal (XBUFFER (Vstandard_output));
- current_buffer->enable_multibyte_characters = Qnil;
+ set_buffer_internal (buf);
+ Ferase_buffer ();
+ buf->enable_multibyte_characters = Qnil;
+
insert_1_both (read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
val = call2 (Vset_auto_coding_function,
filename, make_number (nread));
set_buffer_internal (prev);
-
- /* Remove the binding for standard-output. */
- unbind_to (count1, Qnil);
/* Discard the unwind protect for recovering the
current buffer. */
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
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));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
total_read += nread;
if (how_much == -1)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
here doesn't do any harm. */
immediate_quit = 1;
QUIT;
- this = emacs_read (fd, BEG_ADDR + PT_BYTE - 1 + inserted, trytry);
+ this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
immediate_quit = 0;
}
if (how_much < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
notfound:
this way, we can run Lisp program safely before decoding
the inserted text. */
Lisp_Object unwind_data;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
unwind_data = Fcons (current_buffer->enable_multibyte_characters,
Fcons (current_buffer->undo_list,
if (!EQ (current_buffer->undo_list, Qt))
current_buffer->undo_list = Qnil;
#ifdef APOLLO
- stat (XSTRING (filename)->data, &st);
+ stat (SDATA (filename), &st);
#endif
if (NILP (handler))
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
- CHECK_NUMBER (insval, 0);
+ CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
if (!NILP (visit))
}
p = Vafter_insert_file_functions;
- while (!NILP (p))
+ while (CONSP (p))
{
- insval = call1 (Fcar (p), make_number (inserted));
+ insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval, 0);
+ CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
}
QUIT;
- p = Fcdr (p);
+ p = XCDR (p);
}
if (!NILP (visit)
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
-static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object));
+static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object));
/* If build_annotations switched buffers, switch back to BUF.
Kill the temporary buffer that was selected in the meantime.
return Qnil;
}
+/* Decide the coding-system to encode the data with. */
+
+void
+choose_write_coding_system (start, end, filename,
+ append, visit, lockname, coding)
+ Lisp_Object start, end, filename, append, visit, lockname;
+ struct coding_system *coding;
+{
+ Lisp_Object val;
+
+ if (auto_saving)
+ val = Qnil;
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else
+ {
+ /* If the variable `buffer-file-coding-system' is set locally,
+ it means that the file was read with some kind of code
+ conversion or the variable is explicitly set by users. We
+ had better write it out with the same coding system even if
+ `enable-multibyte-characters' is nil.
+
+ If it is not set locally, we anyway have to convert EOL
+ format if the default value of `buffer-file-coding-system'
+ tells that it is not Unix-like (LF only) format. */
+ 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))
+ {
+ /* Check file-coding-system-alist. */
+ 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))
+ {
+ /* If we still have not decided a coding system, use the
+ default value of 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)))
+ /* Confirm that VAL can surely encode the current region. */
+ val = call5 (Vselect_safe_coding_system_function,
+ start, end, val, Qnil, filename);
+
+ setup_coding_system (Fcheck_coding_system (val), coding);
+ if (coding->eol_type == CODING_EOL_UNDECIDED
+ && !using_default_coding)
+ {
+ if (! EQ (default_buffer_file_coding.symbol,
+ buffer_defaults.buffer_file_coding_system))
+ setup_coding_system (buffer_defaults.buffer_file_coding_system,
+ &default_buffer_file_coding);
+ if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
+ {
+ Lisp_Object subsidiaries;
+
+ coding->eol_type = default_buffer_file_coding.eol_type;
+ subsidiaries = Fget (coding->symbol, Qeol_type);
+ if (VECTORP (subsidiaries)
+ && XVECTOR (subsidiaries)->size == 3)
+ coding->symbol
+ = XVECTOR (subsidiaries)->contents[coding->eol_type];
+ }
+ }
+
+ if (force_raw_text)
+ setup_raw_text_coding_system (coding);
+ goto done_setup_coding;
+ }
+
+ setup_coding_system (Fcheck_coding_system (val), coding);
+
+ done_setup_coding:
+ if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+ coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
+}
+
DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
"r\nFWrite region to file: \ni\ni\ni\np",
doc: /* Write current region into specified file.
-When called from a program, takes three arguments:
-START, END and FILENAME. START and END are buffer positions.
+When called from a program, requires three arguments:
+START, END and FILENAME. START and END are normally buffer positions
+specifying the part of the buffer to write.
+If START is nil, that means to use the entire buffer contents.
+If START is a string, then output that string to the file
+instead of any buffer contents; END is ignored.
+
Optional fourth argument APPEND if non-nil means
append to existing file contents (if any). If it is an integer,
seek to that offset in the file before writing.
the output goes to FILENAME, but the buffer is marked as visiting VISIT.
VISIT is also the file name to lock and unlock for clash detection.
If VISIT is neither t nor nil nor a string,
- that means do not print the \"Wrote file\" message.
+ that means do not display the \"Wrote file\" message.
The optional sixth arg LOCKNAME, if non-nil, specifies the name to
use for locking and unlocking, overriding FILENAME and VISIT.
The optional seventh arg MUSTBENEW, if non-nil, insists on a check
If MUSTBENEW is neither nil nor `excl', that means ask for
confirmation before overwriting, but do go ahead and overwrite the file
if the user confirms.
-Kludgy feature: if START is a string, then that string is written
-to the file, instead of any buffer contents, and END is ignored.
This does code conversion according to the value of
`coding-system-for-write', `buffer-file-coding-system', or
register int desc;
int failure;
int save_errno = 0;
- unsigned char *fn;
+ const unsigned char *fn;
struct stat st;
int tem;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int count1;
#ifdef VMS
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
- GCPRO4 (start, filename, visit, lockname);
-
- /* Decide the coding-system to encode the data with. */
- {
- Lisp_Object val;
-
- if (auto_saving)
- val = Qnil;
- else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else
- {
- /* If the variable `buffer-file-coding-system' is set locally,
- it means that the file was read with some kind of code
- conversion or the variable is explicitly set by users. We
- had better write it out with the same coding system even if
- `enable-multibyte-characters' is nil.
-
- If it is not set locally, we anyway have to convert EOL
- format if the default value of `buffer-file-coding-system'
- tells that it is not Unix-like (LF only) format. */
- 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))
- {
- /* Check file-coding-system-alist. */
- 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))
- {
- /* If we still have not decided a coding system, use the
- default value of 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)))
- /* Confirm that VAL can surely encode the current region. */
- 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;
+ GCPRO5 (start, filename, visit, visit_file, lockname);
filename = Fexpand_file_name (filename, Qnil);
- if (! NILP (mustbenew) && !EQ (mustbenew, Qexcl))
+ 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);
+ annotations = Qnil;
/* If the file name has special constructs in it,
call the corresponding file handler. */
}
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
- count1 = specpdl_ptr - specpdl;
+ count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
- annotations = build_annotations (start, end, coding.pre_write_conversion);
- if (current_buffer != given_buffer)
+
+ if (!STRINGP (start))
{
- XSETFASTINT (start, BEGV);
- XSETFASTINT (end, ZV);
+ annotations = build_annotations (start, end);
+
+ if (current_buffer != given_buffer)
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
+ }
+
+ UNGCPRO;
+
+ GCPRO5 (start, filename, annotations, visit_file, lockname);
+
+ /* Decide the coding-system to encode the data with.
+ We used to make this choice before calling build_annotations, but that
+ leads to problems when a write-annotate-function takes care of
+ unsavable chars (as was the case with X-Symbol). */
+ choose_write_coding_system (start, end, filename,
+ append, visit, lockname, &coding);
+ Vlast_coding_system_used = coding.symbol;
+
+ given_buffer = current_buffer;
+ if (! STRINGP (start))
+ {
+ annotations = build_annotations_2 (start, end,
+ coding.pre_write_conversion, annotations);
+ if (current_buffer != given_buffer)
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
}
#ifdef CLASH_DETECTION
encoded_filename = ENCODE_FILE (filename);
- fn = XSTRING (encoded_filename)->data;
+ fn = SDATA (encoded_filename);
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
- ? XSTRING (current_buffer->filename)->data : 0,
+ ? SDATA (current_buffer->filename) : 0,
fn);
}
else /* Write to temporary name and rename if no errors */
{
temp_name = Fmake_temp_name (concat2 (temp_name,
build_string ("$$SAVE$$")));
- fname = XSTRING (filename)->data;
- fn = XSTRING (temp_name)->data;
+ fname = SDATA (filename);
+ fn = SDATA (temp_name);
desc = creat_copy_attrs (fname, fn);
if (desc < 0)
{
if (STRINGP (start))
{
- failure = 0 > a_write (desc, start, 0, XSTRING (start)->size,
+ failure = 0 > a_write (desc, start, 0, SCHARS (start),
&annotations, &coding);
save_errno = errno;
}
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s", XSTRING (filename)->data,
+ error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
if (visiting)
as save-excursion would do. */
static Lisp_Object
-build_annotations (start, end, pre_write_conversion)
- Lisp_Object start, end, pre_write_conversion;
+build_annotations (start, end)
+ Lisp_Object start, end;
{
Lisp_Object annotations;
Lisp_Object p, res;
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
- while (!NILP (p))
+ while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
Vwrite_region_annotations_so_far = annotations;
- res = call2 (Fcar (p), start, end);
+ res = call2 (XCAR (p), start, end);
/* If the function makes a different buffer current,
assume that means this buffer contains altered text to be output.
Reset START and END from the buffer bounds
}
Flength (res); /* Check basic validity of return value */
annotations = merge (annotations, res, Qcar_less_than_car);
- p = Fcdr (p);
+ p = XCDR (p);
}
/* Now do the same for annotation functions implied by the file-format */
p = Vauto_save_file_format;
else
p = current_buffer->file_format;
- for (i = 0; !NILP (p); p = Fcdr (p), ++i)
+ for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
/* Value is either a list of annotations or nil if the function
has written annotations to a temporary buffer, which is now
current. */
- res = call5 (Qformat_annotate_function, Fcar (p), start, end,
+ res = call5 (Qformat_annotate_function, XCAR (p), start, end,
original_buffer, make_number (i));
if (current_buffer != given_buffer)
{
annotations = merge (annotations, res, Qcar_less_than_car);
}
+ UNGCPRO;
+ return annotations;
+}
+
+static Lisp_Object
+build_annotations_2 (start, end, pre_write_conversion, annotations)
+ Lisp_Object start, end, pre_write_conversion, annotations;
+{
+ struct gcpro gcpro1;
+ Lisp_Object res;
+
+ GCPRO1 (annotations);
/* At last, do the same for the function PRE_WRITE_CONVERSION
implied by the current coding-system. */
if (!NILP (pre_write_conversion))
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding))
+ if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
return -1;
}
*annot = Fcdr (*annot);
if (STRINGP (string))
{
- addr = XSTRING (string)->data;
- nbytes = STRING_BYTES (XSTRING (string));
+ addr = SDATA (string);
+ nbytes = SBYTES (string);
coding->src_multibyte = STRING_MULTIBYTE (string);
}
else if (start < end)
Lisp_Object handler;
Lisp_Object filename;
- CHECK_BUFFER (buf, 0);
+ CHECK_BUFFER (buf);
b = XBUFFER (buf);
if (!STRINGP (b->filename)) return Qt;
filename = ENCODE_FILE (b->filename);
- if (stat (XSTRING (filename)->data, &st) < 0)
+ if (stat (SDATA (filename), &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
we say that it isn't modified, provided the error is a tame one. */
filename = ENCODE_FILE (filename);
- if (stat (XSTRING (filename)->data, &st) >= 0)
+ if (stat (SDATA (filename), &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
args[2] = Ferror_message_string (error);
msg = Fformat (3, args);
GCPRO1 (msg);
- nbytes = STRING_BYTES (XSTRING (msg));
+ nbytes = SBYTES (msg);
for (i = 0; i < 3; ++i)
{
if (i == 0)
- message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
else
- message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
Fsleep_for (make_number (1), Qnil);
}
/* Get visited file's mode to become the auto save file's mode. */
if (! NILP (current_buffer->filename)
- && stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
+ && stat (SDATA (current_buffer->filename), &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = st.st_mode | 0600;
else
Lisp_Object oquit;
FILE *stream;
Lisp_Object lispstream;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
- int message_p = push_message ();
+ int message_p = 0;
+
+ if (max_specpdl_size < specpdl_size + 40)
+ max_specpdl_size = specpdl_size + 40;
+
+ if (minibuf_level)
+ no_message = Qt;
+
+ if (NILP (no_message));
+ message_p = push_message ();
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
/* No GCPRO needed, because (when it matters) all Lisp_Object variables
point to non-strings reached from Vbuffer_alist. */
- if (minibuf_level)
- no_message = Qt;
-
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("auto-save-hook"));
call2 (Qmake_directory, dir, Qt);
}
- stream = fopen (XSTRING (listfile)->data, "w");
+ stream = fopen (SDATA (listfile), "w");
if (stream != NULL)
{
/* Arrange to close that file whether or not we get an error.
{
if (!NILP (b->filename))
{
- fwrite (XSTRING (b->filename)->data, 1,
- STRING_BYTES (XSTRING (b->filename)), stream);
+ fwrite (SDATA (b->filename), 1,
+ SBYTES (b->filename), stream);
}
putc ('\n', stream);
- fwrite (XSTRING (b->auto_save_file_name)->data, 1,
- STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);
+ fwrite (SDATA (b->auto_save_file_name), 1,
+ SBYTES (b->auto_save_file_name), stream);
putc ('\n', stream);
}
{
/* It has shrunk too much; turn off auto-saving here. */
minibuffer_auto_raise = orig_minibuffer_auto_raise;
- message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
+ message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
b->name, 1);
minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
double_dollars (val)
Lisp_Object val;
{
- register unsigned char *old, *new;
+ register const unsigned char *old;
+ register unsigned char *new;
register int n;
int osize, count;
- osize = STRING_BYTES (XSTRING (val));
+ osize = SBYTES (val);
/* Count the number of $ characters. */
- for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
+ for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
- old = XSTRING (val)->data;
- val = make_uninit_multibyte_string (XSTRING (val)->size + count,
+ old = SDATA (val);
+ val = make_uninit_multibyte_string (SCHARS (val) + count,
osize + count);
- new = XSTRING (val)->data;
+ new = SDATA (val);
for (n = osize; n > 0; n--)
if (*old != '$')
*new++ = *old++;
return val;
}
+static Lisp_Object
+read_file_name_cleanup (arg)
+ Lisp_Object arg;
+{
+ return (current_buffer->directory = arg);
+}
+
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
3, 3, 0,
doc: /* Internal subroutine for read-file-name. Do not call this. */)
int changed;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
realdir = dir;
name = string;
/* No need to protect ACTION--we only compare it with t and nil. */
GCPRO5 (string, realdir, name, specdir, orig_string);
- if (XSTRING (string)->size == 0)
+ if (SCHARS (string) == 0)
{
if (EQ (action, Qlambda))
{
UNGCPRO;
if (EQ (action, Qt))
- return Ffile_name_all_completions (name, realdir);
+ {
+ Lisp_Object all = Ffile_name_all_completions (name, realdir);
+ Lisp_Object comp;
+ int count;
+
+ if (NILP (Vread_file_name_predicate)
+ || EQ (Vread_file_name_predicate, Qfile_exists_p))
+ return all;
+
+#ifndef VMS
+ if (EQ (Vread_file_name_predicate, Qfile_directory_p))
+ {
+ /* Brute-force speed up for directory checking:
+ Discard strings which don't end in a slash. */
+ for (comp = Qnil; CONSP (all); all = XCDR (all))
+ {
+ Lisp_Object tem = XCAR (all);
+ int len;
+ if (STRINGP (tem) &&
+ (len = SCHARS (tem), len > 0) &&
+ IS_DIRECTORY_SEP (SREF (tem, len-1)))
+ comp = Fcons (tem, comp);
+ }
+ }
+ else
+#endif
+ {
+ /* Must do it the hard (and slow) way. */
+ GCPRO3 (all, comp, specdir);
+ count = SPECPDL_INDEX ();
+ record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
+ current_buffer->directory = realdir;
+ for (comp = Qnil; CONSP (all); all = XCDR (all))
+ if (!NILP (call1 (Vread_file_name_predicate, XCAR (all))))
+ comp = Fcons (XCAR (all), comp);
+ unbind_to (count, Qnil);
+ UNGCPRO;
+ }
+ return Fnreverse (comp);
+ }
+
/* Only other case actually used is ACTION = lambda */
#ifdef VMS
/* Supposedly this helps commands such as `cd' that read directory names,
but can someone explain how it helps them? -- RMS */
- if (XSTRING (name)->size == 0)
+ if (SCHARS (name) == 0)
return Qt;
#endif /* VMS */
+ if (!NILP (Vread_file_name_predicate))
+ return call1 (Vread_file_name_predicate, string);
return Ffile_exists_p (string);
}
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
+DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
Default name to DEFAULT-FILENAME if user enters a null string.
Fourth arg MUSTMATCH non-nil means require existing file's name.
Non-nil and non-t means also require confirmation after completion.
Fifth arg INITIAL specifies text to start with.
+If optional sixth arg PREDICATE is non-nil, possible completions and the
+resulting file name must satisfy (funcall PREDICATE NAME).
DIR defaults to current buffer's directory default.
If this command was invoked with the mouse, use a file dialog box if
`use-dialog-box' is non-nil, and the window system or X toolkit in use
provides a file dialog box. */)
- (prompt, dir, default_filename, mustmatch, initial)
- Lisp_Object prompt, dir, default_filename, mustmatch, initial;
+ (prompt, dir, default_filename, mustmatch, initial, predicate)
+ Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
{
Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
#endif
if (homedir != 0
&& STRINGP (dir)
- && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
+ && !strncmp (homedir, SDATA (dir), strlen (homedir))
+ && IS_DIRECTORY_SEP (SREF (dir, strlen (homedir))))
{
- dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
- XSTRING (dir)->data[0] = '~';
+ dir = make_string (SDATA (dir) + strlen (homedir) - 1,
+ SBYTES (dir) - strlen (homedir) + 1);
+ SSET (dir, 0, '~');
}
/* Likewise for default_filename. */
if (homedir != 0
&& STRINGP (default_filename)
- && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
+ && !strncmp (homedir, SDATA (default_filename), strlen (homedir))
+ && IS_DIRECTORY_SEP (SREF (default_filename, 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] = '~';
+ = make_string (SDATA (default_filename) + strlen (homedir) - 1,
+ SBYTES (default_filename) - strlen (homedir) + 1);
+ SSET (default_filename, 0, '~');
}
if (!NILP (default_filename))
{
- CHECK_STRING (default_filename, 3);
+ CHECK_STRING (default_filename);
default_filename = double_dollars (default_filename);
}
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- pos = make_number (XSTRING (double_dollars (dir))->size);
+ pos = make_number (SCHARS (double_dollars (dir)));
insdef = Fcons (double_dollars (insdef), pos);
}
else
else
insdef = Qnil;
- count = specpdl_ptr - specpdl;
+ if (!NILP (Vread_file_name_function))
+ {
+ Lisp_Object args[7];
+
+ GCPRO2 (insdef, default_filename);
+ args[0] = Vread_file_name_function;
+ args[1] = prompt;
+ args[2] = dir;
+ args[3] = default_filename;
+ args[4] = mustmatch;
+ args[5] = initial;
+ args[6] = predicate;
+ RETURN_UNGCPRO (Ffuncall (7, args));
+ }
+
+ count = SPECPDL_INDEX ();
#ifdef VMS
specbind (intern ("completion-ignore-case"), Qt);
#endif
specbind (intern ("minibuffer-completing-file-name"), Qt);
+ specbind (intern ("read-file-name-predicate"),
+ (NILP (predicate) ? Qfile_exists_p : predicate));
GCPRO2 (insdef, default_filename);
/* If DIR contains a file name, split it. */
Lisp_Object file;
file = Ffile_name_nondirectory (dir);
- if (XSTRING (file)->size && NILP (default_filename))
+ if (SCHARS (file) && NILP (default_filename))
{
default_filename = file;
dir = Ffile_name_directory (dir);
if (!NILP (tem) && !NILP (default_filename))
val = default_filename;
- else if (XSTRING (val)->size == 0 && NILP (insdef))
+ else if (SCHARS (val) == 0 && NILP (insdef))
{
if (!NILP (default_filename))
val = default_filename;
DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
doc: /* *Coding system for encoding file names.
-If it is nil, default-file-name-coding-system (which see) is used. */);
+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,
doc: /* Default coding system for encoding file names.
-This variable is used only when file-name-coding-system is nil.
+This variable is used only when `file-name-coding-system' is nil.
-This variable is set/changed by the command set-language-environment.
+This variable is set/changed by the command `set-language-environment'.
User should not set this variable manually,
-instead use file-name-coding-system to get a constant encoding
+instead use `file-name-coding-system' to get a constant encoding
of file names regardless of the current language environment. */);
Vdefault_file_name_coding_system = Qnil;
Fput (Qfile_date_error, Qerror_message,
build_string ("Cannot set file date"));
+ DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function,
+ doc: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
+ Vread_file_name_function = Qnil;
+
+ DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate,
+ doc: /* Current predicate used by `read-file-name-internal'. */);
+ Vread_file_name_predicate = Qnil;
+
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
insert_default_directory = 1;
The value should be either ?/ or ?\\ (any other value is treated as ?\\).
This variable affects the built-in functions only on Windows,
on other platforms, it is initialized so that Lisp code can find out
-what the normal separator is.
-
-WARNING: This variable is deprecated and will be removed in the near
-future. DO NOT USE IT. */);
+what the normal separator is. */);
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
inserted at the specified positions of the file being written (1 means to
insert before the first byte written). The POSITIONs must be sorted into
increasing order. If there are several functions in the list, the several
-lists are merged destructively. */);
+lists are merged destructively. Alternatively, the function can return
+with a different buffer current and value nil.*/);
Vwrite_region_annotate_functions = Qnil;
DEFVAR_LISP ("write-region-annotations-so-far",