]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
(xfont_query_font): Adjusted for the change of
[gnu-emacs] / src / fileio.c
index be6bf37ad94bb78a3ea10c46b439888b0b0e47b6..8ce89ba23f3cf6f8b72e3d7716d8e08fbfd6b7af 100644 (file)
@@ -1,6 +1,7 @@
 /* File IO for GNU Emacs.
-   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
-     1999, 2000, 2001, 2003, 2004, 2005  Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
+                 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -224,6 +225,11 @@ int vms_stmlf_recfm;
    expanding file names.  This can be bound to / or \. */
 Lisp_Object Vdirectory_sep_char;
 
+#ifdef HAVE_FSYNC
+/* Nonzero means skip the call to fsync in Fwrite-region.  */
+int write_region_inhibit_fsync;
+#endif
+
 extern Lisp_Object Vuser_login_name;
 
 #ifdef WINDOWSNT
@@ -1059,6 +1065,7 @@ See also the function `substitute-in-file-name'.  */)
 #endif /* DOS_NT */
   int length;
   Lisp_Object handler, result;
+  int multibyte;
 
   CHECK_STRING (name);
 
@@ -1136,6 +1143,7 @@ See also the function `substitute-in-file-name'.  */)
 
   name = FILE_SYSTEM_CASE (name);
   nm = SDATA (name);
+  multibyte = STRING_MULTIBYTE (name);
 
 #ifdef DOS_NT
   /* We will force directory separators to be either all \ or /, so make
@@ -1301,8 +1309,7 @@ See also the function `substitute-in-file-name'.  */)
          if (index (nm, '/'))
            {
              nm = sys_translate_unix (nm);
-             return make_specified_string (nm, -1, strlen (nm),
-                                           STRING_MULTIBYTE (name));
+             return make_specified_string (nm, -1, strlen (nm), multibyte);
            }
 #endif /* VMS */
 #ifdef DOS_NT
@@ -1314,8 +1321,7 @@ See also the function `substitute-in-file-name'.  */)
          if (IS_DIRECTORY_SEP (nm[1]))
            {
              if (strcmp (nm, SDATA (name)) != 0)
-               name = make_specified_string (nm, -1, strlen (nm),
-                                             STRING_MULTIBYTE (name));
+               name = make_specified_string (nm, -1, strlen (nm), multibyte);
            }
          else
 #endif
@@ -1324,8 +1330,7 @@ See also the function `substitute-in-file-name'.  */)
            {
              char temp[] = " :";
 
-             name = make_specified_string (nm, -1, p - nm,
-                                           STRING_MULTIBYTE (name));
+             name = make_specified_string (nm, -1, p - nm, multibyte);
              temp[0] = DRIVE_LETTER (drive);
              name = concat2 (build_string (temp), name);
            }
@@ -1333,8 +1338,7 @@ See also the function `substitute-in-file-name'.  */)
 #else /* not DOS_NT */
          if (nm == SDATA (name))
            return name;
-         return make_specified_string (nm, -1, strlen (nm),
-                                       STRING_MULTIBYTE (name));
+         return make_specified_string (nm, -1, strlen (nm), multibyte);
 #endif /* not DOS_NT */
        }
     }
@@ -1446,6 +1450,7 @@ See also the function `substitute-in-file-name'.  */)
       && !newdir)
     {
       newdir = SDATA (default_directory);
+      multibyte |= STRING_MULTIBYTE (default_directory);
 #ifdef DOS_NT
       /* Note if special escape prefix is present, but remove for now.  */
       if (newdir[0] == '/' && newdir[1] == ':')
@@ -1643,8 +1648,7 @@ See also the function `substitute-in-file-name'.  */)
        {
          *o++ = *p++;
        }
-      else if (IS_DIRECTORY_SEP (p[0])
-              && p[1] == '.'
+      else if (p[1] == '.'
               && (IS_DIRECTORY_SEP (p[2])
                   || p[2] == 0))
        {
@@ -1654,7 +1658,7 @@ See also the function `substitute-in-file-name'.  */)
            *o++ = *p;
          p += 2;
        }
-      else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
+      else if (p[1] == '.' && p[2] == '.'
               /* `/../' is the "superroot" on certain file systems.
                  Turned off on DOS_NT systems because they have no
                  "superroot" and because this causes us to produce
@@ -1674,14 +1678,9 @@ See also the function `substitute-in-file-name'.  */)
            ++o;
          p += 3;
        }
-      else if (p > target
-              && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
-       {
-         /* Collapse multiple `/' in a row.  */
-         *o++ = *p++;
-         while (IS_DIRECTORY_SEP (*p))
-           ++p;
-       }
+      else if (p > target && IS_DIRECTORY_SEP (p[1]))
+       /* Collapse multiple `/' in a row.  */
+       p++;
       else
        {
          *o++ = *p++;
@@ -1711,8 +1710,7 @@ See also the function `substitute-in-file-name'.  */)
   CORRECT_DIR_SEPS (target);
 #endif /* DOS_NT */
 
-  result = make_specified_string (target, -1, o - target,
-                                  STRING_MULTIBYTE (name));
+  result = make_specified_string (target, -1, o - target, multibyte);
 
   /* Again look to see if the file name has special constructs in it
      and perhaps call the corresponding file handler.  This is needed
@@ -2411,32 +2409,31 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
   return;
 }
 
-DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
+DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
        "fCopy file: \nGCopy %s to file: \np\nP",
        doc: /* Copy FILE to NEWNAME.  Both args must be strings.
 If NEWNAME names a directory, copy FILE there.
-Signals a `file-already-exists' error if file NEWNAME already exists,
-unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
-A number as third arg means request confirmation if NEWNAME already exists.
-This is what happens in interactive use with M-x.
-Always sets the file modes of the output file to match the input file.
+
+This function always sets the file modes of the output file to match
+the input file.
+
+The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
+if file NEWNAME already exists.  If OK-IF-ALREADY-EXISTS is nil, we
+signal a `file-already-exists' error without overwriting.  If
+OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
+about overwriting; this is what happens in interactive use with M-x.
+Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
+existing file.
 
 Fourth arg KEEP-TIME non-nil means give the output file the same
 last-modified time as the old one.  (This works on only some systems.)
 
 A prefix arg makes KEEP-TIME non-nil.
 
-The optional fifth arg MUSTBENEW, if non-nil, insists on a check
-for an existing file with the same name.  If MUSTBENEW is `excl',
-that means to get an error if the file already exists; never overwrite.
-If MUSTBENEW is neither nil nor `excl', that means ask for
-confirmation before overwriting, but do go ahead and overwrite the file
-if the user confirms.
-
 If PRESERVE-UID-GID is non-nil, we try to transfer the
 uid and gid of FILE to NEWNAME.  */)
-  (file, newname, ok_if_already_exists, keep_time, mustbenew, preserve_uid_gid)
-     Lisp_Object file, newname, ok_if_already_exists, keep_time, mustbenew;
+  (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid)
+     Lisp_Object file, newname, ok_if_already_exists, keep_time;
      Lisp_Object preserve_uid_gid;
 {
   int ifd, ofd, n;
@@ -2453,9 +2450,6 @@ uid and gid of FILE to NEWNAME.  */)
   CHECK_STRING (file);
   CHECK_STRING (newname);
 
-  if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
-    barf_or_query_if_file_exists (newname, "overwrite", 1, 0, 1);
-
   if (!NILP (Ffile_directory_p (newname)))
     newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
   else
@@ -2558,12 +2552,12 @@ uid and gid of FILE to NEWNAME.  */)
   /* System's default file type was set to binary by _fmode in emacs.c.  */
   ofd = emacs_open (SDATA (encoded_newname),
                    O_WRONLY | O_TRUNC | O_CREAT
-                   | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
+                   | (NILP (ok_if_already_exists) ? O_EXCL : 0),
                    S_IREAD | S_IWRITE);
 #else  /* not MSDOS */
   ofd = emacs_open (SDATA (encoded_newname),
                    O_WRONLY | O_TRUNC | O_CREAT
-                   | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
+                   | (NILP (ok_if_already_exists) ? O_EXCL : 0),
                    0666);
 #endif /* not MSDOS */
 #endif /* VMS */
@@ -2731,8 +2725,10 @@ int
 internal_delete_file (filename)
      Lisp_Object filename;
 {
-  return NILP (internal_condition_case_1 (Fdelete_file, filename,
-                                         Qt, internal_delete_file_1));
+  Lisp_Object tem;
+  tem = internal_condition_case_1 (Fdelete_file, filename,
+                                  Qt, internal_delete_file_1);
+  return NILP (tem);
 }
 \f
 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
@@ -2806,7 +2802,7 @@ This is what happens in interactive use with M-x.  */)
                        /* We have already prompted if it was an integer,
                           so don't have copy-file prompt again.  */
                        NILP (ok_if_already_exists) ? Qnil : Qt,
-                       Qt, Qnil, Qt);
+                       Qt, Qt);
 
          Fdelete_file (file);
        }
@@ -3393,8 +3389,10 @@ searchable directory.  */)
 }
 
 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
-       doc: /* Return t if file FILENAME is the name of a regular file.
-This is the sort of file that holds an ordinary stream of data bytes.  */)
+       doc: /* Return t if FILENAME names a regular file.
+This is the sort of file that holds an ordinary stream of data bytes.
+Symbolic links to regular files count as regular files.
+See `file-symlink-p' to distinguish symlinks.  */)
      (filename)
      Lisp_Object filename;
 {
@@ -4291,13 +4289,8 @@ actually used.  */)
         if we couldn't read the file.  */
 
       if (how_much < 0)
-       {
-         if (how_much == -1)
-           error ("IO error reading %s: %s",
-                  SDATA (orig_filename), emacs_strerror (errno));
-         else if (how_much == -2)
-           error ("maximum buffer size exceeded");
-       }
+       error ("IO error reading %s: %s",
+              SDATA (orig_filename), emacs_strerror (errno));
 
       if (unprocessed > 0)
        {
@@ -4395,6 +4388,8 @@ actually used.  */)
                          same_at_start_charpos, inserted_chars, 0);
       /* Set `inserted' to the number of inserted characters.  */
       inserted = PT - temp;
+      /* Set point before the inserted characters.  */
+      SET_PT_BOTH (temp, same_at_start);
 
       unbind_to (this_count, Qnil);
 
@@ -4527,6 +4522,8 @@ actually used.  */)
 #endif
       Vdeactivate_mark = old_Vdeactivate_mark;
     }
+  else
+    Vdeactivate_mark = Qt;
 
   /* Make the text read part of the buffer.  */
   GAP_SIZE -= inserted;
@@ -4892,10 +4889,8 @@ choose_write_coding_system (start, end, filename,
        val = raw_text_coding_system (val);
     }
 
+  val = coding_inherit_eol_type (val, Qnil);
   setup_coding_system (val, coding);
-  if (! NILP (val)
-      && VECTORP (CODING_ID_EOL_TYPE (coding->id)))
-    val = AREF (CODING_ID_EOL_TYPE (coding->id), 0);
 
   if (!STRINGP (start) && !NILP (current_buffer->selective_display))
     coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
@@ -4968,6 +4963,7 @@ This does code conversion according to the value of
   if (!NILP (start) && !STRINGP (start))
     validate_region (&start, &end);
 
+  visit_file = Qnil;
   GCPRO5 (start, filename, visit, visit_file, lockname);
 
   filename = Fexpand_file_name (filename, Qnil);
@@ -5241,7 +5237,7 @@ This does code conversion according to the value of
      Disk full in NFS may be reported here.  */
   /* mib says that closing the file will try to write as fast as NFS can do
      it, and that means the fsync here is not crucial for autosave files.  */
-  if (!auto_saving && fsync (desc) < 0)
+  if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
     {
       /* If fsync fails with EINTR, don't treat that as serious.  */
       if (errno != EINTR)
@@ -5684,6 +5680,8 @@ auto_save_error (error)
   Lisp_Object args[3], msg;
   int i, nbytes;
   struct gcpro gcpro1;
+  char *msgbuf;
+  USE_SAFE_ALLOCA;
 
   ring_bell ();
 
@@ -5693,16 +5691,19 @@ auto_save_error (error)
   msg = Fformat (3, args);
   GCPRO1 (msg);
   nbytes = SBYTES (msg);
+  SAFE_ALLOCA (msgbuf, char *, nbytes);
+  bcopy (SDATA (msg), msgbuf, nbytes);
 
   for (i = 0; i < 3; ++i)
     {
       if (i == 0)
-       message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
+       message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
       else
-       message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
+       message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
       Fsleep_for (make_number (1), Qnil);
     }
 
+  SAFE_FREE ();
   UNGCPRO;
   return Qnil;
 }
@@ -5734,13 +5735,13 @@ auto_save_1 ()
 }
 
 static Lisp_Object
-do_auto_save_unwind (stream)  /* used as unwind-protect function */
-     Lisp_Object stream;
+do_auto_save_unwind (arg)  /* used as unwind-protect function */
+     Lisp_Object arg;
 {
+  FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
   auto_saving = 0;
-  if (!NILP (stream))
-    fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
-                     | XFASTINT (XCDR (stream))));
+  if (stream != NULL)
+    fclose (stream);
   return Qnil;
 }
 
@@ -5785,8 +5786,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer.  */)
   int auto_saved = 0;
   int do_handled_files;
   Lisp_Object oquit;
-  FILE *stream;
-  Lisp_Object lispstream;
+  FILE *stream = NULL;
   int count = SPECPDL_INDEX ();
   int orig_minibuffer_auto_raise = minibuffer_auto_raise;
   int old_message_p = 0;
@@ -5838,24 +5838,10 @@ A non-nil CURRENT-ONLY argument means save only current buffer.  */)
        }
 
       stream = fopen (SDATA (listfile), "w");
-      if (stream != NULL)
-       {
-         /* Arrange to close that file whether or not we get an error.
-            Also reset auto_saving to 0.  */
-         lispstream = Fcons (Qnil, Qnil);
-         XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
-         XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
-       }
-      else
-       lispstream = Qnil;
-    }
-  else
-    {
-      stream = NULL;
-      lispstream = Qnil;
     }
 
-  record_unwind_protect (do_auto_save_unwind, lispstream);
+  record_unwind_protect (do_auto_save_unwind,
+                        make_save_value (stream, 0));
   record_unwind_protect (do_auto_save_unwind_1,
                         make_number (minibuffer_auto_raise));
   minibuffer_auto_raise = 0;
@@ -6154,13 +6140,17 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte
 #endif
        {
          /* Must do it the hard (and slow) way.  */
+         Lisp_Object tem;
          GCPRO3 (all, comp, specdir);
          count = SPECPDL_INDEX ();
          record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
          current_buffer->directory = realdir;
          for (comp = Qnil; CONSP (all); all = XCDR (all))
-           if (!NILP (call1 (Vread_file_name_predicate, XCAR (all))))
-             comp = Fcons (XCAR (all), comp);
+           {
+             tem = call1 (Vread_file_name_predicate, XCAR (all));
+             if (!NILP (tem))
+               comp = Fcons (XCAR (all), comp);
+           }
          unbind_to (count, Qnil);
          UNGCPRO;
        }
@@ -6670,6 +6660,14 @@ shortly after Emacs reads your `.emacs' file, if you have not yet given it
 a non-nil value.  */);
   Vauto_save_list_file_name = Qnil;
 
+#ifdef HAVE_FSYNC
+  DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
+              doc: /* *Non-nil means don't call fsync in `write-region'.
+This variable affects calls to `write-region' as well as save commands.
+A non-nil value may result in data loss!  */);
+  write_region_inhibit_fsync = 0;
+#endif
+
   defsubr (&Sfind_file_name_handler);
   defsubr (&Sfile_name_directory);
   defsubr (&Sfile_name_nondirectory);