/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,98,1999 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000
+ 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 (LINUX)
#include <errno.h>
#ifndef vax11c
+#ifndef USE_CRT_DLL
extern int errno;
#endif
+#endif
#ifdef APOLLO
#include <sys/time.h>
Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
Lisp_Object Qmake_directory_internal;
+Lisp_Object Qmake_directory;
Lisp_Object Qdelete_directory;
Lisp_Object Qdelete_file;
Lisp_Object Qrename_file;
'w','x','y','z','0','1','2','3',
'4','5','6','7','8','9','-','_'
};
+
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
-DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
- "Generate temporary file name (string) starting with PREFIX (a string).\n\
-The Emacs process number forms part of the result,\n\
-so there is no danger of generating a name being used by another process.\n\
-\n\
-In addition, this function makes an attempt to choose a name\n\
-which has no existing file. To make this work,\n\
-PREFIX should be an absolute file name.\n\
-\n\
-There is a race condition between calling `make-temp-name' and creating the\n\
-file which opens all kinds of security holes. For that reason, you should\n\
-probably use `make-temp-file' instead.")
- (prefix)
+/* 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
+ with long file names, add the pid as a decimal number.
+
+ This function signals an error if no unique file name could be
+ generated. */
+
+Lisp_Object
+make_temp_name (prefix, base64_p)
Lisp_Object prefix;
+ int base64_p;
{
Lisp_Object val;
int len;
unsigned char *p, *data;
char pidbuf[20];
int pidlen;
-
+
CHECK_STRING (prefix, 0);
/* VAL is created by adding 6 characters to PREFIX. The first
pid = (int) getpid ();
+ if (base64_p)
+ {
+ pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidlen = 3;
+ }
+ else
+ {
#ifdef HAVE_LONG_FILE_NAMES
- sprintf (pidbuf, "%d", pid);
- pidlen = strlen (pidbuf);
+ sprintf (pidbuf, "%d", pid);
+ pidlen = strlen (pidbuf);
#else
- pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidlen = 3;
+ pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidlen = 3;
#endif
-
+ }
+
len = XSTRING (prefix)->size;
val = make_uninit_string (len + 3 + pidlen);
data = XSTRING (val)->data;
in looping through 225307 stat's, which is not only
dog-slow, but also useless since it will fallback to
the errow below, anyway. */
- report_file_error ("Cannot create temporary name for prefix `%s'",
+ report_file_error ("Cannot create temporary name for prefix",
Fcons (prefix, Qnil));
/* not reached */
}
return Qnil;
}
+
+DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
+ "Generate temporary file name (string) starting with PREFIX (a string).\n\
+The Emacs process number forms part of the result,\n\
+so there is no danger of generating a name being used by another process.\n\
+\n\
+In addition, this function makes an attempt to choose a name\n\
+which has no existing file. To make this work,\n\
+PREFIX should be an absolute file name.\n\
+\n\
+There is a race condition between calling `make-temp-name' and creating the\n\
+file which opens all kinds of security holes. For that reason, you should\n\
+probably use `make-temp-file' instead.")
+ (prefix)
+ Lisp_Object prefix;
+{
+ return make_temp_name (prefix, 0);
+}
+
+
\f
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert filename NAME to absolute, and canonicalize it.\n\
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
+#ifdef DOS_NT
+ /* If the file names are identical but for the case, don't ask for
+ confirmation: they simply want to change the letter-case of the
+ file name. */
+ if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
+#endif
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_newname, "rename to it",
#endif /* MSDOS */
dir = ENCODE_FILE (dir);
+#ifdef WINDOWSNT
+ /* 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)
+ return Qnil;
+ return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
+#else
return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
? Qt : Qnil);
+#endif
}
\f
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
return Qnil;
}
val = make_string (buf, valsize);
+ if (buf[0] == '/' && index (buf, ':'))
+ val = concat2 (build_string ("/:"), val);
xfree (buf);
val = DECODE_FILE (val);
return val;
XSETINT (value, (~ realmask) & 0777);
return value;
}
+
\f
-#ifdef unix
+#ifdef __NetBSD__
+#define unix 42
+#endif
+#ifdef unix
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
"Tell Unix to finish all pending disk updates.")
()
We assume that the 1K-byte and 3K-byte for heading
and tailing respectively are sufficient for this
purpose. */
- int how_many, nread;
+ int nread;
if (st.st_size <= (1024 * 4))
nread = emacs_read (fd, read_buf, 1024 * 4);
XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (nread > 0)
{
- int count = specpdl_ptr - specpdl;
struct buffer *prev = current_buffer;
+ int count1;
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;
insert_1_both (read_buf, nread, nread, 0, 0, 0);
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--;
}
setup_coding_system (Fcheck_coding_system (val), &coding);
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
if (NILP (current_buffer->enable_multibyte_characters)
&& ! NILP (val))
end-of-line conversion. */
setup_raw_text_coding_system (&coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
coding_system_decided = 1;
}
- /* Ensure we always set Vlast_coding_system_used. */
- set_coding_system = 1;
-
/* If requested, replace the accessible part of the buffer
with the file contents. Avoid replacing text at the
beginning or end of the buffer that matches the file contents;
and let the following if-statement handle the replace job. */
if (!NILP (replace)
&& BEGV < ZV
- && ! CODING_REQUIRE_DECODING (&coding)
- && (coding.eol_type == CODING_EOL_UNDECIDED
- || coding.eol_type == CODING_EOL_LF))
+ && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK))
{
/* same_at_start and same_at_end count bytes,
because file access counts bytes
if (coding.type == coding_type_undecided)
detect_coding (&coding, buffer, nread);
- if (CODING_REQUIRE_DECODING (&coding))
+ if (coding.common_flags & CODING_REQUIRE_DECODING_MASK)
/* We found that the file should be decoded somehow.
Let's give up here. */
{
/* Save for next iteration whatever we didn't convert. */
unprocessed = this - coding.consumed;
bcopy (read_buf + coding.consumed, read_buf, unprocessed);
- this = coding.produced;
+ if (!NILP (current_buffer->enable_multibyte_characters))
+ this = coding.produced;
+ else
+ this = str_as_unibyte (conversion_buffer + inserted,
+ coding.produced);
}
inserted += this;
/* Set `inserted' to the number of inserted characters. */
inserted = PT - temp;
- free (conversion_buffer);
+ xfree (conversion_buffer);
emacs_close (fd);
specpdl_ptr--;
error ("IO error reading %s: %s",
XSTRING (orig_filename)->data, emacs_strerror (errno));
+ notfound:
+
if (! coding_system_decided)
{
/* The coding system is not yet decided. Decide it by an
setup_coding_system (val, &temp_coding);
bcopy (&temp_coding, &coding, sizeof coding);
}
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
if (NILP (current_buffer->enable_multibyte_characters)
&& ! NILP (val))
/* We must suppress all character code conversion except for
end-of-line conversion. */
setup_raw_text_coding_system (&coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
+ }
+
+ if (!NILP (visit)
+ && (coding.type == coding_type_no_conversion
+ || coding.type == coding_type_raw_text))
+ {
+ /* Visiting a file with these coding system always make the buffer
+ unibyte. */
+ current_buffer->enable_multibyte_characters = Qnil;
+ coding.dst_multibyte = 0;
}
if (inserted > 0 || coding.type == coding_type_ccl)
{
if (CODING_MAY_REQUIRE_DECODING (&coding))
{
- /* Here, we don't have to consider byte combining (see the
- comment below) because code_convert_region takes care of
- it. */
code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
&coding, 0, 0);
- inserted = (NILP (current_buffer->enable_multibyte_characters)
- ? coding.produced : coding.produced_char);
- }
- else if (!NILP (current_buffer->enable_multibyte_characters))
- {
- int inserted_byte = inserted;
-
- /* There's a possibility that we must combine bytes at the
- head (resp. the tail) of the just inserted text with the
- bytes before (resp. after) the gap to form a single
- character. */
- inserted = multibyte_chars_in_text (GPT_ADDR - inserted, inserted);
- adjust_after_insert (PT, PT_BYTE,
- PT + inserted_byte, PT_BYTE + inserted_byte,
- inserted);
+ inserted = coding.produced_char;
}
else
adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
- inserted);
+ inserted);
}
#ifdef DOS_NT
current_buffer->buffer_file_type = Qnil;
#endif
- notfound:
handled:
if (!NILP (visit))
Fsignal (Qfile_error,
Fcons (build_string ("not a regular file"),
Fcons (orig_filename, Qnil)));
-
- /* If visiting nonexistent file, return nil. */
- if (current_buffer->modtime == -1)
- report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
}
/* Decode file format */
update_compositions (PT, PT, CHECK_BORDER);
}
- if (inserted > 0)
+ p = Vafter_insert_file_functions;
+ while (!NILP (p))
{
- p = Vafter_insert_file_functions;
- while (!NILP (p))
+ insval = call1 (Fcar (p), make_number (inserted));
+ if (!NILP (insval))
{
- insval = call1 (Fcar (p), make_number (inserted));
- if (!NILP (insval))
- {
- CHECK_NUMBER (insval, 0);
- inserted = XFASTINT (insval);
- }
- QUIT;
- p = Fcdr (p);
+ CHECK_NUMBER (insval, 0);
+ inserted = XFASTINT (insval);
}
+ QUIT;
+ p = Fcdr (p);
+ }
+
+ if (!NILP (visit)
+ && current_buffer->modtime == -1)
+ {
+ /* If visiting nonexistent file, return nil. */
+ report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
}
/* ??? Retval needs to be dealt with in all cases consistently. */
When called from a program, takes three arguments:\n\
START, END and FILENAME. START and END are buffer positions.\n\
Optional fourth argument APPEND if non-nil means\n\
- append to existing file contents (if any).\n\
+ append to existing file contents (if any). If it is an integer,\n\
+ seek to that offset in the file before writing.\n\
Optional fifth argument VISIT if t means\n\
set the last-save-file-modtime of buffer to this file's modtime\n\
and mark buffer not modified.\n\
filename = Fexpand_file_name (filename, Qnil);
- if (! NILP (mustbenew) && mustbenew != Qexcl)
+ if (! NILP (mustbenew) && !EQ (mustbenew, Qexcl))
barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
if (STRINGP (visit))
S_IREAD | S_IWRITE);
#else /* not DOS_NT */
desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
- | (mustbenew == Qexcl ? O_EXCL : 0),
+ | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
auto_saving ? auto_save_mode_bits : 0666);
#endif /* not DOS_NT */
#endif /* not VMS */
- UNGCPRO;
-
if (desc < 0)
{
#ifdef CLASH_DETECTION
if (!auto_saving) unlock_file (lockname);
errno = save_errno;
#endif /* CLASH_DETECTION */
+ UNGCPRO;
report_file_error ("Opening output file", Fcons (filename, Qnil));
}
record_unwind_protect (close_file_unwind, make_number (desc));
if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
- if (lseek (desc, 0, 2) < 0)
- {
+ {
+ long ret;
+
+ if (NUMBERP (append))
+ ret = lseek (desc, XINT (append), 1);
+ else
+ ret = lseek (desc, 0, 2);
+ if (ret < 0)
+ {
#ifdef CLASH_DETECTION
- if (!auto_saving) unlock_file (lockname);
+ if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
- report_file_error ("Lseek error", Fcons (filename, Qnil));
- }
+ UNGCPRO;
+ report_file_error ("Lseek error", Fcons (filename, Qnil));
+ }
+ }
+
+ UNGCPRO;
#ifdef VMS
/*
}
else if (XINT (start) != XINT (end))
{
- register int end1 = CHAR_TO_BYTE (XINT (end));
-
tem = CHAR_TO_BYTE (XINT (start));
if (XINT (start) < GPT)
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
+ int i;
XSETBUFFER (original_buffer, current_buffer);
p = Vauto_save_file_format;
else
p = current_buffer->file_format;
- while (!NILP (p))
+ for (i = 0; !NILP (p); p = Fcdr (p), ++i)
{
struct buffer *given_buffer = current_buffer;
+
Vwrite_region_annotations_so_far = annotations;
- res = call4 (Qformat_annotate_function, Fcar (p), start, end,
- original_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,
+ original_buffer, make_number (i));
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
XSETFASTINT (end, ZV);
annotations = Qnil;
}
- Flength (res);
- annotations = merge (annotations, res, Qcar_less_than_car);
- p = Fcdr (p);
+
+ if (CONSP (res))
+ annotations = merge (annotations, res, Qcar_less_than_car);
}
/* At last, do the same for the function PRE_WRITE_CONVERSION
/* Output buffer text up to the next annotation's position. */
if (nextpos > pos)
{
- if (0 > e_write (desc, string, pos, nextpos, coding));
+ if (0 > e_write (desc, string, pos, nextpos, coding))
return -1;
pos = nextpos;
}
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding));
+ if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding))
return -1;
}
*annot = Fcdr (*annot);
register char *addr;
register int nbytes;
char buf[WRITE_BUF_SIZE];
- int composing = coding->composing;
int return_val = 0;
+ int require_encoding_p;
if (start >= end)
coding->composing = COMPOSITION_DISABLED;
{
addr = XSTRING (string)->data;
nbytes = STRING_BYTES (XSTRING (string));
+ coding->src_multibyte = STRING_MULTIBYTE (string);
}
else if (start < end)
{
/* It is assured that the gap is not in the range START and END-1. */
addr = CHAR_POS_ADDR (start);
nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
+ coding->src_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
}
else
{
addr = "";
nbytes = 0;
+ coding->src_multibyte = 1;
}
/* We used to have a code for handling selective display here. But,
break;
}
}
- if (result == CODING_FINISH_INSUFFICIENT_SRC)
+ nbytes -= coding->consumed;
+ addr += coding->consumed;
+ if (result == CODING_FINISH_INSUFFICIENT_SRC
+ && nbytes > 0)
{
/* The source text ends by an incomplete multibyte form.
There's no way other than write it out as is. */
}
if (nbytes <= 0)
break;
- nbytes -= coding->consumed;
- addr += coding->consumed;
start += coding->consumed_char;
if (coding->cmp_data)
coding_adjust_composition_offset (coding, start);
}
- return 0;
+
+ if (coding->cmp_data)
+ coding_free_composition_data (coding);
+
+ return return_val;
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
Lisp_Object
auto_save_1 ()
{
- unsigned char *fn;
struct stat st;
/* Get visited file's mode to become the auto save file's mode. */
- if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
+ 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
FILE *stream;
Lisp_Object lispstream;
int count = specpdl_ptr - specpdl;
- int *ptr;
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
int message_p = push_message ();
if (STRINGP (Vauto_save_list_file_name))
{
- Lisp_Object listfile;
+ Lisp_Object listfile, dir;
+
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
+
+ dir = Ffile_name_directory (listfile);
+ if (NILP (Ffile_directory_p (dir)))
+ call2 (Qmake_directory, dir, Qt);
+
stream = fopen (XSTRING (listfile)->data, "w");
if (stream != NULL)
{
GCPRO2 (insdef, default_filename);
-#ifdef USE_MOTIF
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
{
+ /* If DIR contains a file name, split it. */
+ Lisp_Object file;
+ file = Ffile_name_nondirectory (dir);
+ if (XSTRING (file)->size && NILP (default_filename))
+ {
+ default_filename = file;
+ dir = Ffile_name_directory (dir);
+ }
+ if (!NILP(default_filename))
+ default_filename = Fexpand_file_name (default_filename, dir);
val = Fx_file_dialog (prompt, dir, default_filename, mustmatch);
add_to_history = 1;
}
Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
Qmake_directory_internal = intern ("make-directory-internal");
+ Qmake_directory = intern ("make-directory");
Qdelete_directory = intern ("delete-directory");
Qdelete_file = intern ("delete-file");
Qrename_file = intern ("rename-file");
staticpro (&Qfile_name_as_directory);
staticpro (&Qcopy_file);
staticpro (&Qmake_directory_internal);
+ staticpro (&Qmake_directory);
staticpro (&Qdelete_directory);
staticpro (&Qdelete_file);
staticpro (&Qrename_file);
defsubr (&Sunix_sync);
#endif
}
+