]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
Declare Fuser_full_name as Lisp_Object in advance to
[gnu-emacs] / src / fileio.c
index 3e39154e6fa23ff2844a82fe152678b8f797fea8..14b1ca0aa0e71e69d4477a8b62878a3de713ab1d 100644 (file)
@@ -1251,7 +1251,7 @@ See also the function `substitute-in-file-name'.")
       /* Get rid of any slash at the end of newdir, unless newdir is
        just // (an incomplete UNC name). */
       length = strlen (newdir);
-      if (IS_DIRECTORY_SEP (newdir[length - 1])
+      if (length > 0 && IS_DIRECTORY_SEP (newdir[length - 1])
 #ifdef WINDOWSNT
          && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
 #endif
@@ -1379,7 +1379,8 @@ See also the function `substitute-in-file-name'.")
        {
          while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
            ;
-         if (o == target && IS_ANY_SEP (*o))
+         /* Keep initial / only if this is the whole name.  */
+         if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
            ++o;
          p += 3;
        }
@@ -1921,7 +1922,7 @@ duplicates what `expand-file-name' does.")
         || IS_DIRECTORY_SEP (p[0])
 #endif /* not (APOLLO || WINDOWSNT) */
         )
-       && p != nm && IS_DIRECTORY_SEP (p[-1]))
+       && p != xnm && IS_DIRECTORY_SEP (p[-1]))
       xnm = p;
 #ifdef DOS_NT
     else if (IS_DRIVE (p[0]) && p[1] == ':'
@@ -2130,7 +2131,7 @@ A prefix arg makes KEEP-TIME non-nil.")
          EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
          if (set_file_times (XSTRING (newname)->data, atime, mtime))
            Fsignal (Qfile_date_error,
-                    Fcons (build_string ("File already exists"),
+                    Fcons (build_string ("Cannot set file date"),
                            Fcons (newname, Qnil)));
        }
 #ifndef MSDOS
@@ -3034,6 +3035,7 @@ This does code conversion according to the value of\n\
   char read_buf[READ_BUF_SIZE];
   struct coding_system coding;
   unsigned char buffer[1 << 14];
+  int replace_handled = 0;
 
   if (current_buffer->base_buffer && ! NILP (visit))
     error ("Cannot do file visiting in an indirect buffer");
@@ -3100,13 +3102,15 @@ This does code conversion according to the value of\n\
      least signal an error.  */
   if (!S_ISREG (st.st_mode))
     {
-      if (NILP (visit))
+      not_regular = 1;
+
+      if (! NILP (visit))
+       goto notfound;
+
+      if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
        Fsignal (Qfile_error,
                 Fcons (build_string ("not a regular file"),
                        Fcons (filename, Qnil)));
-
-      not_regular = 1;
-      goto notfound;
     }
 #endif
 
@@ -3121,7 +3125,7 @@ This does code conversion according to the value of\n\
   record_unwind_protect (close_file_unwind, make_number (fd));
 
   /* Supposedly happens on VMS.  */
-  if (st.st_size < 0)
+  if (! not_regular && st.st_size < 0)
     error ("File size is negative");
 
   if (!NILP (beg) || !NILP (end))
@@ -3137,39 +3141,11 @@ This does code conversion according to the value of\n\
     CHECK_NUMBER (end, 0);
   else
     {
-      XSETINT (end, st.st_size);
-      if (XINT (end) != st.st_size)
-       error ("maximum buffer size exceeded");
-    }
-
-  /* Try to determine the character coding now,
-     hoping we can recognize that no coding is used
-     and thus enable the REPLACE feature to work.  */
-  if (!NILP (replace) && (coding.type == coding_type_automatic
-                         || coding.eol_type == CODING_EOL_AUTOMATIC))
-    {
-      int nread, bufpos;
-
-      nread = read (fd, buffer, sizeof buffer);
-      if (nread < 0)
-       error ("IO error reading %s: %s",
-              XSTRING (filename)->data, strerror (errno));
-      else if (nread > 0)
+      if (! not_regular)
        {
-         if (coding.type == coding_type_automatic)
-           detect_coding (&coding, buffer, nread);
-         if (coding.eol_type == CODING_EOL_AUTOMATIC)
-           detect_eol (&coding, buffer, nread);
-         if (lseek (fd, 0, 0) < 0)
-           report_file_error ("Setting file position",
-                              Fcons (filename, Qnil));
-         /* If we still haven't found anything other than
-            "automatic", change to "no conversion"
-            so that the replace feature will work.  */
-         if (coding.type == coding_type_automatic)
-           coding.type = coding_type_no_conversion;
-         if (coding.eol_type == CODING_EOL_AUTOMATIC)
-           coding.eol_type = CODING_EOL_LF;
+         XSETINT (end, st.st_size);
+         if (XINT (end) != st.st_size)
+           error ("Maximum buffer size exceeded");
        }
     }
 
@@ -3181,16 +3157,25 @@ This does code conversion according to the value of\n\
      Here we implement this feature in an optimized way
      for the case where code conversion is NOT needed.
      The following if-statement handles the case of conversion
-     in a less optimal way.  */
+     in a less optimal way.
+
+     If the code conversion is "automatic" then we try using this
+     method and hope for the best.
+     But if we discover the need for conversion, we give up on this method
+     and let the following if-statement handle the replace job.  */
   if (!NILP (replace)
-      && ! CODING_REQUIRE_CONVERSION (&coding))
+      && (! CODING_REQUIRE_CONVERSION (&coding)
+         || (coding.type == coding_type_automatic
+             && ! CODING_REQUIRE_EOL_CONVERSION (&coding))
+         || (coding.eol_type == CODING_EOL_AUTOMATIC
+             && ! CODING_REQUIRE_TEXT_CONVERSION (&coding))))
     {
       int same_at_start = BEGV;
       int same_at_end = ZV;
       int overlap;
       /* There is still a possibility we will find the need to do code
         conversion.  If that happens, we set this variable to 1 to
-        give up on the REPLACE feature.  */
+        give up on handling REPLACE in the optimized way.  */
       int giveup_match_end = 0;
 
       if (XINT (beg) != 0)
@@ -3215,6 +3200,26 @@ This does code conversion according to the value of\n\
          else if (nread == 0)
            break;
 
+         if (coding.type == coding_type_automatic)
+           detect_coding (&coding, buffer, nread);
+         if (CODING_REQUIRE_TEXT_CONVERSION (&coding))
+           /* We found that the file should be decoded somehow.
+               Let's give up here.  */
+           {
+             giveup_match_end = 1;
+             break;
+           }
+
+         if (coding.eol_type == CODING_EOL_AUTOMATIC)
+           detect_eol (&coding, buffer, nread);
+         if (CODING_REQUIRE_EOL_CONVERSION (&coding))
+           /* We found that the format of eol should be decoded.
+               Let's give up here.  */
+           {
+             giveup_match_end = 1;
+             break;
+           }
+
          bufpos = 0;
          while (bufpos < nread && same_at_start < ZV
                 && FETCH_BYTE (same_at_start) == buffer[bufpos])
@@ -3272,30 +3277,46 @@ This does code conversion according to the value of\n\
          while (bufpos > 0 && same_at_end > same_at_start
                 && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1])
            same_at_end--, bufpos--;
+
          /* If we found a discrepancy, stop the scan.
             Otherwise loop around and scan the preceding bufferful.  */
          if (bufpos != 0)
-           break;
+           {
+             /* If this discrepancy is because of code conversion,
+                we cannot use this method; giveup and try the other.  */
+             if (same_at_end > same_at_start
+                 && FETCH_BYTE (same_at_end - 1) >= 0200
+                 && ! NILP (current_buffer->enable_multibyte_characters))
+               giveup_match_end = 1;
+             break;
+           }
        }
       immediate_quit = 0;
 
-      /* Don't try to reuse the same piece of text twice.  */
-      overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV);
-      if (overlap > 0)
-       same_at_end += overlap;
+      if (! giveup_match_end)
+       {
+         /* We win!  We can handle REPLACE the optimized way.  */
 
-      /* Arrange to read only the nonmatching middle part of the file.  */
-      XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV));
-      XSETFASTINT (end, XINT (end) - (ZV - same_at_end));
+         /* Don't try to reuse the same piece of text twice.  */
+         overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV);
+         if (overlap > 0)
+           same_at_end += overlap;
 
-      del_range_1 (same_at_start, same_at_end, 0);
-      /* Insert from the file at the proper position.  */
-      SET_PT (same_at_start);
+         /* Arrange to read only the nonmatching middle part of the file.  */
+         XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV));
+         XSETFASTINT (end, XINT (end) - (ZV - same_at_end));
 
-      /* If display currently starts at beginning of line,
-        keep it that way.  */
-      if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
-       XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+         del_range_1 (same_at_start, same_at_end, 0);
+         /* Insert from the file at the proper position.  */
+         SET_PT (same_at_start);
+
+         /* If display currently starts at beginning of line,
+            keep it that way.  */
+         if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
+           XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+
+         replace_handled = 1;
+       }
     }
 
   /* If requested, replace the accessible part of the buffer
@@ -3307,7 +3328,7 @@ This does code conversion according to the value of\n\
      is needed, in a simple way that needs a lot of memory.
      The preceding if-statement handles the case of no conversion
      in a more optimized way.  */
-  if (!NILP (replace) && CODING_REQUIRE_CONVERSION (&coding))
+  if (!NILP (replace) && ! replace_handled)
     {
       int same_at_start = BEGV;
       int same_at_end = ZV;
@@ -3315,11 +3336,18 @@ This does code conversion according to the value of\n\
       int bufpos;
       /* Make sure that the gap is large enough.  */
       int bufsize = 2 * st.st_size;
-      unsigned char *conversion_buffer = (unsigned char *) malloc (bufsize);
+      unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize);
 
       /* First read the whole file, performing code conversion into
         CONVERSION_BUFFER.  */
 
+      if (lseek (fd, XINT (beg), 0) < 0)
+       {
+         free (conversion_buffer);
+         report_file_error ("Setting file position",
+                            Fcons (filename, Qnil));
+       }
+
       total = st.st_size;      /* Total bytes in the file.  */
       how_much = 0;            /* Bytes read from file so far.  */
       inserted = 0;            /* Bytes put into CONVERSION_BUFFER so far.  */
@@ -3358,7 +3386,7 @@ This does code conversion according to the value of\n\
              if (inserted + require + 2 * (total - how_much) > bufsize)
                {
                  bufsize = inserted + require + 2 * (total - how_much);
-                 conversion_buffer = (unsigned char *) realloc (conversion_buffer, bufsize);
+                 conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize);
                }
 
              /* Convert this batch with results in CONVERSION_BUFFER.  */
@@ -3430,36 +3458,41 @@ This does code conversion according to the value of\n\
       if (overlap > 0)
        same_at_end += overlap;
 
+      /* If display currently starts at beginning of line,
+        keep it that way.  */
+      if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
+       XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+
       /* 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 - same_at_end) + (same_at_start - BEG);
       move_gap (same_at_start);
       del_range_1 (same_at_start, same_at_end, 0);
-      make_gap (inserted);
-      insert (conversion_buffer + same_at_start - BEG, inserted);
+      SET_PT (same_at_start);
+      insert_1 (conversion_buffer + same_at_start - BEG, inserted, 0, 0);
 
       free (conversion_buffer);
       close (fd);
       specpdl_ptr--;
 
-      /* If display currently starts at beginning of line,
-        keep it that way.  */
-      if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
-       XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
       goto handled;
     }
 
-  total = XINT (end) - XINT (beg);
+  if (! not_regular)
+    {
+      register Lisp_Object temp;
 
-  {
-    register Lisp_Object temp;
+      total = XINT (end) - XINT (beg);
 
-    /* Make sure point-max won't overflow after this insertion.  */
-    XSETINT (temp, total);
-    if (total != XINT (temp))
-      error ("maximum buffer size exceeded");
-  }
+      /* Make sure point-max won't overflow after this insertion.  */
+      XSETINT (temp, total);
+      if (total != XINT (temp))
+       error ("Maximum buffer size exceeded");
+    }
+  else
+    /* For a special file, all we can do is guess.  */
+    total = READ_BUF_SIZE;
 
   if (NILP (visit) && total > 0)
     prepare_to_modify_buffer (PT, PT);
@@ -3503,7 +3536,13 @@ This does code conversion according to the value of\n\
          break;
        }
 
-      how_much += this;
+      /* For a regular file, where TOTAL is the real size,
+        count HOW_MUCH to compare with it.
+        For a special file, where TOTAL is just a buffer size,
+        so don't bother counting in HOW_MUCH.
+        (INSERTED is where we count the number of characters inserted.)  */
+      if (! not_regular)
+       how_much += this;
 
       if (CODING_REQUIRE_CONVERSION (&coding))
        {
@@ -3514,8 +3553,21 @@ This does code conversion according to the value of\n\
          require = decoding_buffer_size (&coding, this);
          if (GAP_SIZE < require)
            make_gap (require - GAP_SIZE);
-         if (how_much >= total)  /* This is the last block.  */
-           coding.last_block = 1;
+
+         if (! not_regular)
+           {
+             if (how_much >= total)  /* This is the last block.  */
+               coding.last_block = 1;
+           }
+         else
+           {
+             /* If we encounter EOF, say it is the last block.  (The
+                data this will apply to is the UNPROCESSED characters
+                carried over from the last batch.)  */
+             if (this == 0)
+               coding.last_block = 1;
+           }
+
          produced = decode_coding (&coding, read_buf,
                                    POS_ADDR (PT + inserted - 1) + 1,
                                    this, GAP_SIZE, &consumed);
@@ -3637,7 +3689,11 @@ This does code conversion according to the value of\n\
       inserted = XFASTINT (insval);
     }
 
-  if (inserted > 0 && NILP (visit) && total > 0)
+  /* 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.  */
+  if (inserted > 0 && total > 0
+      && (NILP (visit) || !NILP (replace)))
     signal_after_change (PT, 0, inserted);
 
   if (inserted > 0)
@@ -3690,8 +3746,8 @@ build_annotations_unwind (buf)
   return Qnil;
 }
 
-DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6,
-  "r\nFWrite region to file: ",
+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\
@@ -3707,13 +3763,17 @@ 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.\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)
+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;
@@ -3744,7 +3804,42 @@ This does code conversion according to the value of\n\
   if (!NILP (start) && !STRINGP (start))
     validate_region (&start, &end);
 
-  GCPRO3 (filename, visit, lockname);
+  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);
+    else
+      {
+       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_coding_system (7, args);
+       val = (CONSP (coding_systems)
+              ? XCONS (coding_systems)->cdr
+              : Fsymbol_value (Qbuffer_file_coding_system));
+      }
+    setup_coding_system (Fcheck_coding_system (val), &coding); 
+    if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+      coding.selective = 1;
+#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);
@@ -3785,38 +3880,6 @@ This does code conversion according to the value of\n\
       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);
-    else
-      {
-       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_coding_system (7, args);
-       val = (CONSP (coding_systems)
-              ? XCONS (coding_systems)->cdr
-              : Fsymbol_value (Qbuffer_file_coding_system));
-      }
-    setup_coding_system (Fcheck_coding_system (val), &coding); 
-    if (!STRINGP (start) && !NILP (current_buffer->selective_display))
-      coding.selective = 1;
-#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))
     {
@@ -3953,6 +4016,14 @@ This does code conversion according to the value of\n\
  */
   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;
@@ -3991,6 +4062,7 @@ This does code conversion according to the value of\n\
   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;
     }
@@ -4171,14 +4243,10 @@ build_annotations (start, end, 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);
+      annotations = (current_buffer != given_buffer
+                    ? res
+                    : merge (annotations, res, Qcar_less_than_car));
     }
 
   UNGCPRO;
@@ -4253,14 +4321,6 @@ e_write (desc, addr, len, coding)
       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);
@@ -4397,7 +4457,7 @@ auto_save_1 ()
   return
     Fwrite_region (Qnil, Qnil,
                   current_buffer->auto_save_file_name,
-                  Qnil, Qlambda, Qnil);
+                  Qnil, Qlambda, Qnil, Qnil);
 }
 
 static Lisp_Object
@@ -4798,7 +4858,7 @@ DIR defaults to current buffer's directory default.")
   GCPRO2 (insdef, default_filename);
   val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
                          dir, mustmatch, insdef1,
-                         Qfile_name_history);
+                         Qfile_name_history, default_filename);
 
 #ifdef VMS
   unbind_to (count, Qnil);
@@ -4866,7 +4926,7 @@ DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
   val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
                          dir, mustmatch,
                          insert_default_directory ? insdef : Qnil,
-                         Qfile_name_history);
+                         Qfile_name_history, Qnil);
 
 #ifdef VMS
   unbind_to (count, Qnil);