/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
+ 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* for euidaccess */
-
#include <config.h>
-#if defined (USG5) || defined (BSD_SYSTEM) || defined (GNU_LINUX)
+#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#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 "commands.h"
extern int use_dialog_box;
+extern int use_file_dialog;
#ifndef O_WRONLY
#define O_WRONLY 1
a new file with the same mode as the original */
int auto_save_mode_bits;
+/* The symbol bound to coding-system-for-read when
+ insert-file-contents is called for recovering a file. This is not
+ an actual coding system name, but just an indicator to tell
+ insert-file-contents to use `emacs-mule' with a special flag for
+ auto saving and recovering a file. */
+Lisp_Object Qauto_save_coding;
+
/* Coding system for file names, or nil if none. */
Lisp_Object Vfile_name_coding_system;
whose I/O is done with a special handler. */
Lisp_Object Vfile_name_handler_alist;
-/* Format for auto-save files */
-Lisp_Object Vauto_save_file_format;
-
/* Lisp functions for translating file formats */
Lisp_Object Qformat_decode, Qformat_annotate_function;
/* Functions to be called to process text properties in inserted file. */
Lisp_Object Vafter_insert_file_functions;
+/* Lisp function for setting buffer-file-coding-system and the
+ multibyteness of the current buffer after inserting a file. */
+Lisp_Object Qafter_insert_file_set_coding;
+
/* Functions to be called to create text property annotations for file. */
Lisp_Object Vwrite_region_annotate_functions;
+Lisp_Object Qwrite_region_annotate_functions;
/* During build_annotations, each time an annotation function is called,
this holds the annotations made by the previous functions. */
/* 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 completion ignores case when reading file name. */
+int read_file_name_completion_ignore_case;
+
/* 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 Qfile_accessible_directory_p;
Lisp_Object Qfile_modes;
Lisp_Object Qset_file_modes;
+Lisp_Object Qset_file_times;
Lisp_Object Qfile_newer_than_file_p;
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
(filename)
Lisp_Object filename;
{
+#ifndef DOS_NT
+ register const unsigned char *beg;
+#else
register unsigned char *beg;
- register unsigned char *p;
+#endif
+ register const unsigned char *p;
Lisp_Object handler;
CHECK_STRING (filename);
#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
CORRECT_DIR_SEPS (beg);
#endif /* DOS_NT */
- if (STRING_MULTIBYTE (filename))
- return make_string (beg, p - beg);
- return make_unibyte_string (beg, p - beg);
+ return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
(filename)
Lisp_Object filename;
{
- register unsigned char *beg, *p, *end;
+ register const unsigned char *beg, *p, *end;
Lisp_Object handler;
CHECK_STRING (filename);
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
)
p--;
- if (STRING_MULTIBYTE (filename))
- return make_string (p, end - p);
- return make_unibyte_string (p, end - p);
+ return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
}
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
/* 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'
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);
+ file_name_as_directory (buf, SDATA (file));
+ return make_specified_string (buf, -1, strlen (buf),
+ STRING_MULTIBYTE (file));
}
\f
/*
/* 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);
- return build_string (buf);
+ directory_file_name (SDATA (directory), buf);
+ return make_specified_string (buf, -1, strlen (buf),
+ STRING_MULTIBYTE (directory));
}
static char make_temp_name_tbl[64] =
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
/* Value is a temporary file name starting with PREFIX, a string.
-
+
The Emacs process number forms part of the result, so there is
no danger of generating a name being used by another process.
In addition, this function makes an attempt to choose a name
which has no existing file. To make this work, PREFIX should be
an absolute file name.
-
+
BASE64_P non-zero means add the pid as 3 characters in base64
encoding. In this case, 6 characters will be added to PREFIX to
form the file name. Otherwise, if Emacs is running on a system
int base64_p;
{
Lisp_Object val;
- int len;
+ int len, clen;
int pid;
unsigned char *p, *data;
char pidbuf[20];
int pidlen;
-
+
CHECK_STRING (prefix);
/* VAL is created by adding 6 characters to PREFIX. The first
pidlen = 3;
#endif
}
-
- len = XSTRING (prefix)->size;
- val = make_uninit_string (len + 3 + pidlen);
- data = XSTRING (val)->data;
- bcopy(XSTRING (prefix)->data, data, len);
+
+ len = SBYTES (prefix); clen = SCHARS (prefix);
+ val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
+ if (!STRING_MULTIBYTE (prefix))
+ STRING_SET_UNIBYTE (val);
+ data = SDATA (val);
+ bcopy(SDATA (prefix), data, len);
p = data + len;
bcopy (pidbuf, p, pidlen);
}
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 is_escaped = 0;
#endif /* DOS_NT */
int length;
- Lisp_Object handler;
+ Lisp_Object handler, result;
CHECK_STRING (name);
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
&& IS_DIRECTORY_SEP (p[0])
&& IS_DIRECTORY_SEP (p[1]))
lose = 1;
-
+
#ifdef VMS
if (p[0] == '\\')
lose = 1;
{
#ifdef VMS
if (index (nm, '/'))
- return build_string (sys_translate_unix (nm));
+ {
+ nm = sys_translate_unix (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
+ }
#endif /* VMS */
#ifdef DOS_NT
/* Make sure directories are all separated with / or \ as
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
- if (strcmp (nm, XSTRING (name)->data) != 0)
- name = build_string (nm);
+ if (strcmp (nm, SDATA (name)) != 0)
+ name = make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
}
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] = ':';
+ char temp[] = " :";
+
+ name = make_specified_string (nm, -1, p - nm,
+ STRING_MULTIBYTE (name));
+ temp[0] = DRIVE_LETTER (drive);
+ name = concat2 (build_string (temp), name);
}
return name;
#else /* not DOS_NT */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
- return build_string (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
#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] == ':')
absolute directory in nm produces "//", which will then be
incorrectly treated as a network share. Ignore newdir in
this case (keeping the drive letter). */
- if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
+ if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
&& newdir[1] == '\0'))
#endif
strcpy (target, newdir);
CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
- return make_string (target, o - target);
+ result = make_specified_string (target, -1, o - target,
+ STRING_MULTIBYTE (name));
+
+ /* Again look to see if the file name has special constructs in it
+ and perhaps call the corresponding file handler. This is needed
+ for filenames such as "/foo/../user@host:/bar/../baz". Expanding
+ the ".." component gives us "/user@host:/bar/../baz" which needs
+ to be expanded again. */
+ handler = Ffind_file_name_handler (result, Qexpand_file_name);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, result, default_directory);
+
+ return result;
}
#if 0
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);
- newdir = XSTRING (defalt)->data;
+ 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);
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. */
for (p = nm; p != endp; p++)
{
if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT)
- /* // at start of file name is meaningful in Apollo and
- WindowsNT systems. */
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
+ /* // at start of file name is meaningful in Apollo,
+ WindowsNT and Cygwin systems. */
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
-#else /* not (APOLLO || WINDOWSNT) */
+#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT) */
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
)
&& p != nm
&& (0
#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 */
}
#ifdef VMS
- return build_string (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (filename));
#else
/* See if any variables are substituted into the string
/* 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 */
for (p = xnm; p != x; p++)
if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT)
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
-#else /* not (APOLLO || WINDOWSNT) */
+#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT) */
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
)
&& p != xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
xnm = p;
#endif
- if (STRING_MULTIBYTE (filename))
- return make_string (xnm, x - xnm);
- return make_unibyte_string (xnm, x - xnm);
+ return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
badsubst:
error ("Bad format environment-variable substitution");
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 (lstat (SDATA (encoded_filename), &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);
+ tem = format2 ("File %s already exists; %s anyway? ",
+ absname, build_string (querystring));
if (quick)
tem = Fy_or_n_p (tem);
else
This is what happens in interactive use with M-x.
Fourth arg KEEP-TIME non-nil means give the new file the same
last-modified time as the old one. (This works on only some systems.)
-A prefix arg makes KEEP-TIME non-nil. */)
+A prefix arg makes KEEP-TIME non-nil.
+Also set the file modes of the target file to match the source file. */)
(file, newname, ok_if_already_exists, keep_time)
Lisp_Object file, newname, ok_if_already_exists, keep_time;
{
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;
CHECK_STRING (newname);
if (!NILP (Ffile_directory_p (newname)))
- newname = Fexpand_file_name (file, newname);
+ newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
else
newname = Fexpand_file_name (newname, Qnil);
|| 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)));
+ /* CopyFile retains the timestamp by default. */
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);
+ immediate_quit = 1;
+ ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
+ immediate_quit = 0;
+
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
#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;
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
- doc: /* Delete the directory named DIRECTORY. */)
+ doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
(directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
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));
}
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
- doc: /* Delete file named FILENAME.
+ doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
If file has multiple names, it continues to exist with the other names. */)
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
Lisp_Object encoded_file;
+ struct gcpro gcpro1;
- CHECK_STRING (filename);
+ GCPRO1 (filename);
+ if (!NILP (Ffile_directory_p (filename))
+ && NILP (Ffile_symlink_p (filename)))
+ Fsignal (Qfile_error,
+ Fcons (build_string ("Removing old name: is a directory"),
+ Fcons (filename, Qnil)));
+ UNGCPRO;
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;
}
Lisp_Object args[2];
#endif
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- Lisp_Object encoded_file, encoded_newname;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ Lisp_Object encoded_file, encoded_newname, symlink_target;
- encoded_file = encoded_newname = Qnil;
- GCPRO4 (file, newname, encoded_file, encoded_newname);
+ symlink_target = encoded_file = encoded_newname = Qnil;
+ GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
CHECK_STRING (file);
CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
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)
{
- Fcopy_file (file, newname,
- /* We have already prompted if it was an integer,
- so don't have copy-file prompt again. */
- NILP (ok_if_already_exists) ? Qnil : Qt, Qt);
+#ifdef S_IFLNK
+ symlink_target = Ffile_symlink_p (file);
+ if (! NILP (symlink_target))
+ Fmake_symbolic_link (symlink_target, newname,
+ NILP (ok_if_already_exists) ? Qnil : Qt);
+ else
+#endif
+ Fcopy_file (file, newname,
+ /* We have already prompted if it was an integer,
+ so don't have copy-file prompt again. */
+ NILP (ok_if_already_exists) ? Qnil : Qt, Qt);
Fdelete_file (file);
}
else
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;
/* 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;
{
CHECK_STRING (name);
if (NILP (string))
- delete_logical_name (XSTRING (name)->data);
+ delete_logical_name (SDATA (name));
else
{
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;
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);
- ptr = XSTRING (filename)->data;
+ ptr = SDATA (filename);
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
#ifdef VMS
/* ??? This criterion is probably wrong for '<'. */
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,
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,
#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);
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
}
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;
\f
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
-The value is the name of the file to which it is linked.
+The value is the link target, as a string.
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);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
+#ifdef S_IFLNK
+ {
+ char *buf;
+ int bufsize;
+ int valsize;
+ Lisp_Object val;
+
filename = ENCODE_FILE (filename);
bufsize = 50;
bufsize *= 2;
buf = (char *) xrealloc (buf, bufsize);
bzero (buf, bufsize);
-
+
errno = 0;
- valsize = readlink (XSTRING (filename)->data, buf, bufsize);
+ valsize = readlink (SDATA (filename), buf, bufsize);
if (valsize == -1)
{
#ifdef ERANGE
}
}
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 /* not S_IFLNK */
return Qnil;
#endif /* not S_IFLNK */
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;
}
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
- /* It's an unlikely combination, but yes we really do need to gcpro:
- Suppose that file-accessible-directory-p has no handler, but
- file-directory-p does have a handler; this handler causes a GC which
- relocates the string in `filename'; and finally file-directory-p
- returns non-nil. Then we would end up passing a garbaged string
- to file-executable-p. */
GCPRO1 (filename);
tem = (NILP (Ffile_directory_p (filename))
|| NILP (Ffile_executable_p (filename)));
/* 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
}
\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
- doc: /* Return mode bits of file named FILENAME, as an integer. */)
+ doc: /* Return mode bits of file named FILENAME, as an integer.
+Return nil, if file does not exist or is not accessible. */)
(filename)
Lisp_Object filename;
{
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 */
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;
XSETINT (value, (~ realmask) & 0777);
return value;
}
+\f
+extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
+
+DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
+ doc: /* Set times of file FILENAME to TIME.
+Set both access and modification times.
+Return t on success, else nil.
+Use the current time if TIME is nil. TIME is in the format of
+`current-time'. */)
+ (filename, time)
+ Lisp_Object filename, time;
+{
+ Lisp_Object absname, encoded_absname;
+ Lisp_Object handler;
+ time_t sec;
+ int usec;
+
+ if (! lisp_time_argument (time, &sec, &usec))
+ error ("Invalid time specification");
+
+ absname = Fexpand_file_name (filename, current_buffer->directory);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (absname, Qset_file_times);
+ if (!NILP (handler))
+ return call3 (handler, Qset_file_times, absname, time);
+
+ encoded_absname = ENCODE_FILE (absname);
+
+ {
+ EMACS_TIME t;
+
+ EMACS_SET_SECS (t, sec);
+ EMACS_SET_USECS (t, usec);
+ if (set_file_times (SDATA (encoded_absname), t, t))
+ {
+#ifdef DOS_NT
+ struct stat st;
+
+ /* Setting times on a directory always fails. */
+ if (stat (SDATA (encoded_absname), &st) == 0
+ && (st.st_mode & S_IFMT) == S_IFDIR)
+ return Qnil;
+#endif
+ report_file_error ("Setting file times", Fcons (absname, Qnil));
+ return Qnil;
+ }
+ }
+
+ return Qt;
+}
\f
#ifdef __NetBSD__
#define unix 42
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;
read_non_regular ()
{
int nbytes;
-
+
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);
immediate_quit = 0;
return make_number (nbytes);
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
doc: /* Insert contents of file FILENAME after point.
-Returns list of absolute file name and number of bytes inserted.
+Returns list of absolute file name and number of characters inserted.
If second argument VISIT is non-nil, the buffer's visited filename
and last save file modtime are set, and it is marked unmodified.
If visiting and the file does not exist, visiting is completed
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;
/* 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. */
record_unwind_protect (close_file_unwind, make_number (fd));
/* Supposedly happens on VMS. */
+ /* Can happen on any platform that uses long as type of off_t, but allows
+ file sizes to exceed 2Gb. VMS is no longer officially supported, so
+ give a message suitable for the latter case. */
if (! not_regular && st.st_size < 0)
- error ("File size is negative");
+ error ("Maximum buffer size exceeded");
/* Prevent redisplay optimizations. */
current_buffer->clip_changed = 1;
}
}
- if (BEG < Z)
+ if (EQ (Vcoding_system_for_read, Qauto_save_coding))
+ {
+ /* We use emacs-mule for auto saving... */
+ setup_coding_system (Qemacs_mule, &coding);
+ /* ... but with the special flag to indicate to read in a
+ multibyte sequence for eight-bit-control char as is. */
+ coding.flags = 1;
+ coding.src_multibyte = 0;
+ coding.dst_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
+ coding.eol_type = CODING_EOL_LF;
+ coding_system_decided = 1;
+ }
+ else if (BEG < Z)
{
/* Decide the coding system to use for reading the file now
because we can't use an optimized method for handling
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*");
-
- set_buffer_internal (XBUFFER (Vstandard_output));
- current_buffer->enable_multibyte_characters = Qnil;
+ buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
+ buf = XBUFFER (buffer);
+
+ delete_all_overlays (buf);
+ buf->directory = current_buffer->directory;
+ buf->read_only = Qnil;
+ buf->filename = Qnil;
+ buf->undo_list = Qt;
+ eassert (buf->overlays_before == NULL);
+ eassert (buf->overlays_after == NULL);
+
+ set_buffer_internal (buf);
+ Ferase_buffer ();
+ buf->enable_multibyte_characters = Qnil;
+
insert_1_both (read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
val = call2 (Vset_auto_coding_function,
filename, make_number (nread));
set_buffer_internal (prev);
- /* Remove the binding for standard-output. */
- unbind_to (count1, Qnil);
-
/* Discard the unwind protect for recovering the
current buffer. */
specpdl_ptr--;
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;
}
-
+
/* Scan this bufferful from the end, comparing with
the Emacs buffer. */
bufpos = total_read;
-
+
/* Compare with same_at_start to avoid counting some buffer text
as matching both at the file's beginning and at the end. */
while (bufpos > 0 && same_at_end > same_at_start
if (how_much < 0)
{
xfree (conversion_buffer);
-
+ coding_free_composition_data (&coding);
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");
}
if (bufpos == inserted)
{
xfree (conversion_buffer);
+ coding_free_composition_data (&coding);
emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
we are taking from the file. */
- inserted -= (Z_BYTE - same_at_end) + (same_at_start - BEG_BYTE);
+ inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
if (same_at_end != same_at_start)
{
}
/* Insert from the file at the proper position. */
SET_PT_BOTH (temp, same_at_start);
- insert_1 (conversion_buffer + same_at_start - BEG_BYTE, inserted,
+ insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted,
0, 0, 0);
if (coding.cmp_data && coding.cmp_data->used)
coding_restore_composition (&coding, Fcurrent_buffer ());
coding_free_composition_data (&coding);
-
+
/* Set `inserted' to the number of inserted characters. */
inserted = PT - temp;
before exiting the loop, it is set to a negative value if I/O
error occurs. */
how_much = 0;
-
+
/* Total bytes inserted. */
inserted = 0;
-
+
/* Here, we don't do code conversion in the loop. It is done by
code_convert_region after all data are read into the buffer. */
{
int gap_size = GAP_SIZE;
-
+
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
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 (this <= 0)
{
how_much = this;
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,
inserted);
}
+ /* Now INSERTED is measured in characters. */
+
#ifdef DOS_NT
/* Use the conversion type to determine buffer-file-type
(find-buffer-file-type is now used to help determine the
conversion). */
- if ((coding.eol_type == CODING_EOL_UNDECIDED
+ if ((coding.eol_type == CODING_EOL_UNDECIDED
|| coding.eol_type == CODING_EOL_LF)
&& ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
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))
Fcons (orig_filename, Qnil)));
}
+ if (set_coding_system)
+ Vlast_coding_system_used = coding.symbol;
+
+ if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
+ {
+ insval = call1 (Qafter_insert_file_set_coding, make_number (inserted));
+ if (! NILP (insval))
+ {
+ CHECK_NUMBER (insval);
+ inserted = XFASTINT (insval);
+ }
+ }
+
/* Decode file format */
if (inserted > 0)
{
int empty_undo_list_p = 0;
-
+
/* If we're anyway going to discard undo information, don't
record it in the first place. The buffer's undo list at this
point is either nil or t when visiting a file. */
empty_undo_list_p = NILP (current_buffer->undo_list);
current_buffer->undo_list = Qt;
}
-
+
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
-
+
if (!NILP (visit))
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
- if (set_coding_system)
- Vlast_coding_system_used = coding.symbol;
-
/* Call after-change hooks for the inserted text, aside from the case
of normal visiting (not with REPLACE), which is done in a new buffer
"before" the buffer is changed. */
}
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);
inserted = XFASTINT (insval);
}
QUIT;
- p = Fcdr (p);
+ p = XCDR (p);
}
if (!NILP (visit)
{
Lisp_Object val;
- if (auto_saving)
- val = Qnil;
+ if (auto_saving
+ && NILP (Fstring_equal (current_buffer->filename,
+ current_buffer->auto_save_file_name)))
+ {
+ /* We use emacs-mule for auto saving... */
+ setup_coding_system (Qemacs_mule, coding);
+ /* ... but with the special flag to indicate not to strip off
+ leading code of eight-bit-control chars. */
+ coding->flags = 1;
+ goto done_setup_coding;
+ }
else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
+ {
+ val = Vcoding_system_for_write;
+ if (coding_system_require_warning
+ && !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, Fcons (Qt, Fcons (val, Qnil)),
+ Qnil, filename);
+ }
else
{
/* If the variable `buffer-file-coding-system' is set locally,
if (NILP (current_buffer->enable_multibyte_characters))
force_raw_text = 1;
}
-
+
if (NILP (val))
{
/* Check file-coding-system-alist. */
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);
+ 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
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.
-Optional fifth argument VISIT if t means
+Optional fifth argument VISIT, if t or a string, means
set the last-save-file-modtime of buffer to this file's modtime
and mark buffer not modified.
If VISIT is a string, it is a second file name;
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
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) */
return val;
}
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+
/* Special kludge to simplify auto-saving. */
if (NILP (start))
{
XSETFASTINT (start, BEG);
XSETFASTINT (end, Z);
+ Fwiden ();
}
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
- count1 = specpdl_ptr - specpdl;
+ count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
- annotations = build_annotations (start, end);
- 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;
Vlast_coding_system_used = coding.symbol;
given_buffer = current_buffer;
- annotations = build_annotations_2 (start, end,
- coding.pre_write_conversion, annotations);
- if (current_buffer != given_buffer)
+ if (! STRINGP (start))
{
- XSETFASTINT (start, BEGV);
- XSETFASTINT (end, ZV);
+ 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 (!NILP (append) && !NILP (Ffile_regular_p (filename)))
{
long ret;
-
+
if (NUMBERP (append))
ret = lseek (desc, XINT (append), 1);
else
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
}
-
+
UNGCPRO;
#ifdef VMS
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)
update_mode_lines++;
}
else if (quietly)
- return Qnil;
+ {
+ if (auto_saving
+ && ! NILP (Fstring_equal (current_buffer->filename,
+ current_buffer->auto_save_file_name)))
+ SAVE_MODIFF = MODIFF;
+
+ return Qnil;
+ }
if (!auto_saving)
- message_with_string ("Wrote %s", visit_file, 1);
+ message_with_string ((INTEGERP (append)
+ ? "Updated %s"
+ : ! NILP (append)
+ ? "Added to %s"
+ : "Wrote %s"),
+ visit_file, 1);
return Qnil;
}
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
- int i;
+ int i, used_global = 0;
XSETBUFFER (original_buffer, current_buffer);
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
- while (!NILP (p))
+ while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
+ if (EQ (Qt, XCAR (p)) && !used_global)
+ { /* Use the global value of the hook. */
+ Lisp_Object arg[2];
+ used_global = 1;
+ arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
+ arg[1] = XCDR (p);
+ p = Fappend (2, arg);
+ continue;
+ }
Vwrite_region_annotations_so_far = annotations;
- res = call2 (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 */
- if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
- p = Vauto_save_file_format;
+ if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
+ p = current_buffer->auto_save_file_format;
else
p = current_buffer->file_format;
- for (i = 0; !NILP (p); p = Fcdr (p), ++i)
+ for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
-
+
Vwrite_region_annotations_so_far = annotations;
/* 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)
{
XSETFASTINT (end, ZV);
annotations = Qnil;
}
-
+
if (CONSP (res))
annotations = merge (annotations, res, Qcar_less_than_car);
}
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)
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
Sverify_visited_file_modtime, 1, 1, 0,
doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
-This means that the file has not been changed since it was visited or saved. */)
+This means that the file has not been changed since it was visited or saved.
+See Info node `(elisp)Modification Time' for more details. */)
(buf)
Lisp_Object buf;
{
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. */
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
doc: /* Return the current buffer's recorded visited file modification time.
-The value is a list of the form (HIGH . LOW), like the time values
-that `file-attributes' returns. */)
+The value is a list of the form (HIGH LOW), like the time values
+that `file-attributes' returns. If the current buffer has no recorded
+file modification time, this function returns 0.
+See Info node `(elisp)Modification Time' for more details. */)
()
{
- return long_to_cons ((unsigned long) current_buffer->modtime);
+ Lisp_Object tcons;
+ tcons = long_to_cons ((unsigned long) current_buffer->modtime);
+ if (CONSP (tcons))
+ return list2 (XCAR (tcons), XCDR (tcons));
+ return tcons;
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
filename = ENCODE_FILE (filename);
- if (stat (XSTRING (filename)->data, &st) >= 0)
+ if (stat (SDATA (filename), &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
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));
+ 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);
}
auto_save_1 ()
{
struct stat st;
+ Lisp_Object modes;
+
+ auto_save_mode_bits = 0666;
/* 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)
- /* But make sure we can overwrite it later! */
- auto_save_mode_bits = st.st_mode | 0600;
- else
- auto_save_mode_bits = 0666;
+ if (! NILP (current_buffer->filename))
+ {
+ if (stat (SDATA (current_buffer->filename), &st) >= 0)
+ /* But make sure we can overwrite it later! */
+ auto_save_mode_bits = st.st_mode | 0600;
+ else if ((modes = Ffile_modes (current_buffer->filename),
+ INTEGERP (modes)))
+ /* Remote files don't cooperate with stat. */
+ auto_save_mode_bits = XINT (modes) | 0600;
+ }
return
Fwrite_region (Qnil, Qnil,
if (!NILP (stream))
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
| XFASTINT (XCDR (stream))));
- pop_message ();
return Qnil;
}
return Qnil;
}
+static Lisp_Object
+do_auto_save_make_dir (dir)
+ Lisp_Object dir;
+{
+ return call2 (Qmake_directory, dir, Qt);
+}
+
+static Lisp_Object
+do_auto_save_eh (ignore)
+ Lisp_Object ignore;
+{
+ return Qnil;
+}
+
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
doc: /* Auto-save all buffers that need it.
This is all buffers that have auto-saving enabled
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 = 0;
+ int old_message_p = 0;
+ struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
max_specpdl_size = specpdl_size + 40;
if (minibuf_level)
no_message = Qt;
- if (NILP (no_message));
- message_p = push_message ();
-
+ if (NILP (no_message))
+ {
+ old_message_p = push_message ();
+ record_unwind_protect (pop_message_unwind, Qnil);
+ }
+
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
oquit = Vquit_flag;
if (STRINGP (Vauto_save_list_file_name))
{
Lisp_Object listfile;
-
+
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
/* Don't try to create the directory when shutting down Emacs,
if (!NILP (Vrun_hooks))
{
Lisp_Object dir;
+ dir = Qnil;
+ GCPRO2 (dir, listfile);
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
- call2 (Qmake_directory, dir, Qt);
+ internal_condition_case_1 (do_auto_save_make_dir,
+ dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
+ do_auto_save_eh);
+ UNGCPRO;
}
-
- 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.
minibuffer_auto_raise = 0;
auto_saving = 1;
- /* First, save all files which don't have handlers. If Emacs is
- crashing, the handlers may tweak what is causing Emacs to crash
- in the first place, and it would be a shame if Emacs failed to
- autosave perfectly ordinary files because it couldn't handle some
- ange-ftp'd file. */
+ /* On first pass, save all files that don't have handlers.
+ On second pass, save all files that do have handlers.
+
+ If Emacs is crashing, the handlers may tweak what is causing
+ Emacs to crash in the first place, and it would be a shame if
+ Emacs failed to autosave perfectly ordinary files because it
+ couldn't handle some ange-ftp'd file. */
+
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
{
{
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,
if (auto_saved && NILP (no_message))
{
- if (message_p)
+ if (old_message_p)
{
+ /* If we are going to restore an old message,
+ give time to read ours. */
sit_for (1, 0, 0, 0, 0);
restore_message ();
}
else
+ /* If we displayed a message and then restored a state
+ with no message, leave a "done" message on the screen. */
message1 ("Auto-saving...done");
}
Vquit_flag = oquit;
+ /* This restores the message-stack status. */
unbind_to (count, Qnil);
return Qnil;
}
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. */)
/* 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 */
+ string = Fexpand_file_name (string, dir);
+ if (!NILP (Vread_file_name_predicate))
+ return call1 (Vread_file_name_predicate, string);
return Ffile_exists_p (string);
}
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
+DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
+ Snext_read_file_uses_dialog_p, 0, 0, 0,
+ doc: /* Return t if a call to `read-file-name' will use a dialog.
+The return value is only relevant for a call to `read-file-name' that happens
+before any other event (mouse or keypress) is handeled. */)
+ ()
+{
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && use_dialog_box
+ && use_file_dialog
+ && have_menus_p ())
+ return Qt;
+#endif
+ return Qnil;
+}
+
+DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
doc: /* 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.
+Default name to DEFAULT-FILENAME if user exits the minibuffer with
+the same non-empty string that was inserted by this function.
(If DEFAULT-FILENAME is omitted, the visited file name is used,
except that if INITIAL is specified, that combined with DIR is used.)
+If the user exits with an empty minibuffer, this function returns
+an empty string. (This can only happen if the user erased the
+pre-inserted contents or if `insert-default-directory' is nil.)
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.
-DIR defaults to current buffer's directory default.
+If optional sixth arg PREDICATE is non-nil, possible completions and
+the resulting file name must satisfy (funcall PREDICATE NAME).
+DIR should be an absolute directory name. It defaults to the value of
+`default-directory'.
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;
+provides a file dialog box.
+
+See also `read-file-name-completion-ignore-case'
+and `read-file-name-function'. */)
+ (prompt, dir, default_filename, mustmatch, initial, predicate)
+ Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
{
Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
+ Lisp_Object decoded_homedir;
int replace_in_history = 0;
int add_to_history = 0;
int count;
if (NILP (dir))
dir = current_buffer->directory;
+ if (NILP (Ffile_name_absolute_p (dir)))
+ dir = Fexpand_file_name (dir, Qnil);
if (NILP (default_filename))
- {
- if (! NILP (initial))
- default_filename = Fexpand_file_name (initial, dir);
- else
- default_filename = current_buffer->filename;
- }
+ default_filename
+ = (!NILP (initial)
+ ? Fexpand_file_name (initial, dir)
+ : current_buffer->filename);
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
CORRECT_DIR_SEPS (homedir);
}
#endif
+ if (homedir != 0)
+ decoded_homedir
+ = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
if (homedir != 0
&& STRINGP (dir)
- && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
+ && !strncmp (SDATA (decoded_homedir), SDATA (dir),
+ SBYTES (decoded_homedir))
+ && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
{
- dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
- XSTRING (dir)->data[0] = '~';
+ dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
+ dir = concat2 (build_string ("~"), dir);
}
/* 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 (SDATA (decoded_homedir), SDATA (default_filename),
+ SBYTES (decoded_homedir))
+ && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_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] = '~';
+ = Fsubstring (default_filename,
+ make_number (SCHARS (decoded_homedir)), Qnil);
+ default_filename = concat2 (build_string ("~"), default_filename);
}
if (!NILP (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;
-#ifdef VMS
- specbind (intern ("completion-ignore-case"), Qt);
-#endif
+ if (!NILP (Vread_file_name_function))
+ {
+ Lisp_Object args[7];
+
+ GCPRO2 (insdef, default_filename);
+ args[0] = Vread_file_name_function;
+ args[1] = prompt;
+ args[2] = dir;
+ args[3] = default_filename;
+ args[4] = mustmatch;
+ args[5] = initial;
+ args[6] = predicate;
+ RETURN_UNGCPRO (Ffuncall (7, args));
+ }
+ count = SPECPDL_INDEX ();
+ specbind (intern ("completion-ignore-case"),
+ read_file_name_completion_ignore_case ? Qt : Qnil);
specbind (intern ("minibuffer-completing-file-name"), Qt);
+ specbind (intern ("read-file-name-predicate"),
+ (NILP (predicate) ? Qfile_exists_p : predicate));
GCPRO2 (insdef, default_filename);
-
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
- if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
- && use_dialog_box
- && have_menus_p ())
+
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
+ if (! NILP (Fnext_read_file_uses_dialog_p ()))
{
/* 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(default_filename))
default_filename = Fexpand_file_name (default_filename, dir);
- val = Fx_file_dialog (prompt, dir, default_filename, mustmatch);
+ val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
+ EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
add_to_history = 1;
}
else
if (! replace_in_history)
add_to_history = 1;
- val = build_string ("");
+ val = empty_string;
}
unbind_to (count, Qnil);
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)
Fset (Qfile_name_history,
Fcons (val1, tem));
}
-
+
return val;
}
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
Qfile_modes = intern ("file-modes");
Qset_file_modes = intern ("set-file-modes");
+ Qset_file_times = intern ("set-file-times");
Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
Qinsert_file_contents = intern ("insert-file-contents");
Qwrite_region = intern ("write-region");
Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
+ Qauto_save_coding = intern ("auto-save-coding");
staticpro (&Qexpand_file_name);
staticpro (&Qsubstitute_in_file_name);
staticpro (&Qfile_accessible_directory_p);
staticpro (&Qfile_modes);
staticpro (&Qset_file_modes);
+ staticpro (&Qset_file_times);
staticpro (&Qfile_newer_than_file_p);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
staticpro (&Qset_visited_file_modtime);
+ staticpro (&Qauto_save_coding);
Qfile_name_history = intern ("file-name-history");
Fset (Qfile_name_history, Qnil);
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,
- doc: /* *Format in which to write auto-save files.
-Should be a list of symbols naming formats that are defined in `format-alist'.
-If it is t, which is the default, auto-save files are written in the
-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);
-
+ Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding");
+ staticpro (&Qafter_insert_file_set_coding);
+
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
Fput (Qfile_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 ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case,
+ doc: /* *Non-nil means when reading a file name completion ignores case. */);
+#if defined VMS || defined DOS_NT || defined MAC_OS
+ read_file_name_completion_ignore_case = 1;
+#else
+ read_file_name_completion_ignore_case = 0;
+#endif
+
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
- doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
+ doc: /* *Non-nil means when reading a filename start with default dir in minibuffer.
+If the initial minibuffer contents are non-empty, you can usually
+request a default filename by typing RETURN without editing. For some
+commands, exiting with an empty minibuffer has a special meaning,
+such as making the current buffer visit no file in the case of
+`set-visited-file-name'.
+If this variable is non-nil, the minibuffer contents are always
+initially non-empty and typing RETURN without editing will fetch the
+default name, if one is provided. Note however that this default name
+is not necessarily the name originally inserted in the minibuffer, if
+that is just the default directory.
+If this variable is nil, the minibuffer often starts out empty. In
+that case you may have to explicitly fetch the next history element to
+request the default name. */);
insert_default_directory = 1;
DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
doc: /* Directory separator character for built-in functions that return file names.
-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. */);
+The value is always ?/. Don't use this variable, just use `/'. */);
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
doc: /* A list of functions to be called at the end of `insert-file-contents'.
-Each is passed one argument, the number of bytes inserted. It should return
-the new byte count, and leave point the same. If `insert-file-contents' is
-intercepted by a handler from `file-name-handler-alist', that handler is
-responsible for calling the after-insert-file-functions if appropriate. */);
+Each is passed one argument, the number of characters inserted.
+It should return the new character count, and leave point the same.
+If `insert-file-contents' is intercepted by a handler from
+`file-name-handler-alist', that handler is responsible for calling the
+functions in `after-insert-file-functions' if appropriate. */);
Vafter_insert_file_functions = Qnil;
DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
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; in that case it should pay attention
+to the annotations returned by previous functions and listed in
+`write-region-annotations-so-far'.*/);
Vwrite_region_annotate_functions = Qnil;
+ staticpro (&Qwrite_region_annotate_functions);
+ Qwrite_region_annotate_functions
+ = intern ("write-region-annotate-functions");
DEFVAR_LISP ("write-region-annotations-so-far",
&Vwrite_region_annotations_so_far,
defsubr (&Sfile_regular_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
+ defsubr (&Sset_file_times);
defsubr (&Sset_default_file_modes);
defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sread_file_name_internal);
defsubr (&Sread_file_name);
+ defsubr (&Snext_read_file_uses_dialog_p);
#ifdef unix
defsubr (&Sunix_sync);
#endif
}
+/* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
+ (do not change this comment) */