comparison src/fileio.c @ 17723:f67a321c8fb6

(Fwrite_region): Add 7th optional arg CODING_SYSTEM. Move gap after a newline code if we are encoding in a coding system which requires designation sequences to be put at beginning of line. Set coding.last_block to 1 before calling a_write for an empty file. (build_annotations): Code tuned up for handling pre_write_conversion of a coding system. (e_write): Delete code for handling carryover of code conversion. It is now handled in encode_coding. (auto_save_1): Supply 7th new arg CODING_SYSTEM as Qnil to Fwrite_region.

17722:27df69e20b98

  Fset_buffer (buf);
  Fkill_buffer (tembuf);
  return Qnil;
}

DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6,
  "r\nFWrite region to file: ",
  "Write current region into specified file.\n\
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\

  VISIT is also the file name to lock and unlock for clash detection.\n\
If VISIT is neither t nor nil nor a string,\n\
  that means do not print the \"Wrote file\" message.\n\
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
  use for locking and unlocking, overriding FILENAME and VISIT.\n\
Kludgy feature: if START is a string, then that string is written\n\
to the file, instead of any buffer contents, and END is ignored.\n\
This does code conversion according to the value of\n\
 `coding-system-for-write' or `coding-system-alist', and sets the variable\n\
 `last-coding-system-used' to the coding system actually used.")
  (start, end, filename, append, visit, lockname)
     Lisp_Object start, end, filename, append, visit, lockname;
{
  register int desc;
  int failure;
  int save_errno;
  unsigned char *fn;

    error ("Cannot do file visiting in an indirect buffer");

  if (!NILP (start) && !STRINGP (start))
    validate_region (&start, &end);

  GCPRO4 (start, filename, visit, lockname);
  filename = Fexpand_file_name (filename, Qnil);
  if (STRINGP (visit))
    visit_file = Fexpand_file_name (visit, Qnil);
  else
    visit_file = filename;
  UNGCPRO;

  visiting = (EQ (visit, Qt) || STRINGP (visit));
  quietly = !NILP (visit);

  annotations = Qnil;

  if (NILP (lockname))
    lockname = visit_file;

  GCPRO5 (start, filename, annotations, visit_file, lockname);

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (filename, Qwrite_region);
  /* If FILENAME has no handler, see if VISIT has one.  */
  if (NILP (handler) && STRINGP (visit))
    handler = Ffind_file_name_handler (visit, Qwrite_region);

  if (!NILP (handler))
    {
      Lisp_Object val;
      val = call6 (handler, Qwrite_region, start, end,
		   filename, append, visit);

      if (visiting)
	{
	  SAVE_MODIFF = MODIFF;
	  XSETFASTINT (current_buffer->save_length, Z - BEG);
	  current_buffer->filename = visit_file;
	}
      UNGCPRO;
      return val;
    }

  /* Decide the coding-system to be encoded to.  */
  {
    Lisp_Object val;

    if (auto_saving || NILP (current_buffer->enable_multibyte_characters))
      val = Qnil;
    else if (!NILP (Vcoding_system_for_write))
      val = Vcoding_system_for_write;
    else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system,
					      Qnil)))
      val = Fsymbol_value (Qbuffer_file_coding_system);

#ifdef DOS_NT
    if (!NILP (current_buffer->buffer_file_type))
      coding.eol_type = CODING_EOL_LF;
#endif /* DOS_NT */
  }

  /* Special kludge to simplify auto-saving.  */
  if (NILP (start))
    {
      XSETFASTINT (start, BEG);

 *
 * Yech!
 */
  if (GPT > BEG && GPT_ADDR[-1] != '\n')
    move_gap (find_next_newline (GPT, 1));
#endif

  failure = 0;
  immediate_quit = 1;

	}
    }
  else
    {
      /* If file was empty, still need to write the annotations */
      failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding);
      save_errno = errno;
    }

  if (coding.require_flushing)

  if (!NILP (pre_write_conversion))
    {
      struct buffer *given_buffer = current_buffer;
      Vwrite_region_annotations_so_far = annotations;
      res = call2 (pre_write_conversion, start, end);
      if (current_buffer != given_buffer)
	{
	  start = BEGV;
	  end = ZV;
	  annotations = Qnil;
	}
      Flength (res);
      annotations = merge (annotations, res, Qcar_less_than_car);
    }

  UNGCPRO;
  return annotations;
}

  while (1)
    {
      produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE,
				&consumed);
      len -= consumed, addr += consumed;
      if (produced == 0 && len > 0)
	{
	  /* There was a carry over because of invalid codes in the source.
	     We just write out them as is.  */
	  bcopy (addr, buf, len);
	  produced = len;
	  len = 0;
	}
      if (produced > 0)
	{
	  produced -= write (desc, buf, produced);
	  if (produced) return -1;
	}

    auto_save_mode_bits = 0666;

  return
    Fwrite_region (Qnil, Qnil,
		   current_buffer->auto_save_file_name,
		   Qnil, Qlambda, Qnil);
}

static Lisp_Object
do_auto_save_unwind (desc)  /* used as unwind-protect function */
     Lisp_Object desc;

17723:f67a321c8fb6

  Fset_buffer (buf);
  Fkill_buffer (tembuf);
  return Qnil;
}

DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
  "r\nFWrite region to file: \ni\ni\ni\nZCoding system: ",
  "Write current region into specified file.\n\
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\

  VISIT is also the file name to lock and unlock for clash detection.\n\
If VISIT is neither t nor nil nor a string,\n\
  that means do not print the \"Wrote file\" message.\n\
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
  use for locking and unlocking, overriding FILENAME and VISIT.\n\
The optional seventh arg CODING-SYSTEM, if non-nil, specifies the coding\n\
 system to be used for encoding characters.  For interactive use,\n\
 you can specify it by giving a prefix argument.  If no coding system\n\
 is specified, the current region is encoded according to the value of\n\
 `coding-system-for-write' or `coding-system-alist'.  The variable\n\
 `last-coding-system-used' is set the coding system actually used.\n\
Kludgy feature: if START is a string, then that string is written\n\
to the file, instead of any buffer contents, and END is ignored.")
  (start, end, filename, append, visit, lockname, coding_system_symbol)
     Lisp_Object start, end, filename, append, visit, lockname;
     Lisp_Object coding_system_symbol;
{
  register int desc;
  int failure;
  int save_errno;
  unsigned char *fn;

    error ("Cannot do file visiting in an indirect buffer");

  if (!NILP (start) && !STRINGP (start))
    validate_region (&start, &end);

  GCPRO5 (start, filename, visit, lockname, coding_system_symbol);

  /* Decide the coding-system to be encoded to.  */
  {
    Lisp_Object val;

    if (auto_saving || NILP (current_buffer->enable_multibyte_characters))
      val = Qnil;
    else if (!NILP (coding_system_symbol))
      val = coding_system_symbol;
    else if (!NILP (Vcoding_system_for_write))
      val = Vcoding_system_for_write;
    else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system,
					      Qnil)))
      val = Fsymbol_value (Qbuffer_file_coding_system);

#ifdef DOS_NT
    if (!NILP (current_buffer->buffer_file_type))
      coding.eol_type = CODING_EOL_LF;
#endif /* DOS_NT */
  }

  filename = Fexpand_file_name (filename, Qnil);
  if (STRINGP (visit))
    visit_file = Fexpand_file_name (visit, Qnil);
  else
    visit_file = filename;
  UNGCPRO;

  visiting = (EQ (visit, Qt) || STRINGP (visit));
  quietly = !NILP (visit);

  annotations = Qnil;

  if (NILP (lockname))
    lockname = visit_file;

  GCPRO5 (start, filename, annotations, visit_file, lockname);

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (filename, Qwrite_region);
  /* If FILENAME has no handler, see if VISIT has one.  */
  if (NILP (handler) && STRINGP (visit))
    handler = Ffind_file_name_handler (visit, Qwrite_region);

  if (!NILP (handler))
    {
      Lisp_Object val;
      val = call6 (handler, Qwrite_region, start, end,
		   filename, append, visit);

      if (visiting)
	{
	  SAVE_MODIFF = MODIFF;
	  XSETFASTINT (current_buffer->save_length, Z - BEG);
	  current_buffer->filename = visit_file;
	}
      UNGCPRO;
      return val;
    }

  /* Special kludge to simplify auto-saving.  */
  if (NILP (start))
    {
      XSETFASTINT (start, BEG);

 *
 * Yech!
 */
  if (GPT > BEG && GPT_ADDR[-1] != '\n')
    move_gap (find_next_newline (GPT, 1));
#else
  /* Whether VMS or not, we must move the gap to the next of newline
     when we must put designation sequences at beginning of line.  */
  if (INTEGERP (start)
      && coding.type == coding_type_iso2022
      && coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
      && GPT > BEG && GPT_ADDR[-1] != '\n')
    move_gap (find_next_newline (GPT, 1));
#endif

  failure = 0;
  immediate_quit = 1;

	}
    }
  else
    {
      /* If file was empty, still need to write the annotations */
      coding.last_block = 1;
      failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding);
      save_errno = errno;
    }

  if (coding.require_flushing)

  if (!NILP (pre_write_conversion))
    {
      struct buffer *given_buffer = current_buffer;
      Vwrite_region_annotations_so_far = annotations;
      res = call2 (pre_write_conversion, start, end);
      Flength (res);
      annotations = (current_buffer != given_buffer
		     ? res
		     : merge (annotations, res, Qcar_less_than_car));
    }

  UNGCPRO;
  return annotations;
}

  while (1)
    {
      produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE,
				&consumed);
      len -= consumed, addr += consumed;
      if (produced > 0)
	{
	  produced -= write (desc, buf, produced);
	  if (produced) return -1;
	}

    auto_save_mode_bits = 0666;

  return
    Fwrite_region (Qnil, Qnil,
		   current_buffer->auto_save_file_name,
		   Qnil, Qlambda, Qnil, Qnil);
}

static Lisp_Object
do_auto_save_unwind (desc)  /* used as unwind-protect function */
     Lisp_Object desc;