#include <careadlinkat.h>
#include <stat-time.h>
+#include <binary-io.h>
+
#ifdef HPUX
#include <netio.h>
#endif
report_file_errno (char const *string, Lisp_Object name, int errorno)
{
Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
- Lisp_Object errstring;
- char *str;
-
synchronize_system_messages_locale ();
- str = strerror (errorno);
- errstring = code_convert_string_norecord (build_unibyte_string (str),
- Vlocale_coding_system, 0);
-
- while (1)
- switch (errorno)
- {
- case EEXIST:
- xsignal (Qfile_already_exists, Fcons (errstring, data));
- break;
- default:
- /* System error messages are capitalized. Downcase the initial
- unless it is followed by a slash. (The slash case caters to
- error messages that begin with "I/O" or, in German, "E/A".) */
- if (STRING_MULTIBYTE (errstring)
- && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
- {
- int c;
-
- str = SSDATA (errstring);
- c = STRING_CHAR ((unsigned char *) str);
- Faset (errstring, make_number (0), make_number (downcase (c)));
- }
-
- xsignal (Qfile_error,
- Fcons (build_string (string), Fcons (errstring, data)));
- }
+ char *str = strerror (errorno);
+ Lisp_Object errstring
+ = code_convert_string_norecord (build_unibyte_string (str),
+ Vlocale_coding_system, 0);
+ Lisp_Object errdata = Fcons (errstring, data);
+
+ if (errorno == EEXIST)
+ xsignal (Qfile_already_exists, errdata);
+ else
+ xsignal (Qfile_error, Fcons (build_string (string), errdata));
}
/* Signal a file-access failure that set errno. STRING describes the
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
doc: /* Generate temporary file name (string) 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.
+The Emacs process number forms part of the result, so there is no
+danger of generating a name being used by another Emacs process
+\(so long as only a single host can access the containing directory...).
-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.
+This function tries to choose a name that has no existing file.
+For this to work, PREFIX should be an absolute file name.
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, 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. */)
+file, which opens all kinds of security holes. For that reason, you should
+normally use `make-temp-file' instead. */)
(Lisp_Object prefix)
{
return make_temp_name (prefix, 0);
(Lisp_Object filename)
{
Lisp_Object absname;
- Lisp_Object values[4];
+ Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
+
Lisp_Object handler;
#if HAVE_LIBSELINUX
security_context_t con;
absname = ENCODE_FILE (absname);
- values[0] = Qnil;
- values[1] = Qnil;
- values[2] = Qnil;
- values[3] = Qnil;
#if HAVE_LIBSELINUX
if (is_selinux_enabled ())
{
{
context = context_new (con);
if (context_user_get (context))
- values[0] = build_string (context_user_get (context));
+ user = build_string (context_user_get (context));
if (context_role_get (context))
- values[1] = build_string (context_role_get (context));
+ role = build_string (context_role_get (context));
if (context_type_get (context))
- values[2] = build_string (context_type_get (context));
+ type = build_string (context_type_get (context));
if (context_range_get (context))
- values[3] = build_string (context_range_get (context));
+ range = build_string (context_range_get (context));
context_free (context);
freecon (con);
}
}
#endif
- return Flist (ARRAYELTS (values), values);
+ return list4 (user, role, type, range);
}
\f
DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
{
/* If we have not yet decided a coding system, check
file-coding-system-alist. */
- Lisp_Object args[6];
-
- args[0] = Qinsert_file_contents, args[1] = orig_filename;
- args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
- coding_system = Ffind_operation_coding_system (6, args);
+ coding_system = CALLN (Ffind_operation_coding_system,
+ Qinsert_file_contents, orig_filename,
+ visit, beg, end, replace);
if (CONSP (coding_system))
coding_system = XCAR (coding_system);
}
{
/* If the coding system is not yet decided, check
file-coding-system-alist. */
- Lisp_Object args[6];
-
- args[0] = Qinsert_file_contents, args[1] = orig_filename;
- args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
- coding_system = Ffind_operation_coding_system (6, args);
+ coding_system = CALLN (Ffind_operation_coding_system,
+ Qinsert_file_contents, orig_filename,
+ visit, beg, end, Qnil);
if (CONSP (coding_system))
coding_system = XCAR (coding_system);
}
if (NILP (val))
{
/* Check file-coding-system-alist. */
- Lisp_Object args[7], coding_systems;
-
- args[0] = Qwrite_region; args[1] = start; args[2] = end;
- args[3] = filename; args[4] = append; args[5] = visit;
- args[6] = lockname;
- coding_systems = Ffind_operation_coding_system (7, args);
+ Lisp_Object coding_systems
+ = CALLN (Ffind_operation_coding_system, Qwrite_region, start, end,
+ filename, append, visit, lockname);
if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
val = XCDR (coding_systems);
}
doc: /* Return t if (car A) is numerically less than (car B). */)
(Lisp_Object a, Lisp_Object b)
{
- Lisp_Object args[2];
- args[0] = Fcar (a);
- args[1] = Fcar (b);
- return Flss (2, args);
+ return CALLN (Flss, Fcar (a), Fcar (b));
}
/* Build the complete list of annotations appropriate for writing out
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
int i;
- bool used_global = 0;
+ bool used_global = false;
XSETBUFFER (original_buffer, current_buffer);
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);
+ used_global = true;
+ p = CALLN (Fappend,
+ Fdefault_value (Qwrite_region_annotate_functions),
+ XCDR (p));
continue;
}
Vwrite_region_annotations_so_far = annotations;
ring_bell (XFRAME (selected_frame));
AUTO_STRING (format, "Auto-saving %s: %s");
- msg = Fformat (3, ((Lisp_Object [])
- {format, BVAR (current_buffer, name),
- Ferror_message_string (error_val)}));
+ msg = CALLN (Fformat, format, BVAR (current_buffer, name),
+ Ferror_message_string (error_val));
GCPRO1 (msg);
for (i = 0; i < 3; ++i)
return Qnil;
}
+\f
+DEFUN ("set-binary-mode", Fset_binary_mode, Sset_binary_mode, 2, 2, 0,
+ doc: /* Switch STREAM to binary I/O mode or text I/O mode.
+STREAM can be one of the symbols `stdin', `stdout', or `stderr'.
+If MODE is non-nil, switch STREAM to binary mode, otherwise switch
+it to text mode.
+
+As a side effect, this function flushes any pending STREAM's data.
+
+Value is the previous value of STREAM's I/O mode, nil for text mode,
+non-nil for binary mode.
+
+On MS-Windows and MS-DOS, binary mode is needed to read or write
+arbitrary binary data, and for disabling translation between CR-LF
+pairs and a single newline character. Examples include generation
+of text files with Unix-style end-of-line format using `princ' in
+batch mode, with standard output redirected to a file.
+
+On Posix systems, this function always returns non-nil, and has no
+effect except for flushing STREAM's data. */)
+ (Lisp_Object stream, Lisp_Object mode)
+{
+ FILE *fp = NULL;
+ int binmode;
+
+ CHECK_SYMBOL (stream);
+ if (EQ (stream, Qstdin))
+ fp = stdin;
+ else if (EQ (stream, Qstdout))
+ fp = stdout;
+ else if (EQ (stream, Qstderr))
+ fp = stderr;
+ else
+ xsignal2 (Qerror, build_string ("unsupported stream"), stream);
+
+ binmode = NILP (mode) ? O_TEXT : O_BINARY;
+ if (fp != stdin)
+ fflush (fp);
+
+ return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
+}
+\f
void
init_fileio (void)
{
DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
DEFSYM (Qget_buffer_window_list, "get-buffer-window-list");
+ DEFSYM (Qstdin, "stdin");
+ DEFSYM (Qstdout, "stdout");
+ DEFSYM (Qstderr, "stderr");
+
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
defsubr (&Snext_read_file_uses_dialog_p);
+ defsubr (&Sset_binary_mode);
+
#ifdef HAVE_SYNC
defsubr (&Sunix_sync);
#endif