diff src/fileio.c @ 5494:1ea2b4351945

[MSDOS]: #include "msdos.h" and <sys/param.h> needed for the following changes. (Ffile_name_directory, Fexpand_file_name) [FILE_SYSTEM_CASE]: Apply case conversion if defined. (Ffile_name_directory, Ffile_name_nondirectory, file_name_as_directory, directory_file_name, Fexpand_file_name, Fsubstitute_in_file_name, expand_and_dir_to_file) [MSDOS]: Drive letter support. (Fexpand_file_name) [MSDOS]: Support for multiple default directories. (Ffile_writeable_p) [MSDOS]: Don't call access with file name ending in slash. (Finsert_file_contents) [MSDOS]: Determine file type by name (call find-buffer-file-type) and change CR+LF to LF if it is a text file. (Fwrite_region) [MSDOS]: Use text/binary mode as specified by buffer_file_type. (syms_of_fileio) [MSDOS]: Set Qfind_buffer_file_type. (Fsubstitute_in_file_name) [MSDOS]: Ignore case in environtment variable.

--- a/src/fileio.c	Sat Jan 08 08:48:32 1994 +0000
+++ b/src/fileio.c	Sat Jan 08 09:15:49 1994 +0000
@@ -36,6 +36,11 @@
 #include <pwd.h>
 #endif
 
+#ifdef MSDOS
+#include "msdos.h"
+#include <sys/param.h>
+#endif
+
 #include <ctype.h>
 
 #ifdef VMS
@@ -237,6 +242,9 @@
   if (!NILP (handler))
     return call2 (handler, Qfile_name_directory, file);
 
+#ifdef FILE_SYSTEM_CASE
+  file = FILE_SYSTEM_CASE (file);
+#endif
   beg = XSTRING (file)->data;
   p = beg + XSTRING (file)->size;
 
@@ -244,10 +252,31 @@
 #ifdef VMS
 	 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
 #endif /* VMS */
+#ifdef MSDOS
+	 && p[-1] != ':'
+#endif
 	 ) p--;
 
   if (p == beg)
     return Qnil;
+#ifdef MSDOS
+  /* Expansion of "c:" to drive and default directory.  */
+  if (p == beg + 2 && beg[1] == ':')
+    {
+      int drive = (*beg) - 'a';
+      /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
+      unsigned char *res = alloca (MAXPATHLEN + 5);
+      if (getdefdir (drive + 1, res + 2)) 
+	{
+	  res[0] = drive + 'a';
+	  res[1] = ':';
+	  if (res[strlen (res) - 1] != '/')
+	    strcat (res, "/");
+	  beg = res;
+	  p = beg + strlen (beg);
+	}
+    }
+#endif
   return make_string (beg, p - beg);
 }
 
@@ -278,6 +307,9 @@
 #ifdef VMS
 	 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
 #endif /* VMS */
+#ifdef MSDOS
+	 && p[-1] != ':'
+#endif
 	 ) p--;
 
   return make_string (p, end - p);
@@ -373,7 +405,11 @@
     }
 #else /* not VMS */
   /* For Unix syntax, Append a slash if necessary */
+#ifdef MSDOS
+  if (out[size] != ':' && out[size] != '/')
+#else
   if (out[size] != '/')
+#endif
     strcat (out, "/");
 #endif /* not VMS */
   return out;
@@ -549,7 +585,12 @@
   /* Process as Unix format: just remove any final slash.
      But leave "/" unchanged; do not change it to "".  */
   strcpy (dst, src);
-  if (slen > 1 && dst[slen - 1] == '/')
+  if (slen > 1 
+      && dst[slen - 1] == '/'
+#ifdef MSDOS
+      && dst[slen - 2] != ':'
+#endif
+      )
     dst[slen - 1] = 0;
   return 1;
 }
@@ -634,6 +675,11 @@
   int lbrack = 0, rbrack = 0;
   int dots = 0;
 #endif /* VMS */
+#ifdef MSDOS	/* Demacs 1.1.2 91/10/20 Manabu Higashida */
+  int drive = -1;
+  int relpath = 0;
+  unsigned char *tmp, *defdir;
+#endif
   Lisp_Object handler;
   
   CHECK_STRING (name, 0);
@@ -674,9 +720,32 @@
   /* Filenames on VMS are always upper case.  */
   name = Fupcase (name);
 #endif
+#ifdef FILE_SYSTEM_CASE
+  name = FILE_SYSTEM_CASE (name);
+#endif
 
   nm = XSTRING (name)->data;
   
+#ifdef MSDOS
+  /* firstly, strip drive name. */
+  {
+    unsigned char *colon = rindex (nm, ':');
+    if (colon)
+      if (nm == colon)
+	nm++;
+      else
+	{
+	  drive = tolower (colon[-1]) - 'a';
+	  nm = colon + 1;
+	  if (*nm != '/')
+	    {
+	      defdir = alloca (MAXPATHLEN + 1);
+	      relpath = getdefdir (drive + 1, defdir);
+	    }
+	}	
+  }
+#endif
+
   /* If nm is absolute, flush ...// and detect /./ and /../.
      If no /./ or /../ we can return right away. */
   if (
@@ -803,9 +872,11 @@
 	  if (index (nm, '/'))
 	    return build_string (sys_translate_unix (nm));
 #endif /* VMS */
+#ifndef MSDOS
 	  if (nm == XSTRING (name)->data)
 	    return name;
 	  return build_string (nm);
+#endif
 	}
     }
 
@@ -823,6 +894,9 @@
 	{
 	  if (!(newdir = (unsigned char *) egetenv ("HOME")))
 	    newdir = (unsigned char *) "";
+#ifdef MSDOS
+	  dostounix_filename (newdir);
+#endif
 	  nm++;
 #ifdef VMS
 	  nm++;			/* Don't leave the slash in nm.  */
@@ -859,11 +933,18 @@
 #ifdef VMS
       && !index (nm, ':')
 #endif /* not VMS */
+#ifdef MSDOS
+      && drive == -1
+#endif
       && !newdir)
     {
       newdir = XSTRING (defalt)->data;
     }
 
+#ifdef MSDOS
+  if (newdir == 0 && relpath)
+    newdir = defdir; 
+#endif
   if (newdir != 0)
     {
       /* Get rid of any slash at the end of newdir.  */
@@ -871,6 +952,9 @@
       /* Adding `length > 1 &&' makes ~ expand into / when homedir
 	 is the root dir.  People disagree about whether that is right.
 	 Anyway, we can't take the risk of this change now.  */
+#ifdef MSDOS
+      if (newdir[1] != ':' && length > 1)
+#endif
       if (newdir[length - 1] == '/')
 	{
 	  unsigned char *temp = (unsigned char *) alloca (length);
@@ -885,7 +969,12 @@
 
   /* Now concatenate the directory and name to new space in the stack frame */
   tlen += strlen (nm) + 1;
+#ifdef MSDOS
+  /* Add reserved space for drive name.  */
+  target = (unsigned char *) alloca (tlen + 2) + 2;
+#else
   target = (unsigned char *) alloca (tlen);
+#endif
   *target = 0;
 
   if (newdir)
@@ -1001,6 +1090,16 @@
 #endif /* not VMS */
     }
 
+#ifdef MSDOS
+  /* at last, set drive name. */
+  if (target[1] != ':')
+    {
+      target -= 2;
+      target[0] = (drive < 0 ? getdisk () : drive) + 'a';
+      target[1] = ':';
+    }
+#endif
+
   return make_string (target, o - target);
 }
 #if 0
@@ -1377,6 +1476,13 @@
 	  nm = p;
 	  substituted = 1;
 	}
+#ifdef MSDOS
+      if (p[0] && p[1] == ':')
+	{
+	  nm = p;
+	  substituted = 1;
+	}
+#endif /* MSDOS */
     }
 
 #ifdef VMS
@@ -1420,6 +1526,9 @@
 	target = (unsigned char *) alloca (s - o + 1);
 	strncpy (target, o, s - o);
 	target[s - o] = 0;
+#ifdef MSDOS
+	strupr (target); /* $home == $HOME etc.  */
+#endif
 
 	/* Get variable value */
 	o = (unsigned char *) egetenv (target);
@@ -1475,6 +1584,9 @@
 	target = (unsigned char *) alloca (s - o + 1);
 	strncpy (target, o, s - o);
 	target[s - o] = 0;
+#ifdef MSDOS
+	strupr (target); /* $home == $HOME etc.  */
+#endif
 
 	/* Get variable value */
 	o = (unsigned char *) egetenv (target);
@@ -1507,6 +1619,10 @@
 	 )
 	&& p != nm && p[-1] == '/')
       xnm = p;
+#ifdef MSDOS
+    else if (p[0] && p[1] == ':')
+	xnm = p;
+#endif
 
   return make_string (xnm, x - xnm);
 
@@ -1645,7 +1761,12 @@
   /* Create the copy file with the same record format as the input file */
   ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
 #else
+#ifdef MSDOS
+  /* System's default file type was set to binary by _fmode in emacs.c.  */
+  ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE);
+#else /* not MSDOS */
   ofd = creat (XSTRING (newname)->data, 0666);
+#endif /* not MSDOS */
 #endif /* VMS */
   if (ofd < 0)
       report_file_error ("Opening output file", Fcons (newname, Qnil));
@@ -1992,6 +2113,9 @@
       || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
 	  && ptr[1] != '.')
 #endif /* VMS */
+#ifdef MSDOS
+      || (*ptr != 0 && ptr[1] == ':' && ptr[2] == '/')
+#endif
       )
     return Qt;
   else
@@ -2161,6 +2285,10 @@
   if (!NILP (dir))
     dir = Fdirectory_file_name (dir);
 #endif /* VMS */
+#ifdef MSDOS
+  if (!NILP (dir))
+    dir = Fdirectory_file_name (dir);
+#endif /* MSDOS */
   return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
 	   && ! ro_fsys ((char *) XSTRING (dir)->data))
 	  ? Qt : Qnil);
@@ -2371,6 +2499,10 @@
   return (mtime1 > st.st_mtime) ? Qt : Qnil;
 }
 
+#ifdef MSDOS
+Lisp_Object Qfind_buffer_file_type;
+#endif
+
 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
   1, 4, 0,
   "Insert contents of file FILENAME after point.\n\
@@ -2514,6 +2646,31 @@
       inserted += this;
     }
 
+#ifdef MSDOS
+  /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
+  /* Determine file type from name and remove LFs from CR-LFs if the file
+     is deemed to be a text file.  */
+  {
+    struct gcpro gcpro1;
+    Lisp_Object code = Qnil;
+    GCPRO1 (filename);
+    code = call1 (Qfind_buffer_file_type, filename);
+    UNGCPRO;
+    if (XTYPE (code) == Lisp_Int) 
+      XFASTINT (current_buffer->buffer_file_type) = XFASTINT (code);
+    if (XFASTINT (current_buffer->buffer_file_type) == 0)
+      {
+	int reduced_size = 
+	  inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1);
+	ZV -= reduced_size;
+	Z -= reduced_size;
+	GPT -= reduced_size;
+	GAP_SIZE += reduced_size;
+	inserted -= reduced_size;
+      }
+  }
+#endif
+
   if (inserted > 0)
     {
       record_insert (point, inserted);
@@ -2627,6 +2784,10 @@
   Lisp_Object annotations;
   int visiting, quietly;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+#ifdef MSDOS
+  int buffer_file_type
+    = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
+#endif
 
   if (!NILP (start) && !STRINGP (start))
     validate_region (&start, &end);
@@ -2681,7 +2842,11 @@
   fn = XSTRING (filename)->data;
   desc = -1;
   if (!NILP (append))
+#ifdef MSDOS
+    desc = open (fn, O_WRONLY | buffer_file_type);
+#else
     desc = open (fn, O_WRONLY);
+#endif
 
   if (desc < 0)
 #ifdef VMS
@@ -2730,7 +2895,13 @@
 	  desc = creat (fn, 0666);
       }
 #else /* not VMS */
+#ifdef MSDOS
+  desc = open (fn, 
+	       O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, 
+	       S_IREAD | S_IWRITE);
+#else /* not MSDOS */
   desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
+#endif /* not MSDOS */
 #endif /* not VMS */
 
   UNGCPRO;
@@ -3576,6 +3747,11 @@
   Qfile_already_exists = intern("file-already-exists");
   staticpro (&Qfile_already_exists);
 
+#ifdef MSDOS
+  Qfind_buffer_file_type = intern ("find-buffer-file-type");
+  staticpro (&Qfind_buffer_file_type);
+#endif
+
   Qcar_less_than_car = intern ("car-less-than-car");
   staticpro (&Qcar_less_than_car);