(byte-compile-lambda):
[bpt/emacs.git] / src / fileio.c
index 01de4f3..23a0d8d 100644 (file)
@@ -35,8 +35,6 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include <perror.h>
 #include <stddef.h>
 #include <string.h>
-#else
-#include <sys/dir.h>
 #endif
 
 #include <errno.h>
@@ -54,6 +52,7 @@ extern int sys_nerr;
 #endif
 
 #include "lisp.h"
+#include "intervals.h"
 #include "buffer.h"
 #include "window.h"
 
@@ -130,6 +129,11 @@ close_file_unwind (fd)
   close (XFASTINT (fd));
 }
 \f
+Lisp_Object Qexpand_file_name;
+Lisp_Object Qdirectory_file_name;
+Lisp_Object Qfile_name_directory;
+Lisp_Object Qfile_name_nondirectory;
+Lisp_Object Qfile_name_as_directory;
 Lisp_Object Qcopy_file;
 Lisp_Object Qmake_directory;
 Lisp_Object Qdelete_directory;
@@ -169,7 +173,7 @@ find_file_handler (filename)
          Lisp_Object string;
          string = XCONS (elt)->car;
          if (XTYPE (string) == Lisp_String
-             && fast_string_match (string, filename))
+             && fast_string_match (string, filename) >= 0)
            return XCONS (elt)->cdr;
        }
     }
@@ -188,9 +192,16 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.")
 {
   register unsigned char *beg;
   register unsigned char *p;
+  Lisp_Object handler;
 
   CHECK_STRING (file, 0);
 
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = find_file_handler (file);
+  if (!NILP (handler))
+    return call2 (handler, Qfile_name_directory, file);
+
   beg = XSTRING (file)->data;
   p = beg + XSTRING (file)->size;
 
@@ -215,9 +226,16 @@ or the entire name if it contains no slash.")
      Lisp_Object file;
 {
   register unsigned char *beg, *p, *end;
+  Lisp_Object handler;
 
   CHECK_STRING (file, 0);
 
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = find_file_handler (file);
+  if (!NILP (handler))
+    return call2 (handler, Qfile_name_nondirectory, file);
+
   beg = XSTRING (file)->data;
   end = p = beg + XSTRING (file)->size;
 
@@ -316,10 +334,18 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
      Lisp_Object file;
 {
   char *buf;
+  Lisp_Object handler;
 
   CHECK_STRING (file, 0);
   if (NILP (file))
     return Qnil;
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = find_file_handler (file);
+  if (!NILP (handler))
+    return call2 (handler, Qfile_name_as_directory, file);
+
   buf = (char *) alloca (XSTRING (file)->size + 10);
   return build_string (file_name_as_directory (buf, XSTRING (file)->data));
 }
@@ -442,9 +468,11 @@ directory_file_name (src, dst)
                  && (ptr[rlen] == ']' || ptr[rlen] == '>')
                  && ptr[rlen - 1] == '.')
                {
-                 ptr[rlen - 1] = ']';
-                 ptr[rlen] = '\0';
-                 return directory_file_name (ptr, dst);
+                 char * buf = (char *) alloca (strlen (ptr) + 1);
+                 strcpy (buf, ptr);
+                 buf[rlen - 1] = ']';
+                 buf[rlen] = '\0';
+                 return directory_file_name (buf, dst);
                }
              else
                dst[slen - 1] = ':';
@@ -481,11 +509,19 @@ it returns a file name such as \"[X]Y.DIR.1\".")
      Lisp_Object directory;
 {
   char *buf;
+  Lisp_Object handler;
 
   CHECK_STRING (directory, 0);
 
   if (NILP (directory))
     return Qnil;
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = find_file_handler (directory);
+  if (!NILP (handler))
+    return call2 (handler, Qdirectory_file_name, directory);
+
 #ifdef VMS
   /* 20 extra chars is insufficient for VMS, since we might perform a
      logical name translation. an equivalence string can be up to 255
@@ -541,9 +577,16 @@ See also the function `substitute-in-file-name'.")
   int lbrack = 0, rbrack = 0;
   int dots = 0;
 #endif /* VMS */
+  Lisp_Object handler;
   
   CHECK_STRING (name, 0);
 
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = find_file_handler (name);
+  if (!NILP (handler))
+    return call3 (handler, Qexpand_file_name, name, defalt);
+
 #ifdef VMS
   /* Filenames on VMS are always upper case.  */
   name = Fupcase (name);
@@ -1452,9 +1495,13 @@ A prefix arg makes KEEP-TIME non-nil.")
   filename = Fexpand_file_name (filename, Qnil);
   newname = Fexpand_file_name (newname, Qnil);
 
-  /* If the file name has special constructs in it,
+  /* If the input file name has special constructs in it,
      call the corresponding file handler.  */
   handler = find_file_handler (filename);
+  if (!NILP (handler))
+    return call3 (handler, Qcopy_file, filename, newname);
+  /* Likewise for output file name.  */
+  handler = find_file_handler (newname);
   if (!NILP (handler))
     return call3 (handler, Qcopy_file, filename, newname);
 
@@ -1829,9 +1876,9 @@ See also `file-readable-p' and `file-attributes'.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call2 (handler, Qfile_exists_p, filename);
+    return call2 (handler, Qfile_exists_p, abspath);
 
   return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
 }
@@ -1851,9 +1898,9 @@ For directories this means you can change to that directory.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call2 (handler, Qfile_executable_p, filename);
+    return call2 (handler, Qfile_executable_p, abspath);
 
   return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
 }
@@ -1872,9 +1919,9 @@ See also `file-exists-p' and `file-attributes'.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call2 (handler, Qfile_readable_p, filename);
+    return call2 (handler, Qfile_readable_p, abspath);
 
   return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
 }
@@ -1941,9 +1988,9 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call2 (handler, Qfile_writable_p, filename);
+    return call2 (handler, Qfile_writable_p, abspath);
 
   if (access (XSTRING (abspath)->data, 0) >= 0)
     return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
@@ -1971,9 +2018,9 @@ if the directory so specified exists and really is a directory.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call2 (handler, Qfile_directory_p, filename);
+    return call2 (handler, Qfile_directory_p, abspath);
 
   if (stat (XSTRING (abspath)->data, &st) < 0)
     return Qnil;
@@ -2018,9 +2065,9 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call2 (handler, Qfile_modes, filename);
+    return call2 (handler, Qfile_modes, abspath);
 
   if (stat (XSTRING (abspath)->data, &st) < 0)
     return Qnil;
@@ -2041,9 +2088,9 @@ Only the 12 low bits of MODE are used.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = find_file_handler (filename);
+  handler = find_file_handler (abspath);
   if (!NILP (handler))
-    return call3 (handler, Qset_file_modes, filename, mode);
+    return call3 (handler, Qset_file_modes, abspath, mode);
 
 #ifndef APOLLO
   if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
@@ -2133,12 +2180,16 @@ otherwise, if FILE2 does not exist, the answer is t.")
   struct stat st;
   int mtime1;
   Lisp_Object handler;
+  struct gcpro gcpro1, gcpro2;
 
   CHECK_STRING (file1, 0);
   CHECK_STRING (file2, 0);
 
+  abspath1 = Qnil;
+  GCPRO2 (abspath1, file2);
   abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
   abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
+  UNGCPRO;
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
@@ -2270,8 +2321,13 @@ before the error is signaled.")
     }
 
   if (inserted > 0)
-    MODIFF++;
-  record_insert (point, inserted);
+    {
+      record_insert (point, inserted);
+
+      /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
+      offset_intervals (current_buffer, point, inserted);
+      MODIFF++;
+    }
 
   close (fd);
 
@@ -2330,6 +2386,9 @@ Optional fifth argument VISIT if t means\n\
   and mark buffer not modified.\n\
 If VISIT is neither t nor nil, it means do not print\n\
   the \"Wrote file\" message.\n\
+If VISIT is a string, it is a second file name;\n\
+  the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
+  VISIT is also the file name to lock and unlock for clash detection.\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)
@@ -2346,6 +2405,8 @@ to the file, instead of any buffer contents, and END is ignored.")
   unsigned char *fname = 0;    /* If non-0, original filename (must rename) */
 #endif /* VMS */
   Lisp_Object handler;
+  Lisp_Object visit_file = XTYPE (visit) == Lisp_String ? visit : filename;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   /* Special kludge to simplify auto-saving */
   if (NILP (start))
@@ -2356,8 +2417,8 @@ to the file, instead of any buffer contents, and END is ignored.")
   else if (XTYPE (start) != Lisp_String)
     validate_region (&start, &end);
 
+  GCPRO4 (start, filename, visit, visit_file);
   filename = Fexpand_file_name (filename, Qnil);
-  fn = XSTRING (filename)->data;
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
@@ -2379,21 +2440,23 @@ to the file, instead of any buffer contents, and END is ignored.")
       /* Do this before reporting IO error
         to avoid a "file has changed on disk" warning on
         next attempt to save.  */
-      if (EQ (visit, Qt))
+      if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
        {
          current_buffer->modtime = 0;
          current_buffer->save_modified = MODIFF;
          XFASTINT (current_buffer->save_length) = Z - BEG;
-         current_buffer->filename = filename;
+         current_buffer->filename = visit_file;
        }
+      UNGCPRO;
       return val;
     }
 
 #ifdef CLASH_DETECTION
   if (!auto_saving)
-    lock_file (filename);
+    lock_file (visit_file);
 #endif /* CLASH_DETECTION */
 
+  fn = XSTRING (filename)->data;
   desc = -1;
   if (!NILP (append))
     desc = open (fn, O_WRONLY);
@@ -2448,11 +2511,13 @@ to the file, instead of any buffer contents, and END is ignored.")
   desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
 #endif /* not VMS */
 
+  UNGCPRO;
+
   if (desc < 0)
     {
 #ifdef CLASH_DETECTION
       save_errno = errno;
-      if (!auto_saving) unlock_file (filename);
+      if (!auto_saving) unlock_file (visit_file);
       errno = save_errno;
 #endif /* CLASH_DETECTION */
       report_file_error ("Opening output file", Fcons (filename, Qnil));
@@ -2464,7 +2529,7 @@ to the file, instead of any buffer contents, and END is ignored.")
     if (lseek (desc, 0, 2) < 0)
       {
 #ifdef CLASH_DETECTION
-       if (!auto_saving) unlock_file (filename);
+       if (!auto_saving) unlock_file (visit_file);
 #endif /* CLASH_DETECTION */
        report_file_error ("Lseek error", Fcons (filename, Qnil));
       }
@@ -2572,29 +2637,29 @@ to the file, instead of any buffer contents, and END is ignored.")
 
 #ifdef CLASH_DETECTION
   if (!auto_saving)
-    unlock_file (filename);
+    unlock_file (visit_file);
 #endif /* CLASH_DETECTION */
 
   /* Do this before reporting IO error
      to avoid a "file has changed on disk" warning on
      next attempt to save.  */
-  if (EQ (visit, Qt))
+  if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
     current_buffer->modtime = st.st_mtime;
 
   if (failure)
     error ("IO error writing %s: %s", fn, err_str (save_errno));
 
-  if (EQ (visit, Qt))
+  if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
     {
       current_buffer->save_modified = MODIFF;
       XFASTINT (current_buffer->save_length) = Z - BEG;
-      current_buffer->filename = filename;
+      current_buffer->filename = visit_file;
     }
   else if (!NILP (visit))
     return Qnil;
 
   if (!auto_saving)
-    message ("Wrote %s", fn);
+    message ("Wrote %s", XSTRING (visit_file)->data);
 
   return Qnil;
 }
@@ -2654,7 +2719,7 @@ This means that the file has not been changed since it was visited or saved.")
      call the corresponding file handler.  */
   handler = find_file_handler (b->filename);
   if (!NILP (handler))
-    return call2 (handler, Qverify_visited_file_modtime, b->filename);
+    return call2 (handler, Qverify_visited_file_modtime, buf);
 
   if (stat (XSTRING (b->filename)->data, &st) < 0)
     {
@@ -2855,36 +2920,46 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte
      lambda for verify final value */
 {
   Lisp_Object name, specdir, realdir, val, orig_string;
+  int changed;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+  realdir = dir;
+  name = string;
+  orig_string = Qnil;
+  specdir = Qnil;
+  changed = 0;
+  /* No need to protect ACTION--we only compare it with t and nil.  */
+  GCPRO4 (string, realdir, name, specdir);
 
   if (XSTRING (string)->size == 0)
     {
-      orig_string = Qnil; 
-      name = string;
-      realdir = dir;
       if (EQ (action, Qlambda))
-       return Qnil;
+       {
+         UNGCPRO;
+         return Qnil;
+       }
     }
   else
     {
       orig_string = string;
       string = Fsubstitute_in_file_name (string);
+      changed = NILP (Fstring_equal (string, orig_string));
       name = Ffile_name_nondirectory (string);
-      realdir = Ffile_name_directory (string);
-      if (NILP (realdir))
-       realdir = dir;
-      else
-       realdir = Fexpand_file_name (realdir, dir);
+      val = Ffile_name_directory (string);
+      if (! NILP (val))
+       realdir = Fexpand_file_name (val, realdir);
     }
 
   if (NILP (action))
     {
       specdir = Ffile_name_directory (string);
       val = Ffile_name_completion (name, realdir);
+      UNGCPRO;
       if (XTYPE (val) != Lisp_String)
        {
-         if (NILP (Fstring_equal (string, orig_string)))
+         if (changed)
            return string;
-         return (val);
+         return val;
        }
 
       if (!NILP (specdir))
@@ -2916,8 +2991,9 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte
          }
       }
 #endif /* Not VMS */
-      return (val);
+      return val;
     }
+  UNGCPRO;
 
   if (EQ (action, Qt))
     return Ffile_name_all_completions (name, realdir);
@@ -3075,6 +3151,11 @@ DIR defaults to current buffer's directory default.")
 \f
 syms_of_fileio ()
 {
+  Qexpand_file_name = intern ("expand-file-name");
+  Qdirectory_file_name = intern ("directory-file-name");
+  Qfile_name_directory = intern ("file-name-directory");
+  Qfile_name_nondirectory = intern ("file-name-nondirectory");
+  Qfile_name_as_directory = intern ("file-name-as-directory");
   Qcopy_file = intern ("copy-file");
   Qmake_directory = intern ("make-directory");
   Qdelete_directory = intern ("delete-directory");
@@ -3156,7 +3237,9 @@ to be handled; the remaining arguments are the arguments that were\n\
 passed to that primitive.  For example, if you do\n\
     (file-exists-p FILENAME)\n\
 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
-    (funcall HANDLER FILENAME)");
+    (funcall HANDLER 'file-exists-p FILENAME)");
+  Vfile_name_handler_alist = Qnil;
+
   defsubr (&Sfile_name_directory);
   defsubr (&Sfile_name_nondirectory);
   defsubr (&Sfile_name_as_directory);
@@ -3204,5 +3287,7 @@ and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
   defsubr (&Sread_file_name_internal);
   defsubr (&Sread_file_name);
 
+#ifdef unix
   defsubr (&Sunix_sync);
+#endif
 }