/* 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, 2001
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#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\
unsigned char *nm;
register unsigned char *s, *p, *o, *x, *endp;
- unsigned char *target;
+ unsigned char *target = NULL;
int total = 0;
int substituted = 0;
unsigned char *xnm;
/* NOTREACHED */
#endif /* not VMS */
+ return Qnil;
}
\f
/* A slightly faster and more convenient way to get
Fourth arg KEEP-TIME non-nil means give the new file the same\n\
last-modified time as the old one. (This works on only some systems.)\n\
A prefix arg makes KEEP-TIME non-nil.")
- (file, newname, ok_if_already_exists, keep_date)
- Lisp_Object file, newname, ok_if_already_exists, keep_date;
+ (file, newname, ok_if_already_exists, keep_time)
+ Lisp_Object file, newname, ok_if_already_exists, keep_time;
{
int ifd, ofd, n;
char buf[16 * 1024];
handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
- ok_if_already_exists, keep_date));
+ ok_if_already_exists, keep_time));
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
if (input_file_statable_p)
{
- if (!NILP (keep_date))
+ if (!NILP (keep_time))
{
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
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.")
()
int inserted = 0;
register int how_much;
register int unprocessed;
- int count = specpdl_ptr - specpdl;
+ int count = BINDING_STACK_SIZE ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object handler, val, insval, orig_filename;
Lisp_Object p;
- int total;
+ int total = 0;
int not_regular = 0;
unsigned char read_buf[READ_BUF_SIZE];
struct coding_system coding;
else if (nread > 0)
{
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 */
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. */
+ if (!NILP (visit))
+ {
+ empty_undo_list_p = NILP (current_buffer->undo_list);
+ current_buffer->undo_list = Qt;
+ }
+
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
CHECK_NUMBER (insval, 0);
inserted = XFASTINT (insval);
+
+ if (!NILP (visit))
+ current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
if (set_coding_system)
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\
{
register int desc;
int failure;
- int save_errno;
+ int save_errno = 0;
unsigned char *fn;
struct stat st;
int tem;
Lisp_Object visit_file;
Lisp_Object annotations;
Lisp_Object encoded_filename;
- int visiting, quietly;
+ int visiting = (EQ (visit, Qt) || STRINGP (visit));
+ int quietly = !NILP (visit);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
#ifdef DOS_NT
#endif /* DOS_NT */
struct coding_system coding;
- if (current_buffer->base_buffer && ! NILP (visit))
+ if (current_buffer->base_buffer && visiting)
error ("Cannot do file visiting in an indirect buffer");
if (!NILP (start) && !STRINGP (start))
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))
visit_file = filename;
UNGCPRO;
- visiting = (EQ (visit, Qt) || STRINGP (visit));
- quietly = !NILP (visit);
-
annotations = Qnil;
if (NILP (lockname))
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
/*
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);
{
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,
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,
}
\f
Lisp_Object
-auto_save_error ()
+auto_save_error (error)
+ Lisp_Object error;
{
+ Lisp_Object args[3], msg;
+ int i, nbytes;
+ struct gcpro gcpro1;
+
ring_bell ();
- message_with_string ("Autosaving...error for %s", current_buffer->name, 1);
- Fsleep_for (make_number (1), Qnil);
- message_with_string ("Autosaving...error for %s", current_buffer->name, 0);
- Fsleep_for (make_number (1), Qnil);
- message_with_string ("Autosaving...error for %s", current_buffer->name, 0);
- Fsleep_for (make_number (1), Qnil);
+
+ args[0] = build_string ("Auto-saving %s: %s");
+ args[1] = current_buffer->name;
+ args[2] = Ferror_message_string (error);
+ msg = Fformat (3, args);
+ GCPRO1 (msg);
+ nbytes = STRING_BYTES (XSTRING (msg));
+
+ for (i = 0; i < 3; ++i)
+ {
+ if (i == 0)
+ message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ else
+ message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ Fsleep_for (make_number (1), Qnil);
+ }
+
+ UNGCPRO;
return Qnil;
}
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
if (!NILP (stream))
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
| XFASTINT (XCDR (stream))));
+ pop_message ();
return Qnil;
}
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)
{
Vquit_flag = oquit;
- pop_message ();
unbind_to (count, Qnil);
return Qnil;
}
Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
Non-nil and non-t means also require confirmation after completion.\n\
Fifth arg INITIAL specifies text to start with.\n\
-DIR defaults to current buffer's directory default.")
+DIR defaults to current buffer's directory default.\n\
+\n\
+If this command was invoked with the mouse, use a file dialog box if\n\
+`use-dialog-box' is non-nil, and the window system or X toolkit in use\n\
+provides a file dialog box..")
(prompt, dir, default_filename, mustmatch, initial)
Lisp_Object prompt, dir, default_filename, mustmatch, initial;
{
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
#ifdef DOS_NT
- homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
- CORRECT_DIR_SEPS (homedir);
+ /* homedir can be NULL in temacs, since Vprocess_environment is not
+ yet set up. We shouldn't crash in that case. */
+ if (homedir != 0)
+ {
+ homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
+ CORRECT_DIR_SEPS (homedir);
+ }
#endif
if (homedir != 0
&& STRINGP (dir)
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
}
-(_GNU_SOURCE):
+