/[emacs]/emacs/src/fileio.c
ViewVC logotype

Diff of /emacs/src/fileio.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.449 by pj, Wed Jun 5 05:16:48 2002 UTC revision 1.449.2.1 by miles, Fri Apr 4 06:20:58 2003 UTC
# Line 19  along with GNU Emacs; see the file COPYI Line 19  along with GNU Emacs; see the file COPYI
19  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20  Boston, MA 02111-1307, USA.  */  Boston, MA 02111-1307, USA.  */
21    
 #define _GNU_SOURCE             /* for euidaccess */  
   
22  #include <config.h>  #include <config.h>
23    
24  #if defined (USG5) || defined (BSD_SYSTEM) || defined (GNU_LINUX)  #ifdef HAVE_FCNTL_H
25  #include <fcntl.h>  #include <fcntl.h>
26  #endif  #endif
27    
# Line 74  extern int errno; Line 72  extern int errno;
72  #include <sys/time.h>  #include <sys/time.h>
73  #endif  #endif
74    
 #ifndef USG  
 #ifndef VMS  
 #ifndef BSD4_1  
 #ifndef WINDOWSNT  
 #define HAVE_FSYNC  
 #endif  
 #endif  
 #endif  
 #endif  
   
75  #include "lisp.h"  #include "lisp.h"
76  #include "intervals.h"  #include "intervals.h"
77  #include "buffer.h"  #include "buffer.h"
# Line 200  Lisp_Object Vwrite_region_annotations_so Line 188  Lisp_Object Vwrite_region_annotations_so
188  Lisp_Object Vauto_save_list_file_name;  Lisp_Object Vauto_save_list_file_name;
189    
190  /* Function to call to read a file name.  */  /* Function to call to read a file name.  */
191  Lisp_Object Vread_file_name_function;  Lisp_Object Vread_file_name_function;
192    
193  /* Current predicate used by read_file_name_internal.  */  /* Current predicate used by read_file_name_internal.  */
194  Lisp_Object Vread_file_name_predicate;  Lisp_Object Vread_file_name_predicate;
# Line 250  static int e_write P_ ((int, Lisp_Object Line 238  static int e_write P_ ((int, Lisp_Object
238    
239  void  void
240  report_file_error (string, data)  report_file_error (string, data)
241       char *string;       const char *string;
242       Lisp_Object data;       Lisp_Object data;
243  {  {
244    Lisp_Object errstring;    Lisp_Object errstring;
# Line 269  report_file_error (string, data) Line 257  report_file_error (string, data)
257        default:        default:
258          /* System error messages are capitalized.  Downcase the initial          /* System error messages are capitalized.  Downcase the initial
259             unless it is followed by a slash.  */             unless it is followed by a slash.  */
260          if (XSTRING (errstring)->data[1] != '/')          if (SREF (errstring, 1) != '/')
261            XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);            SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
262    
263          Fsignal (Qfile_error,          Fsignal (Qfile_error,
264                   Fcons (build_string (string), Fcons (errstring, data)));                   Fcons (build_string (string), Fcons (errstring, data)));
# Line 393  on VMS, perhaps instead a string ending Line 381  on VMS, perhaps instead a string ending
381       (filename)       (filename)
382       Lisp_Object filename;       Lisp_Object filename;
383  {  {
384    #ifndef DOS_NT
385      register const unsigned char *beg;
386    #else
387    register unsigned char *beg;    register unsigned char *beg;
388    register unsigned char *p;  #endif
389      register const unsigned char *p;
390    Lisp_Object handler;    Lisp_Object handler;
391    
392    CHECK_STRING (filename);    CHECK_STRING (filename);
# Line 408  on VMS, perhaps instead a string ending Line 400  on VMS, perhaps instead a string ending
400  #ifdef FILE_SYSTEM_CASE  #ifdef FILE_SYSTEM_CASE
401    filename = FILE_SYSTEM_CASE (filename);    filename = FILE_SYSTEM_CASE (filename);
402  #endif  #endif
403    beg = XSTRING (filename)->data;    beg = SDATA (filename);
404  #ifdef DOS_NT  #ifdef DOS_NT
405    beg = strcpy (alloca (strlen (beg) + 1), beg);    beg = strcpy (alloca (strlen (beg) + 1), beg);
406  #endif  #endif
407    p = beg + STRING_BYTES (XSTRING (filename));    p = beg + SBYTES (filename);
408    
409    while (p != beg && !IS_DIRECTORY_SEP (p[-1])    while (p != beg && !IS_DIRECTORY_SEP (p[-1])
410  #ifdef VMS  #ifdef VMS
# Line 455  on VMS, perhaps instead a string ending Line 447  on VMS, perhaps instead a string ending
447    CORRECT_DIR_SEPS (beg);    CORRECT_DIR_SEPS (beg);
448  #endif /* DOS_NT */  #endif /* DOS_NT */
449    
450    if (STRING_MULTIBYTE (filename))    return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
     return make_string (beg, p - beg);  
   return make_unibyte_string (beg, p - beg);  
451  }  }
452    
453  DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,  DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
# Line 469  or the entire name if it contains no sla Line 459  or the entire name if it contains no sla
459       (filename)       (filename)
460       Lisp_Object filename;       Lisp_Object filename;
461  {  {
462    register unsigned char *beg, *p, *end;    register const unsigned char *beg, *p, *end;
463    Lisp_Object handler;    Lisp_Object handler;
464    
465    CHECK_STRING (filename);    CHECK_STRING (filename);
# Line 480  or the entire name if it contains no sla Line 470  or the entire name if it contains no sla
470    if (!NILP (handler))    if (!NILP (handler))
471      return call2 (handler, Qfile_name_nondirectory, filename);      return call2 (handler, Qfile_name_nondirectory, filename);
472    
473    beg = XSTRING (filename)->data;    beg = SDATA (filename);
474    end = p = beg + STRING_BYTES (XSTRING (filename));    end = p = beg + SBYTES (filename);
475    
476    while (p != beg && !IS_DIRECTORY_SEP (p[-1])    while (p != beg && !IS_DIRECTORY_SEP (p[-1])
477  #ifdef VMS  #ifdef VMS
# Line 496  or the entire name if it contains no sla Line 486  or the entire name if it contains no sla
486           )           )
487      p--;      p--;
488    
489    if (STRING_MULTIBYTE (filename))    return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
     return make_string (p, end - p);  
   return make_unibyte_string (p, end - p);  
490  }  }
491    
492  DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,  DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
# Line 602  file_name_as_directory (out, in) Line 590  file_name_as_directory (out, in)
590    /* For Unix syntax, Append a slash if necessary */    /* For Unix syntax, Append a slash if necessary */
591    if (!IS_DIRECTORY_SEP (out[size]))    if (!IS_DIRECTORY_SEP (out[size]))
592      {      {
593        out[size + 1] = DIRECTORY_SEP;        /* Cannot use DIRECTORY_SEP, which could have any value */
594          out[size + 1] = '/';
595        out[size + 2] = '\0';        out[size + 2] = '\0';
596      }      }
597  #ifdef DOS_NT  #ifdef DOS_NT
# Line 614  file_name_as_directory (out, in) Line 603  file_name_as_directory (out, in)
603    
604  DEFUN ("file-name-as-directory", Ffile_name_as_directory,  DEFUN ("file-name-as-directory", Ffile_name_as_directory,
605         Sfile_name_as_directory, 1, 1, 0,         Sfile_name_as_directory, 1, 1, 0,
606         doc: /* Return a string representing file FILENAME interpreted as a directory.         doc: /* Return a string representing the file name FILE interpreted as a directory.
607  This operation exists because a directory is also a file, but its name as  This operation exists because a directory is also a file, but its name as
608  a directory is different from its name as a file.  a directory is different from its name as a file.
609  The result can be used as the value of `default-directory'  The result can be used as the value of `default-directory'
# Line 637  On VMS, converts \"[X]FOO.DIR\" to \"[X. Line 626  On VMS, converts \"[X]FOO.DIR\" to \"[X.
626    if (!NILP (handler))    if (!NILP (handler))
627      return call2 (handler, Qfile_name_as_directory, file);      return call2 (handler, Qfile_name_as_directory, file);
628    
629    buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10);    buf = (char *) alloca (SBYTES (file) + 10);
630    return build_string (file_name_as_directory (buf, XSTRING (file)->data));    file_name_as_directory (buf, SDATA (file));
631      return make_specified_string (buf, -1, strlen (buf),
632                                    STRING_MULTIBYTE (file));
633  }  }
634    
635  /*  /*
# Line 833  it returns a file name such as \"[X]Y.DI Line 824  it returns a file name such as \"[X]Y.DI
824    /* 20 extra chars is insufficient for VMS, since we might perform a    /* 20 extra chars is insufficient for VMS, since we might perform a
825       logical name translation. an equivalence string can be up to 255       logical name translation. an equivalence string can be up to 255
826       chars long, so grab that much extra space...  - sss */       chars long, so grab that much extra space...  - sss */
827    buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255);    buf = (char *) alloca (SBYTES (directory) + 20 + 255);
828  #else  #else
829    buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);    buf = (char *) alloca (SBYTES (directory) + 20);
830  #endif  #endif
831    directory_file_name (XSTRING (directory)->data, buf);    directory_file_name (SDATA (directory), buf);
832    return build_string (buf);    return make_specified_string (buf, -1, strlen (buf),
833                                    STRING_MULTIBYTE (directory));
834  }  }
835    
836  static char make_temp_name_tbl[64] =  static char make_temp_name_tbl[64] =
# Line 856  static char make_temp_name_tbl[64] = Line 848  static char make_temp_name_tbl[64] =
848  static unsigned make_temp_name_count, make_temp_name_count_initialized_p;  static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
849    
850  /* Value is a temporary file name starting with PREFIX, a string.  /* Value is a temporary file name starting with PREFIX, a string.
851      
852     The Emacs process number forms part of the result, so there is     The Emacs process number forms part of the result, so there is
853     no danger of generating a name being used by another process.     no danger of generating a name being used by another process.
854     In addition, this function makes an attempt to choose a name     In addition, this function makes an attempt to choose a name
855     which has no existing file.  To make this work, PREFIX should be     which has no existing file.  To make this work, PREFIX should be
856     an absolute file name.     an absolute file name.
857      
858     BASE64_P non-zero means add the pid as 3 characters in base64     BASE64_P non-zero means add the pid as 3 characters in base64
859     encoding.  In this case, 6 characters will be added to PREFIX to     encoding.  In this case, 6 characters will be added to PREFIX to
860     form the file name.  Otherwise, if Emacs is running on a system     form the file name.  Otherwise, if Emacs is running on a system
# Line 882  make_temp_name (prefix, base64_p) Line 874  make_temp_name (prefix, base64_p)
874    unsigned char *p, *data;    unsigned char *p, *data;
875    char pidbuf[20];    char pidbuf[20];
876    int pidlen;    int pidlen;
877        
878    CHECK_STRING (prefix);    CHECK_STRING (prefix);
879    
880    /* VAL is created by adding 6 characters to PREFIX.  The first    /* VAL is created by adding 6 characters to PREFIX.  The first
# Line 911  make_temp_name (prefix, base64_p) Line 903  make_temp_name (prefix, base64_p)
903        pidlen = 3;        pidlen = 3;
904  #endif  #endif
905      }      }
906      
907    len = XSTRING (prefix)->size;    len = SCHARS (prefix);
908    val = make_uninit_string (len + 3 + pidlen);    val = make_uninit_string (len + 3 + pidlen);
909    data = XSTRING (val)->data;    data = SDATA (val);
910    bcopy(XSTRING (prefix)->data, data, len);    bcopy(SDATA (prefix), data, len);
911    p = data + len;    p = data + len;
912    
913    bcopy (pidbuf, p, pidlen);    bcopy (pidbuf, p, pidlen);
# Line 970  make_temp_name (prefix, base64_p) Line 962  make_temp_name (prefix, base64_p)
962      }      }
963    
964    error ("Cannot create temporary name for prefix `%s'",    error ("Cannot create temporary name for prefix `%s'",
965           XSTRING (prefix)->data);           SDATA (prefix));
966    return Qnil;    return Qnil;
967  }  }
968    
# Line 1034  See also the function `substitute-in-fil Line 1026  See also the function `substitute-in-fil
1026    int is_escaped = 0;    int is_escaped = 0;
1027  #endif /* DOS_NT */  #endif /* DOS_NT */
1028    int length;    int length;
1029    Lisp_Object handler;    Lisp_Object handler, result;
1030    
1031    CHECK_STRING (name);    CHECK_STRING (name);
1032    
# Line 1073  See also the function `substitute-in-fil Line 1065  See also the function `substitute-in-fil
1065          return call3 (handler, Qexpand_file_name, name, default_directory);          return call3 (handler, Qexpand_file_name, name, default_directory);
1066      }      }
1067    
1068    o = XSTRING (default_directory)->data;    o = SDATA (default_directory);
1069    
1070    /* Make sure DEFAULT_DIRECTORY is properly expanded.    /* Make sure DEFAULT_DIRECTORY is properly expanded.
1071       It would be better to do this down below where we actually use       It would be better to do this down below where we actually use
# Line 1118  See also the function `substitute-in-fil Line 1110  See also the function `substitute-in-fil
1110    name = FILE_SYSTEM_CASE (name);    name = FILE_SYSTEM_CASE (name);
1111  #endif  #endif
1112    
1113    nm = XSTRING (name)->data;    nm = SDATA (name);
1114    
1115  #ifdef DOS_NT  #ifdef DOS_NT
1116    /* We will force directory separators to be either all \ or /, so make    /* We will force directory separators to be either all \ or /, so make
# Line 1202  See also the function `substitute-in-fil Line 1194  See also the function `substitute-in-fil
1194                     && IS_DIRECTORY_SEP (p[0])                     && IS_DIRECTORY_SEP (p[0])
1195                     && IS_DIRECTORY_SEP (p[1]))                     && IS_DIRECTORY_SEP (p[1]))
1196              lose = 1;              lose = 1;
1197              
1198  #ifdef VMS  #ifdef VMS
1199            if (p[0] == '\\')            if (p[0] == '\\')
1200              lose = 1;              lose = 1;
# Line 1282  See also the function `substitute-in-fil Line 1274  See also the function `substitute-in-fil
1274          {          {
1275  #ifdef VMS  #ifdef VMS
1276            if (index (nm, '/'))            if (index (nm, '/'))
1277              return build_string (sys_translate_unix (nm));              {
1278                  nm = sys_translate_unix (nm);
1279                  return make_specified_string (nm, -1, strlen (nm),
1280                                                STRING_MULTIBYTE (name));
1281                }
1282  #endif /* VMS */  #endif /* VMS */
1283  #ifdef DOS_NT  #ifdef DOS_NT
1284            /* Make sure directories are all separated with / or \ as            /* Make sure directories are all separated with / or \ as
# Line 1292  See also the function `substitute-in-fil Line 1288  See also the function `substitute-in-fil
1288  #ifdef WINDOWSNT  #ifdef WINDOWSNT
1289            if (IS_DIRECTORY_SEP (nm[1]))            if (IS_DIRECTORY_SEP (nm[1]))
1290              {              {
1291                if (strcmp (nm, XSTRING (name)->data) != 0)                if (strcmp (nm, SDATA (name)) != 0)
1292                  name = build_string (nm);                  name = make_specified_string (nm, -1, strlen (nm),
1293                                                  STRING_MULTIBYTE (name));
1294              }              }
1295            else            else
1296  #endif  #endif
1297            /* drive must be set, so this is okay */            /* drive must be set, so this is okay */
1298            if (strcmp (nm - 2, XSTRING (name)->data) != 0)            if (strcmp (nm - 2, SDATA (name)) != 0)
1299              {              {
1300                name = make_string (nm - 2, p - nm + 2);                char temp[] = " :";
1301                XSTRING (name)->data[0] = DRIVE_LETTER (drive);  
1302                XSTRING (name)->data[1] = ':';                name = make_specified_string (nm, -1, p - nm,
1303                                                STRING_MULTIBYTE (name));
1304                  temp[0] = DRIVE_LETTER (drive);
1305                  name = concat2 (build_string (temp), name);
1306              }              }
1307            return name;            return name;
1308  #else /* not DOS_NT */  #else /* not DOS_NT */
1309            if (nm == XSTRING (name)->data)            if (nm == SDATA (name))
1310              return name;              return name;
1311            return build_string (nm);            return make_specified_string (nm, -1, strlen (nm),
1312                                            STRING_MULTIBYTE (name));
1313  #endif /* not DOS_NT */  #endif /* not DOS_NT */
1314          }          }
1315      }      }
# Line 1419  See also the function `substitute-in-fil Line 1420  See also the function `substitute-in-fil
1420  #endif  #endif
1421        && !newdir)        && !newdir)
1422      {      {
1423        newdir = XSTRING (default_directory)->data;        newdir = SDATA (default_directory);
1424  #ifdef DOS_NT  #ifdef DOS_NT
1425        /* Note if special escape prefix is present, but remove for now.  */        /* Note if special escape prefix is present, but remove for now.  */
1426        if (newdir[0] == '/' && newdir[1] == ':')        if (newdir[0] == '/' && newdir[1] == ':')
# Line 1545  See also the function `substitute-in-fil Line 1546  See also the function `substitute-in-fil
1546               absolute directory in nm produces "//", which will then be               absolute directory in nm produces "//", which will then be
1547               incorrectly treated as a network share.  Ignore newdir in               incorrectly treated as a network share.  Ignore newdir in
1548               this case (keeping the drive letter).  */               this case (keeping the drive letter).  */
1549            if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])            if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1550                  && newdir[1] == '\0'))                  && newdir[1] == '\0'))
1551  #endif  #endif
1552              strcpy (target, newdir);              strcpy (target, newdir);
# Line 1677  See also the function `substitute-in-fil Line 1678  See also the function `substitute-in-fil
1678    CORRECT_DIR_SEPS (target);    CORRECT_DIR_SEPS (target);
1679  #endif /* DOS_NT */  #endif /* DOS_NT */
1680    
1681    return make_string (target, o - target);    result = make_specified_string (target, -1, o - target,
1682                                      STRING_MULTIBYTE (name));
1683    
1684      /* Again look to see if the file name has special constructs in it
1685         and perhaps call the corresponding file handler.  This is needed
1686         for filenames such as "/foo/../user@host:/bar/../baz".  Expanding
1687         the ".." component gives us "/user@host:/bar/../baz" which needs
1688         to be expanded again. */
1689      handler = Ffind_file_name_handler (result, Qexpand_file_name);
1690      if (!NILP (handler))
1691        return call3 (handler, Qexpand_file_name, result, default_directory);
1692    
1693      return result;
1694  }  }
1695    
1696  #if 0  #if 0
# Line 1726  See also the function `substitute-in-fil Line 1739  See also the function `substitute-in-fil
1739    name = Fupcase (name);    name = Fupcase (name);
1740  #endif  #endif
1741    
1742    nm = XSTRING (name)->data;    nm = SDATA (name);
1743    
1744    /* If nm is absolute, flush ...// and detect /./ and /../.    /* If nm is absolute, flush ...// and detect /./ and /../.
1745       If no /./ or /../ we can return right away.  */       If no /./ or /../ we can return right away.  */
# Line 1835  See also the function `substitute-in-fil Line 1848  See also the function `substitute-in-fil
1848            if (index (nm, '/'))            if (index (nm, '/'))
1849              return build_string (sys_translate_unix (nm));              return build_string (sys_translate_unix (nm));
1850  #endif /* VMS */  #endif /* VMS */
1851            if (nm == XSTRING (name)->data)            if (nm == SDATA (name))
1852              return name;              return name;
1853            return build_string (nm);            return build_string (nm);
1854          }          }
# Line 1896  See also the function `substitute-in-fil Line 1909  See also the function `substitute-in-fil
1909        if (NILP (defalt))        if (NILP (defalt))
1910          defalt = current_buffer->directory;          defalt = current_buffer->directory;
1911        CHECK_STRING (defalt);        CHECK_STRING (defalt);
1912        newdir = XSTRING (defalt)->data;        newdir = SDATA (defalt);
1913      }      }
1914    
1915    /* Now concatenate the directory and name to new space in the stack frame */    /* Now concatenate the directory and name to new space in the stack frame */
# Line 2046  duplicates what `expand-file-name' does. Line 2059  duplicates what `expand-file-name' does.
2059    if (!NILP (handler))    if (!NILP (handler))
2060      return call2 (handler, Qsubstitute_in_file_name, filename);      return call2 (handler, Qsubstitute_in_file_name, filename);
2061    
2062    nm = XSTRING (filename)->data;    nm = SDATA (filename);
2063  #ifdef DOS_NT  #ifdef DOS_NT
2064    nm = strcpy (alloca (strlen (nm) + 1), nm);    nm = strcpy (alloca (strlen (nm) + 1), nm);
2065    CORRECT_DIR_SEPS (nm);    CORRECT_DIR_SEPS (nm);
2066    substituted = (strcmp (nm, XSTRING (filename)->data) != 0);    substituted = (strcmp (nm, SDATA (filename)) != 0);
2067  #endif  #endif
2068    endp = nm + STRING_BYTES (XSTRING (filename));    endp = nm + SBYTES (filename);
2069    
2070    /* If /~ or // appears, discard everything through first slash.  */    /* If /~ or // appears, discard everything through first slash.  */
2071    
2072    for (p = nm; p != endp; p++)    for (p = nm; p != endp; p++)
2073      {      {
2074        if ((p[0] == '~'        if ((p[0] == '~'
2075  #if defined (APOLLO) || defined (WINDOWSNT)  #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2076             /* // at start of file name is meaningful in Apollo and             /* // at start of file name is meaningful in Apollo,
2077                WindowsNT systems.  */                WindowsNT and Cygwin systems.  */
2078             || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)             || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
2079  #else /* not (APOLLO || WINDOWSNT) */  #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2080             || IS_DIRECTORY_SEP (p[0])             || IS_DIRECTORY_SEP (p[0])
2081  #endif /* not (APOLLO || WINDOWSNT) */  #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2082             )             )
2083            && p != nm            && p != nm
2084            && (0            && (0
# Line 2108  duplicates what `expand-file-name' does. Line 2121  duplicates what `expand-file-name' does.
2121      }      }
2122    
2123  #ifdef VMS  #ifdef VMS
2124    return build_string (nm);    return make_specified_string (nm, -1, strlen (nm),
2125                                    STRING_MULTIBYTE (filename));
2126  #else  #else
2127    
2128    /* See if any variables are substituted into the string    /* See if any variables are substituted into the string
# Line 2168  duplicates what `expand-file-name' does. Line 2182  duplicates what `expand-file-name' does.
2182    
2183    /* If substitution required, recopy the string and do it */    /* If substitution required, recopy the string and do it */
2184    /* Make space in stack frame for the new copy */    /* Make space in stack frame for the new copy */
2185    xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1);    xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
2186    x = xnm;    x = xnm;
2187    
2188    /* Copy the rest of the name through, replacing $ constructs with values */    /* Copy the rest of the name through, replacing $ constructs with values */
# Line 2237  duplicates what `expand-file-name' does. Line 2251  duplicates what `expand-file-name' does.
2251    
2252    for (p = xnm; p != x; p++)    for (p = xnm; p != x; p++)
2253      if ((p[0] == '~'      if ((p[0] == '~'
2254  #if defined (APOLLO) || defined (WINDOWSNT)  #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2255           || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)           || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
2256  #else /* not (APOLLO || WINDOWSNT) */  #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2257           || IS_DIRECTORY_SEP (p[0])           || IS_DIRECTORY_SEP (p[0])
2258  #endif /* not (APOLLO || WINDOWSNT) */  #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2259           )           )
2260          && p != xnm && IS_DIRECTORY_SEP (p[-1]))          && p != xnm && IS_DIRECTORY_SEP (p[-1]))
2261        xnm = p;        xnm = p;
# Line 2251  duplicates what `expand-file-name' does. Line 2265  duplicates what `expand-file-name' does.
2265        xnm = p;        xnm = p;
2266  #endif  #endif
2267    
2268    if (STRING_MULTIBYTE (filename))    return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
     return make_string (xnm, x - xnm);  
   return make_unibyte_string (xnm, x - xnm);  
2269    
2270   badsubst:   badsubst:
2271    error ("Bad format environment-variable substitution");    error ("Bad format environment-variable substitution");
# Line 2279  expand_and_dir_to_file (filename, defdir Line 2291  expand_and_dir_to_file (filename, defdir
2291    absname = Fexpand_file_name (filename, defdir);    absname = Fexpand_file_name (filename, defdir);
2292  #ifdef VMS  #ifdef VMS
2293    {    {
2294      register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];      register int c = SREF (absname, SBYTES (absname) - 1);
2295      if (c == ':' || c == ']' || c == '>')      if (c == ':' || c == ']' || c == '>')
2296        absname = Fdirectory_file_name (absname);        absname = Fdirectory_file_name (absname);
2297    }    }
2298  #else  #else
2299    /* Remove final slash, if any (unless this is the root dir).    /* Remove final slash, if any (unless this is the root dir).
2300       stat behaves differently depending!  */       stat behaves differently depending!  */
2301    if (XSTRING (absname)->size > 1    if (SCHARS (absname) > 1
2302        && IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1])        && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
2303        && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2]))        && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
2304      /* We cannot take shortcuts; they might be wrong for magic file names.  */      /* We cannot take shortcuts; they might be wrong for magic file names.  */
2305      absname = Fdirectory_file_name (absname);      absname = Fdirectory_file_name (absname);
2306  #endif  #endif
# Line 2323  barf_or_query_if_file_exists (absname, q Line 2335  barf_or_query_if_file_exists (absname, q
2335    
2336    /* stat is a good way to tell whether the file exists,    /* stat is a good way to tell whether the file exists,
2337       regardless of what access permissions it has.  */       regardless of what access permissions it has.  */
2338    if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)    if (stat (SDATA (encoded_filename), &statbuf) >= 0)
2339      {      {
2340        if (! interactive)        if (! interactive)
2341          Fsignal (Qfile_already_exists,          Fsignal (Qfile_already_exists,
2342                   Fcons (build_string ("File already exists"),                   Fcons (build_string ("File already exists"),
2343                          Fcons (absname, Qnil)));                          Fcons (absname, Qnil)));
2344        GCPRO1 (absname);        GCPRO1 (absname);
2345        tem = format1 ("File %s already exists; %s anyway? ",        tem = format2 ("File %s already exists; %s anyway? ",
2346                       XSTRING (absname)->data, querystring);                       absname, build_string (querystring));
2347        if (quick)        if (quick)
2348          tem = Fy_or_n_p (tem);          tem = Fy_or_n_p (tem);
2349        else        else
# Line 2371  A prefix arg makes KEEP-TIME non-nil.  * Line 2383  A prefix arg makes KEEP-TIME non-nil.  *
2383    struct stat st, out_st;    struct stat st, out_st;
2384    Lisp_Object handler;    Lisp_Object handler;
2385    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2386    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
2387    int input_file_statable_p;    int input_file_statable_p;
2388    Lisp_Object encoded_file, encoded_newname;    Lisp_Object encoded_file, encoded_newname;
2389    
# Line 2404  A prefix arg makes KEEP-TIME non-nil.  * Line 2416  A prefix arg makes KEEP-TIME non-nil.  *
2416        || INTEGERP (ok_if_already_exists))        || INTEGERP (ok_if_already_exists))
2417      barf_or_query_if_file_exists (encoded_newname, "copy to it",      barf_or_query_if_file_exists (encoded_newname, "copy to it",
2418                                    INTEGERP (ok_if_already_exists), &out_st, 0);                                    INTEGERP (ok_if_already_exists), &out_st, 0);
2419    else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)    else if (stat (SDATA (encoded_newname), &out_st) < 0)
2420      out_st.st_mode = 0;      out_st.st_mode = 0;
2421    
2422  #ifdef WINDOWSNT  #ifdef WINDOWSNT
2423    if (!CopyFile (XSTRING (encoded_file)->data,    if (!CopyFile (SDATA (encoded_file),
2424                   XSTRING (encoded_newname)->data,                   SDATA (encoded_newname),
2425                   FALSE))                   FALSE))
2426      report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));      report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
2427      /* CopyFile retains the timestamp by default.  */
2428    else if (NILP (keep_time))    else if (NILP (keep_time))
2429      {      {
2430        EMACS_TIME now;        EMACS_TIME now;
# Line 2419  A prefix arg makes KEEP-TIME non-nil.  * Line 2432  A prefix arg makes KEEP-TIME non-nil.  *
2432        char * filename;        char * filename;
2433    
2434        EMACS_GET_TIME (now);        EMACS_GET_TIME (now);
2435        filename = XSTRING (encoded_newname)->data;        filename = SDATA (encoded_newname);
2436    
2437        /* Ensure file is writable while its modified time is set.  */        /* Ensure file is writable while its modified time is set.  */
2438        attributes = GetFileAttributes (filename);        attributes = GetFileAttributes (filename);
# Line 2436  A prefix arg makes KEEP-TIME non-nil.  * Line 2449  A prefix arg makes KEEP-TIME non-nil.  *
2449        SetFileAttributes (filename, attributes);        SetFileAttributes (filename, attributes);
2450      }      }
2451  #else /* not WINDOWSNT */  #else /* not WINDOWSNT */
2452    ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);    immediate_quit = 1;
2453      ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
2454      immediate_quit = 0;
2455    
2456    if (ifd < 0)    if (ifd < 0)
2457      report_file_error ("Opening input file", Fcons (file, Qnil));      report_file_error ("Opening input file", Fcons (file, Qnil));
2458    
# Line 2472  A prefix arg makes KEEP-TIME non-nil.  * Line 2488  A prefix arg makes KEEP-TIME non-nil.  *
2488    
2489  #ifdef VMS  #ifdef VMS
2490    /* Create the copy file with the same record format as the input file */    /* Create the copy file with the same record format as the input file */
2491    ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd);    ofd = sys_creat (SDATA (encoded_newname), 0666, ifd);
2492  #else  #else
2493  #ifdef MSDOS  #ifdef MSDOS
2494    /* System's default file type was set to binary by _fmode in emacs.c.  */    /* System's default file type was set to binary by _fmode in emacs.c.  */
2495    ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE);    ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE);
2496  #else /* not MSDOS */  #else /* not MSDOS */
2497    ofd = creat (XSTRING (encoded_newname)->data, 0666);    ofd = creat (SDATA (encoded_newname), 0666);
2498  #endif /* not MSDOS */  #endif /* not MSDOS */
2499  #endif /* VMS */  #endif /* VMS */
2500    if (ofd < 0)    if (ofd < 0)
# Line 2504  A prefix arg makes KEEP-TIME non-nil.  * Line 2520  A prefix arg makes KEEP-TIME non-nil.  *
2520            EMACS_TIME atime, mtime;            EMACS_TIME atime, mtime;
2521            EMACS_SET_SECS_USECS (atime, st.st_atime, 0);            EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
2522            EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);            EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
2523            if (set_file_times (XSTRING (encoded_newname)->data,            if (set_file_times (SDATA (encoded_newname),
2524                                atime, mtime))                                atime, mtime))
2525              Fsignal (Qfile_date_error,              Fsignal (Qfile_date_error,
2526                       Fcons (build_string ("Cannot set file date"),                       Fcons (build_string ("Cannot set file date"),
2527                              Fcons (newname, Qnil)));                              Fcons (newname, Qnil)));
2528          }          }
2529  #ifndef MSDOS  #ifndef MSDOS
2530        chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);        chmod (SDATA (encoded_newname), st.st_mode & 07777);
2531  #else /* MSDOS */  #else /* MSDOS */
2532  #if defined (__DJGPP__) && __DJGPP__ > 1  #if defined (__DJGPP__) && __DJGPP__ > 1
2533        /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,        /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
# Line 2519  A prefix arg makes KEEP-TIME non-nil.  * Line 2535  A prefix arg makes KEEP-TIME non-nil.  *
2535           get only the READ bit, which will make the copied file read-only,           get only the READ bit, which will make the copied file read-only,
2536           so it's better not to chmod at all.  */           so it's better not to chmod at all.  */
2537        if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)        if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2538          chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);          chmod (SDATA (encoded_newname), st.st_mode & 07777);
2539  #endif /* DJGPP version 2 or newer */  #endif /* DJGPP version 2 or newer */
2540  #endif /* MSDOS */  #endif /* MSDOS */
2541      }      }
# Line 2540  DEFUN ("make-directory-internal", Fmake_ Line 2556  DEFUN ("make-directory-internal", Fmake_
2556       (directory)       (directory)
2557       Lisp_Object directory;       Lisp_Object directory;
2558  {  {
2559    unsigned char *dir;    const unsigned char *dir;
2560    Lisp_Object handler;    Lisp_Object handler;
2561    Lisp_Object encoded_dir;    Lisp_Object encoded_dir;
2562    
# Line 2553  DEFUN ("make-directory-internal", Fmake_ Line 2569  DEFUN ("make-directory-internal", Fmake_
2569    
2570    encoded_dir = ENCODE_FILE (directory);    encoded_dir = ENCODE_FILE (directory);
2571    
2572    dir = XSTRING (encoded_dir)->data;    dir = SDATA (encoded_dir);
2573    
2574  #ifdef WINDOWSNT  #ifdef WINDOWSNT
2575    if (mkdir (dir) != 0)    if (mkdir (dir) != 0)
# Line 2566  DEFUN ("make-directory-internal", Fmake_ Line 2582  DEFUN ("make-directory-internal", Fmake_
2582  }  }
2583    
2584  DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",  DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
2585         doc: /* Delete the directory named DIRECTORY.  */)         doc: /* Delete the directory named DIRECTORY.  Does not follow symlinks.  */)
2586       (directory)       (directory)
2587       Lisp_Object directory;       Lisp_Object directory;
2588  {  {
2589    unsigned char *dir;    const unsigned char *dir;
2590    Lisp_Object handler;    Lisp_Object handler;
2591    Lisp_Object encoded_dir;    Lisp_Object encoded_dir;
2592    
# Line 2583  DEFUN ("delete-directory", Fdelete_direc Line 2599  DEFUN ("delete-directory", Fdelete_direc
2599    
2600    encoded_dir = ENCODE_FILE (directory);    encoded_dir = ENCODE_FILE (directory);
2601    
2602    dir = XSTRING (encoded_dir)->data;    dir = SDATA (encoded_dir);
2603    
2604    if (rmdir (dir) != 0)    if (rmdir (dir) != 0)
2605      report_file_error ("Removing directory", Flist (1, &directory));      report_file_error ("Removing directory", Flist (1, &directory));
# Line 2592  DEFUN ("delete-directory", Fdelete_direc Line 2608  DEFUN ("delete-directory", Fdelete_direc
2608  }  }
2609    
2610  DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",  DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
2611         doc: /* Delete file named FILENAME.         doc: /* Delete file named FILENAME.  If it is a symlink, remove the symlink.
2612  If file has multiple names, it continues to exist with the other names.  */)  If file has multiple names, it continues to exist with the other names.  */)
2613       (filename)       (filename)
2614       Lisp_Object filename;       Lisp_Object filename;
2615  {  {
2616    Lisp_Object handler;    Lisp_Object handler;
2617    Lisp_Object encoded_file;    Lisp_Object encoded_file;
2618      struct gcpro gcpro1;
2619    
2620    CHECK_STRING (filename);    GCPRO1 (filename);
2621      if (!NILP (Ffile_directory_p (filename)))
2622        Fsignal (Qfile_error,
2623                 Fcons (build_string ("Removing old name: is a directory"),
2624                        Fcons (filename, Qnil)));
2625      UNGCPRO;
2626    filename = Fexpand_file_name (filename, Qnil);    filename = Fexpand_file_name (filename, Qnil);
2627    
2628    handler = Ffind_file_name_handler (filename, Qdelete_file);    handler = Ffind_file_name_handler (filename, Qdelete_file);
# Line 2609  If file has multiple names, it continues Line 2631  If file has multiple names, it continues
2631    
2632    encoded_file = ENCODE_FILE (filename);    encoded_file = ENCODE_FILE (filename);
2633    
2634    if (0 > unlink (XSTRING (encoded_file)->data))    if (0 > unlink (SDATA (encoded_file)))
2635      report_file_error ("Removing old name", Flist (1, &filename));      report_file_error ("Removing old name", Flist (1, &filename));
2636    return Qnil;    return Qnil;
2637  }  }
# Line 2679  This is what happens in interactive use Line 2701  This is what happens in interactive use
2701      barf_or_query_if_file_exists (encoded_newname, "rename to it",      barf_or_query_if_file_exists (encoded_newname, "rename to it",
2702                                    INTEGERP (ok_if_already_exists), 0, 0);                                    INTEGERP (ok_if_already_exists), 0, 0);
2703  #ifndef BSD4_1  #ifndef BSD4_1
2704    if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))    if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
2705  #else  #else
2706    if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)    if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
2707        || 0 > unlink (XSTRING (encoded_file)->data))        || 0 > unlink (SDATA (encoded_file)))
2708  #endif  #endif
2709      {      {
2710        if (errno == EXDEV)        if (errno == EXDEV)
# Line 2754  This is what happens in interactive use Line 2776  This is what happens in interactive use
2776      barf_or_query_if_file_exists (encoded_newname, "make it a new name",      barf_or_query_if_file_exists (encoded_newname, "make it a new name",
2777                                    INTEGERP (ok_if_already_exists), 0, 0);                                    INTEGERP (ok_if_already_exists), 0, 0);
2778    
2779    unlink (XSTRING (newname)->data);    unlink (SDATA (newname));
2780    if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))    if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
2781      {      {
2782  #ifdef NO_ARG_ARRAY  #ifdef NO_ARG_ARRAY
2783        args[0] = file;        args[0] = file;
# Line 2795  This happens for interactive use with M- Line 2817  This happens for interactive use with M-
2817    /* If the link target has a ~, we must expand it to get    /* If the link target has a ~, we must expand it to get
2818       a truly valid file name.  Otherwise, do not expand;       a truly valid file name.  Otherwise, do not expand;
2819       we want to permit links to relative file names.  */       we want to permit links to relative file names.  */
2820    if (XSTRING (filename)->data[0] == '~')    if (SREF (filename, 0) == '~')
2821      filename = Fexpand_file_name (filename, Qnil);      filename = Fexpand_file_name (filename, Qnil);
2822    linkname = Fexpand_file_name (linkname, Qnil);    linkname = Fexpand_file_name (linkname, Qnil);
2823    
# Line 2820  This happens for interactive use with M- Line 2842  This happens for interactive use with M-
2842        || INTEGERP (ok_if_already_exists))        || INTEGERP (ok_if_already_exists))
2843      barf_or_query_if_file_exists (encoded_linkname, "make it a link",      barf_or_query_if_file_exists (encoded_linkname, "make it a link",
2844                                    INTEGERP (ok_if_already_exists), 0, 0);                                    INTEGERP (ok_if_already_exists), 0, 0);
2845    if (0 > symlink (XSTRING (encoded_filename)->data,    if (0 > symlink (SDATA (encoded_filename),
2846                     XSTRING (encoded_linkname)->data))                     SDATA (encoded_linkname)))
2847      {      {
2848        /* If we didn't complain already, silently delete existing file.  */        /* If we didn't complain already, silently delete existing file.  */
2849        if (errno == EEXIST)        if (errno == EEXIST)
2850          {          {
2851            unlink (XSTRING (encoded_linkname)->data);            unlink (SDATA (encoded_linkname));
2852            if (0 <= symlink (XSTRING (encoded_filename)->data,            if (0 <= symlink (SDATA (encoded_filename),
2853                              XSTRING (encoded_linkname)->data))                              SDATA (encoded_linkname)))
2854              {              {
2855                UNGCPRO;                UNGCPRO;
2856                return Qnil;                return Qnil;
# Line 2860  If STRING is nil or a null string, the l Line 2882  If STRING is nil or a null string, the l
2882  {  {
2883    CHECK_STRING (name);    CHECK_STRING (name);
2884    if (NILP (string))    if (NILP (string))
2885      delete_logical_name (XSTRING (name)->data);      delete_logical_name (SDATA (name));
2886    else    else
2887      {      {
2888        CHECK_STRING (string);        CHECK_STRING (string);
2889    
2890        if (XSTRING (string)->size == 0)        if (SCHARS (string) == 0)
2891          delete_logical_name (XSTRING (name)->data);          delete_logical_name (SDATA (name));
2892        else        else
2893          define_logical_name (XSTRING (name)->data, XSTRING (string)->data);          define_logical_name (SDATA (name), SDATA (string));
2894      }      }
2895    
2896    return string;    return string;
# Line 2887  DEFUN ("sysnetunam", Fsysnetunam, Ssysne Line 2909  DEFUN ("sysnetunam", Fsysnetunam, Ssysne
2909    CHECK_STRING (path);    CHECK_STRING (path);
2910    CHECK_STRING (login);    CHECK_STRING (login);
2911    
2912    netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);    netresult = netunam (SDATA (path), SDATA (login));
2913    
2914    if (netresult == -1)    if (netresult == -1)
2915      return Qnil;      return Qnil;
# Line 2903  On Unix, this is a name starting with a Line 2925  On Unix, this is a name starting with a
2925       (filename)       (filename)
2926       Lisp_Object filename;       Lisp_Object filename;
2927  {  {
2928    unsigned char *ptr;    const unsigned char *ptr;
2929    
2930    CHECK_STRING (filename);    CHECK_STRING (filename);
2931    ptr = XSTRING (filename)->data;    ptr = SDATA (filename);
2932    if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'    if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2933  #ifdef VMS  #ifdef VMS
2934  /* ??? This criterion is probably wrong for '<'.  */  /* ??? This criterion is probably wrong for '<'.  */
# Line 3003  See also `file-readable-p' and `file-att Line 3025  See also `file-readable-p' and `file-att
3025    
3026    absname = ENCODE_FILE (absname);    absname = ENCODE_FILE (absname);
3027    
3028    return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil;    return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
3029  }  }
3030    
3031  DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,  DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
# Line 3026  For a directory, this means you can acce Line 3048  For a directory, this means you can acce
3048    
3049    absname = ENCODE_FILE (absname);    absname = ENCODE_FILE (absname);
3050    
3051    return (check_executable (XSTRING (absname)->data) ? Qt : Qnil);    return (check_executable (SDATA (absname)) ? Qt : Qnil);
3052  }  }
3053    
3054  DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,  DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
# Line 3055  See also `file-exists-p' and `file-attri Line 3077  See also `file-exists-p' and `file-attri
3077  #if defined(DOS_NT) || defined(macintosh)  #if defined(DOS_NT) || defined(macintosh)
3078    /* Under MS-DOS, Windows, and Macintosh, open does not work for    /* Under MS-DOS, Windows, and Macintosh, open does not work for
3079       directories.  */       directories.  */
3080    if (access (XSTRING (absname)->data, 0) == 0)    if (access (SDATA (absname), 0) == 0)
3081      return Qt;      return Qt;
3082    return Qnil;    return Qnil;
3083  #else /* not DOS_NT and not macintosh */  #else /* not DOS_NT and not macintosh */
# Line 3064  See also `file-exists-p' and `file-attri Line 3086  See also `file-exists-p' and `file-attri
3086    /* Opening a fifo without O_NONBLOCK can wait.    /* Opening a fifo without O_NONBLOCK can wait.
3087       We don't want to wait.  But we don't want to mess wth O_NONBLOCK       We don't want to wait.  But we don't want to mess wth O_NONBLOCK
3088       except in the case of a fifo, on a system which handles it.  */       except in the case of a fifo, on a system which handles it.  */
3089    desc = stat (XSTRING (absname)->data, &statbuf);    desc = stat (SDATA (absname), &statbuf);
3090    if (desc < 0)    if (desc < 0)
3091      return Qnil;      return Qnil;
3092    if (S_ISFIFO (statbuf.st_mode))    if (S_ISFIFO (statbuf.st_mode))
3093      flags |= O_NONBLOCK;      flags |= O_NONBLOCK;
3094  #endif  #endif
3095    desc = emacs_open (XSTRING (absname)->data, flags, 0);    desc = emacs_open (SDATA (absname), flags, 0);
3096    if (desc < 0)    if (desc < 0)
3097      return Qnil;      return Qnil;
3098    emacs_close (desc);    emacs_close (desc);
# Line 3099  DEFUN ("file-writable-p", Ffile_writable Line 3121  DEFUN ("file-writable-p", Ffile_writable
3121      return call2 (handler, Qfile_writable_p, absname);      return call2 (handler, Qfile_writable_p, absname);
3122    
3123    encoded = ENCODE_FILE (absname);    encoded = ENCODE_FILE (absname);
3124    if (stat (XSTRING (encoded)->data, &statbuf) >= 0)    if (stat (SDATA (encoded), &statbuf) >= 0)
3125      return (check_writable (XSTRING (encoded)->data)      return (check_writable (SDATA (encoded))
3126              ? Qt : Qnil);              ? Qt : Qnil);
3127    
3128    dir = Ffile_name_directory (absname);    dir = Ffile_name_directory (absname);
# Line 3118  DEFUN ("file-writable-p", Ffile_writable Line 3140  DEFUN ("file-writable-p", Ffile_writable
3140    /* The read-only attribute of the parent directory doesn't affect    /* The read-only attribute of the parent directory doesn't affect
3141       whether a file or directory can be created within it.  Some day we       whether a file or directory can be created within it.  Some day we
3142       should check ACLs though, which do affect this.  */       should check ACLs though, which do affect this.  */
3143    if (stat (XSTRING (dir)->data, &statbuf) < 0)    if (stat (SDATA (dir), &statbuf) < 0)
3144      return Qnil;      return Qnil;
3145    return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;    return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
3146  #else  #else
3147    return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")    return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
3148            ? Qt : Qnil);            ? Qt : Qnil);
3149  #endif  #endif
3150  }  }
# Line 3150  If there is no error, we return nil.  */ Line 3172  If there is no error, we return nil.  */
3172    
3173    encoded_filename = ENCODE_FILE (absname);    encoded_filename = ENCODE_FILE (absname);
3174    
3175    fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);    fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
3176    if (fd < 0)    if (fd < 0)
3177      report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));      report_file_error (SDATA (string), Fcons (filename, Qnil));
3178    emacs_close (fd);    emacs_close (fd);
3179    
3180    return Qnil;    return Qnil;
# Line 3190  Otherwise returns nil.  */) Line 3212  Otherwise returns nil.  */)
3212        bufsize *= 2;        bufsize *= 2;
3213        buf = (char *) xrealloc (buf, bufsize);        buf = (char *) xrealloc (buf, bufsize);
3214        bzero (buf, bufsize);        bzero (buf, bufsize);
3215          
3216        errno = 0;        errno = 0;
3217        valsize = readlink (XSTRING (filename)->data, buf, bufsize);        valsize = readlink (SDATA (filename), buf, bufsize);
3218        if (valsize == -1)        if (valsize == -1)
3219          {          {
3220  #ifdef ERANGE  #ifdef ERANGE
# Line 3208  Otherwise returns nil.  */) Line 3230  Otherwise returns nil.  */)
3230          }          }
3231      }      }
3232    while (valsize >= bufsize);    while (valsize >= bufsize);
3233      
3234    val = make_string (buf, valsize);    val = make_string (buf, valsize);
3235    if (buf[0] == '/' && index (buf, ':'))    if (buf[0] == '/' && index (buf, ':'))
3236      val = concat2 (build_string ("/:"), val);      val = concat2 (build_string ("/:"), val);
# Line 3241  See `file-symlink-p' to distinguish syml Line 3263  See `file-symlink-p' to distinguish syml
3263    
3264    absname = ENCODE_FILE (absname);    absname = ENCODE_FILE (absname);
3265    
3266    if (stat (XSTRING (absname)->data, &st) < 0)    if (stat (SDATA (absname), &st) < 0)
3267      return Qnil;      return Qnil;
3268    return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;    return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
3269  }  }
# Line 3267  searchable directory.  */) Line 3289  searchable directory.  */)
3289    if (!NILP (handler))    if (!NILP (handler))
3290      return call2 (handler, Qfile_accessible_directory_p, filename);      return call2 (handler, Qfile_accessible_directory_p, filename);
3291    
   /* It's an unlikely combination, but yes we really do need to gcpro:  
      Suppose that file-accessible-directory-p has no handler, but  
      file-directory-p does have a handler; this handler causes a GC which  
      relocates the string in `filename'; and finally file-directory-p  
      returns non-nil.  Then we would end up passing a garbaged string  
      to file-executable-p.  */  
3292    GCPRO1 (filename);    GCPRO1 (filename);
3293    tem = (NILP (Ffile_directory_p (filename))    tem = (NILP (Ffile_directory_p (filename))
3294           || NILP (Ffile_executable_p (filename)));           || NILP (Ffile_executable_p (filename)));
# Line 3307  This is the sort of file that holds an o Line 3323  This is the sort of file that holds an o
3323    
3324      /* Tell stat to use expensive method to get accurate info.  */      /* Tell stat to use expensive method to get accurate info.  */
3325      Vw32_get_true_file_attributes = Qt;      Vw32_get_true_file_attributes = Qt;
3326      result = stat (XSTRING (absname)->data, &st);      result = stat (SDATA (absname), &st);
3327      Vw32_get_true_file_attributes = tem;      Vw32_get_true_file_attributes = tem;
3328    
3329      if (result < 0)      if (result < 0)
# Line 3315  This is the sort of file that holds an o Line 3331  This is the sort of file that holds an o
3331      return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;      return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
3332    }    }
3333  #else  #else
3334    if (stat (XSTRING (absname)->data, &st) < 0)    if (stat (SDATA (absname), &st) < 0)
3335      return Qnil;      return Qnil;
3336    return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;    return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
3337  #endif  #endif
# Line 3340  DEFUN ("file-modes", Ffile_modes, Sfile_ Line 3356  DEFUN ("file-modes", Ffile_modes, Sfile_
3356    
3357    absname = ENCODE_FILE (absname);    absname = ENCODE_FILE (absname);
3358    
3359    if (stat (XSTRING (absname)->data, &st) < 0)    if (stat (SDATA (absname), &st) < 0)
3360      return Qnil;      return Qnil;
3361  #if defined (MSDOS) && __DJGPP__ < 2  #if defined (MSDOS) && __DJGPP__ < 2
3362    if (check_executable (XSTRING (absname)->data))    if (check_executable (SDATA (absname)))
3363      st.st_mode |= S_IEXEC;      st.st_mode |= S_IEXEC;
3364  #endif /* MSDOS && __DJGPP__ < 2 */  #endif /* MSDOS && __DJGPP__ < 2 */
3365    
# Line 3370  Only the 12 low bits of MODE are used. Line 3386  Only the 12 low bits of MODE are used.
3386    
3387    encoded_absname = ENCODE_FILE (absname);    encoded_absname = ENCODE_FILE (absname);
3388    
3389    if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0)    if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
3390      report_file_error ("Doing chmod", Fcons (absname, Qnil));      report_file_error ("Doing chmod", Fcons (absname, Qnil));
3391    
3392    return Qnil;    return Qnil;
# Line 3456  otherwise, if FILE2 does not exist, the Line 3472  otherwise, if FILE2 does not exist, the
3472    absname2 = ENCODE_FILE (absname2);    absname2 = ENCODE_FILE (absname2);
3473    UNGCPRO;    UNGCPRO;
3474    
3475    if (stat (XSTRING (absname1)->data, &st) < 0)    if (stat (SDATA (absname1), &st) < 0)
3476      return Qnil;      return Qnil;
3477    
3478    mtime1 = st.st_mtime;    mtime1 = st.st_mtime;
3479    
3480    if (stat (XSTRING (absname2)->data, &st) < 0)    if (stat (SDATA (absname2), &st) < 0)
3481      return Qt;      return Qt;
3482    
3483    return (mtime1 > st.st_mtime) ? Qt : Qnil;    return (mtime1 > st.st_mtime) ? Qt : Qnil;
# Line 3534  static Lisp_Object Line 3550  static Lisp_Object
3550  read_non_regular ()  read_non_regular ()
3551  {  {
3552    int nbytes;    int nbytes;
3553      
3554    immediate_quit = 1;    immediate_quit = 1;
3555    QUIT;    QUIT;
3556    nbytes = emacs_read (non_regular_fd,    nbytes = emacs_read (non_regular_fd,
# Line 3588  actually used.  */) Line 3604  actually used.  */)
3604    int inserted = 0;    int inserted = 0;
3605    register int how_much;    register int how_much;
3606    register int unprocessed;    register int unprocessed;
3607    int count = BINDING_STACK_SIZE ();    int count = SPECPDL_INDEX ();
3608    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3609    Lisp_Object handler, val, insval, orig_filename;    Lisp_Object handler, val, insval, orig_filename;
3610    Lisp_Object p;    Lisp_Object p;
# Line 3640  actually used.  */) Line 3656  actually used.  */)
3656    
3657      /* Tell stat to use expensive method to get accurate info.  */      /* Tell stat to use expensive method to get accurate info.  */
3658      Vw32_get_true_file_attributes = Qt;      Vw32_get_true_file_attributes = Qt;
3659      total = stat (XSTRING (filename)->data, &st);      total = stat (SDATA (filename), &st);
3660      Vw32_get_true_file_attributes = tem;      Vw32_get_true_file_attributes = tem;
3661    }    }
3662    if (total < 0)    if (total < 0)
3663  #else  #else
3664  #ifndef APOLLO  #ifndef APOLLO
3665    if (stat (XSTRING (filename)->data, &st) < 0)    if (stat (SDATA (filename), &st) < 0)
3666  #else  #else
3667    if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0    if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0
3668        || fstat (fd, &st) < 0)        || fstat (fd, &st) < 0)
3669  #endif /* not APOLLO */  #endif /* not APOLLO */
3670  #endif /* WINDOWSNT */  #endif /* WINDOWSNT */
# Line 3683  actually used.  */) Line 3699  actually used.  */)
3699  #endif  #endif
3700    
3701    if (fd < 0)    if (fd < 0)
3702      if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)      if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
3703        goto badopen;        goto badopen;
3704    
3705    /* Replacement should preserve point as it preserves markers.  */    /* Replacement should preserve point as it preserves markers.  */
# Line 3693  actually used.  */) Line 3709  actually used.  */)
3709    record_unwind_protect (close_file_unwind, make_number (fd));    record_unwind_protect (close_file_unwind, make_number (fd));
3710    
3711    /* Supposedly happens on VMS.  */    /* Supposedly happens on VMS.  */
3712      /* Can happen on any platform that uses long as type of off_t, but allows
3713         file sizes to exceed 2Gb.  VMS is no longer officially supported, so
3714         give a message suitable for the latter case.  */
3715    if (! not_regular && st.st_size < 0)    if (! not_regular && st.st_size < 0)
3716      error ("File size is negative");      error ("Maximum buffer size exceeded");
3717    
3718    /* Prevent redisplay optimizations.  */    /* Prevent redisplay optimizations.  */
3719    current_buffer->clip_changed = 1;    current_buffer->clip_changed = 1;
# Line 3779  actually used.  */) Line 3798  actually used.  */)
3798    
3799                if (nread < 0)                if (nread < 0)
3800                  error ("IO error reading %s: %s",                  error ("IO error reading %s: %s",
3801                         XSTRING (orig_filename)->data, emacs_strerror (errno));                         SDATA (orig_filename), emacs_strerror (errno));
3802                else if (nread > 0)                else if (nread > 0)
3803                  {                  {
3804                    struct buffer *prev = current_buffer;                    struct buffer *prev = current_buffer;
# Line 3797  actually used.  */) Line 3816  actually used.  */)
3816                    buf->undo_list = Qt;                    buf->undo_list = Qt;
3817                    buf->overlays_before = Qnil;                    buf->overlays_before = Qnil;
3818                    buf->overlays_after = Qnil;                    buf->overlays_after = Qnil;
3819                      
3820                    set_buffer_internal (buf);                    set_buffer_internal (buf);
3821                    Ferase_buffer ();                    Ferase_buffer ();
3822                    buf->enable_multibyte_characters = Qnil;                    buf->enable_multibyte_characters = Qnil;
# Line 3807  actually used.  */) Line 3826  actually used.  */)
3826                    val = call2 (Vset_auto_coding_function,                    val = call2 (Vset_auto_coding_function,
3827                                 filename, make_number (nread));                                 filename, make_number (nread));
3828                    set_buffer_internal (prev);                    set_buffer_internal (prev);
3829                      
3830                    /* Discard the unwind protect for recovering the                    /* Discard the unwind protect for recovering the
3831                       current buffer.  */                       current buffer.  */
3832                    specpdl_ptr--;                    specpdl_ptr--;
# Line 3896  actually used.  */) Line 3915  actually used.  */)
3915            nread = emacs_read (fd, buffer, sizeof buffer);            nread = emacs_read (fd, buffer, sizeof buffer);
3916            if (nread < 0)            if (nread < 0)
3917              error ("IO error reading %s: %s",              error ("IO error reading %s: %s",
3918                     XSTRING (orig_filename)->data, emacs_strerror (errno));                     SDATA (orig_filename), emacs_strerror (errno));
3919            else if (nread == 0)            else if (nread == 0)
3920              break;              break;
3921    
# Line 3967  actually used.  */) Line 3986  actually used.  */)
3986                nread = emacs_read (fd, buffer + total_read, trial - total_read);                nread = emacs_read (fd, buffer + total_read, trial - total_read);
3987                if (nread < 0)                if (nread < 0)
3988                  error ("IO error reading %s: %s",                  error ("IO error reading %s: %s",
3989                         XSTRING (orig_filename)->data, emacs_strerror (errno));                         SDATA (orig_filename), emacs_strerror (errno));
3990                else if (nread == 0)                else if (nread == 0)
3991                  break;                  break;
3992                total_read += nread;                total_read += nread;
3993              }              }
3994              
3995            /* Scan this bufferful from the end, comparing with            /* Scan this bufferful from the end, comparing with
3996               the Emacs buffer.  */               the Emacs buffer.  */
3997            bufpos = total_read;            bufpos = total_read;
3998              
3999            /* Compare with same_at_start to avoid counting some buffer text            /* Compare with same_at_start to avoid counting some buffer text
4000               as matching both at the file's beginning and at the end.  */               as matching both at the file's beginning and at the end.  */
4001            while (bufpos > 0 && same_at_end > same_at_start            while (bufpos > 0 && same_at_end > same_at_start
# Line 4150  actually used.  */) Line 4169  actually used.  */)
4169    
4170            if (how_much == -1)            if (how_much == -1)
4171              error ("IO error reading %s: %s",              error ("IO error reading %s: %s",
4172                     XSTRING (orig_filename)->data, emacs_strerror (errno));                     SDATA (orig_filename), emacs_strerror (errno));
4173            else if (how_much == -2)            else if (how_much == -2)
4174              error ("maximum buffer size exceeded");              error ("maximum buffer size exceeded");
4175          }          }
# Line 4233  actually used.  */) Line 4252  actually used.  */)
4252        if (coding.cmp_data && coding.cmp_data->used)        if (coding.cmp_data && coding.cmp_data->used)
4253          coding_restore_composition (&coding, Fcurrent_buffer ());          coding_restore_composition (&coding, Fcurrent_buffer ());
4254        coding_free_composition_data (&coding);        coding_free_composition_data (&coding);
4255      
4256        /* Set `inserted' to the number of inserted characters.  */        /* Set `inserted' to the number of inserted characters.  */
4257        inserted = PT - temp;        inserted = PT - temp;
4258    
# Line 4278  actually used.  */) Line 4297  actually used.  */)
4297       before exiting the loop, it is set to a negative value if I/O       before exiting the loop, it is set to a negative value if I/O
4298       error occurs.  */       error occurs.  */
4299    how_much = 0;    how_much = 0;
4300      
4301    /* Total bytes inserted.  */    /* Total bytes inserted.  */
4302    inserted = 0;    inserted = 0;
4303      
4304    /* Here, we don't do code conversion in the loop.  It is done by    /* Here, we don't do code conversion in the loop.  It is done by
4305       code_convert_region after all data are read into the buffer.  */       code_convert_region after all data are read into the buffer.  */
4306    {    {
4307      int gap_size = GAP_SIZE;      int gap_size = GAP_SIZE;
4308        
4309      while (how_much < total)      while (how_much < total)
4310        {        {
4311          /* try is reserved in some compilers (Microsoft C) */          /* try is reserved in some compilers (Microsoft C) */
# Line 4330  actually used.  */) Line 4349  actually used.  */)
4349              this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);              this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
4350              immediate_quit = 0;              immediate_quit = 0;
4351            }            }
4352          
4353          if (this <= 0)          if (this <= 0)
4354            {            {
4355              how_much = this;              how_much = this;
# Line 4370  actually used.  */) Line 4389  actually used.  */)
4389    
4390    if (how_much < 0)    if (how_much < 0)
4391      error ("IO error reading %s: %s",      error ("IO error reading %s: %s",
4392             XSTRING (orig_filename)->data, emacs_strerror (errno));             SDATA (orig_filename), emacs_strerror (errno));
4393    
4394   notfound:   notfound:
4395    
# Line 4395  actually used.  */) Line 4414  actually used.  */)
4414               this way, we can run Lisp program safely before decoding               this way, we can run Lisp program safely before decoding
4415               the inserted text.  */               the inserted text.  */
4416            Lisp_Object unwind_data;            Lisp_Object unwind_data;
4417                int count = specpdl_ptr - specpdl;                int count = SPECPDL_INDEX ();
4418    
4419            unwind_data = Fcons (current_buffer->enable_multibyte_characters,            unwind_data = Fcons (current_buffer->enable_multibyte_characters,
4420                                 Fcons (current_buffer->undo_list,                                 Fcons (current_buffer->undo_list,
# Line 4478  actually used.  */) Line 4497  actually used.  */)
4497    /* Use the conversion type to determine buffer-file-type    /* Use the conversion type to determine buffer-file-type
4498       (find-buffer-file-type is now used to help determine the       (find-buffer-file-type is now used to help determine the
4499       conversion).  */       conversion).  */
4500    if ((coding.eol_type == CODING_EOL_UNDECIDED    if ((coding.eol_type == CODING_EOL_UNDECIDED
4501         || coding.eol_type == CODING_EOL_LF)         || coding.eol_type == CODING_EOL_LF)
4502        && ! CODING_REQUIRE_DECODING (&coding))        && ! CODING_REQUIRE_DECODING (&coding))
4503      current_buffer->buffer_file_type = Qt;      current_buffer->buffer_file_type = Qt;
# Line 4493  actually used.  */) Line 4512  actually used.  */)
4512        if (!EQ (current_buffer->undo_list, Qt))        if (!EQ (current_buffer->undo_list, Qt))
4513          current_buffer->undo_list = Qnil;          current_buffer->undo_list = Qnil;
4514  #ifdef APOLLO  #ifdef APOLLO
4515        stat (XSTRING (filename)->data, &st);        stat (SDATA (filename), &st);
4516  #endif  #endif
4517    
4518        if (NILP (handler))        if (NILP (handler))
# Line 4523  actually used.  */) Line 4542  actually used.  */)
4542    if (inserted > 0)    if (inserted > 0)
4543      {      {
4544        int empty_undo_list_p = 0;        int empty_undo_list_p = 0;
4545          
4546        /* If we're anyway going to discard undo information, don't        /* If we're anyway going to discard undo information, don't
4547           record it in the first place.  The buffer's undo list at this           record it in the first place.  The buffer's undo list at this
4548           point is either nil or t when visiting a file.  */           point is either nil or t when visiting a file.  */
# Line 4532  actually used.  */) Line 4551  actually used.  */)
4551            empty_undo_list_p = NILP (current_buffer->undo_list);            empty_undo_list_p = NILP (current_buffer->undo_list);
4552            current_buffer->undo_list = Qt;            current_buffer->undo_list = Qt;
4553          }          }
4554              
4555        insval = call3 (Qformat_decode,        insval = call3 (Qformat_decode,
4556                        Qnil, make_number (inserted), visit);                        Qnil, make_number (inserted), visit);
4557        CHECK_NUMBER (insval);        CHECK_NUMBER (insval);
4558        inserted = XFASTINT (insval);        inserted = XFASTINT (insval);
4559          
4560        if (!NILP (visit))        if (!NILP (visit))
4561          current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;          current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
4562      }      }
# Line 4625  choose_write_coding_system (start, end, Line 4644  choose_write_coding_system (start, end,
4644    if (auto_saving)    if (auto_saving)
4645      val = Qnil;      val = Qnil;
4646    else if (!NILP (Vcoding_system_for_write))    else if (!NILP (Vcoding_system_for_write))
4647      val = Vcoding_system_for_write;      {
4648          val = Vcoding_system_for_write;
4649          if (coding_system_require_warning
4650              && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4651            /* Confirm that VAL can surely encode the current region.  */
4652            val = call5 (Vselect_safe_coding_system_function,
4653                         start, end, Fcons (Qt, Fcons (val, Qnil)),
4654                         Qnil, filename);
4655        }
4656    else    else
4657      {      {
4658        /* If the variable `buffer-file-coding-system' is set locally,        /* If the variable `buffer-file-coding-system' is set locally,
# Line 4648  choose_write_coding_system (start, end, Line 4675  choose_write_coding_system (start, end,
4675            if (NILP (current_buffer->enable_multibyte_characters))            if (NILP (current_buffer->enable_multibyte_characters))
4676              force_raw_text = 1;              force_raw_text = 1;
4677          }          }
4678            
4679        if (NILP (val))        if (NILP (val))
4680          {          {
4681            /* Check file-coding-system-alist.  */            /* Check file-coding-system-alist.  */
# Line 4670  choose_write_coding_system (start, end, Line 4697  choose_write_coding_system (start, end,
4697            val = current_buffer->buffer_file_coding_system;            val = current_buffer->buffer_file_coding_system;
4698            using_default_coding = 1;            using_default_coding = 1;
4699          }          }
4700                
4701        if (!force_raw_text        if (!force_raw_text
4702            && !NILP (Ffboundp (Vselect_safe_coding_system_function)))            && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4703          /* Confirm that VAL can surely encode the current region.  */          /* Confirm that VAL can surely encode the current region.  */
# Line 4730  If VISIT is a string, it is a second fil Line 4757  If VISIT is a string, it is a second fil
4757    the output goes to FILENAME, but the buffer is marked as visiting VISIT.    the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4758    VISIT is also the file name to lock and unlock for clash detection.    VISIT is also the file name to lock and unlock for clash detection.
4759  If VISIT is neither t nor nil nor a string,  If VISIT is neither t nor nil nor a string,
4760    that means do not print the \"Wrote file\" message.    that means do not display the \"Wrote file\" message.
4761  The optional sixth arg LOCKNAME, if non-nil, specifies the name to  The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4762    use for locking and unlocking, overriding FILENAME and VISIT.    use for locking and unlocking, overriding FILENAME and VISIT.
4763  The optional seventh arg MUSTBENEW, if non-nil, insists on a check  The optional seventh arg MUSTBENEW, if non-nil, insists on a check
# Line 4750  This does code conversion according to t Line 4777  This does code conversion according to t
4777    register int desc;    register int desc;
4778    int failure;    int failure;
4779    int save_errno = 0;    int save_errno = 0;
4780    unsigned char *fn;    const unsigned char *fn;
4781    struct stat st;    struct stat st;
4782    int tem;    int tem;
4783    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
4784    int count1;    int count1;
4785  #ifdef VMS  #ifdef VMS
4786    unsigned char *fname = 0;     /* If non-0, original filename (must rename) */    unsigned char *fname = 0;     /* If non-0, original filename (must rename) */
# Line 4825  This does code conversion according to t Line 4852  This does code conversion according to t
4852      }      }
4853    
4854    record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());    record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
4855    count1 = specpdl_ptr - specpdl;    count1 = SPECPDL_INDEX ();
4856    
4857    given_buffer = current_buffer;    given_buffer = current_buffer;
4858    
# Line 4880  This does code conversion according to t Line 4907  This does code conversion according to t
4907    
4908    encoded_filename = ENCODE_FILE (filename);    encoded_filename = ENCODE_FILE (filename);
4909    
4910    fn = XSTRING (encoded_filename)->data;    fn = SDATA (encoded_filename);
4911    desc = -1;    desc = -1;
4912    if (!NILP (append))    if (!NILP (append))
4913  #ifdef DOS_NT  #ifdef DOS_NT
# Line 4897  This does code conversion according to t Line 4924  This does code conversion according to t
4924          desc = emacs_open (fn, O_RDWR, 0);          desc = emacs_open (fn, O_RDWR, 0);
4925          if (desc < 0)          if (desc < 0)
4926            desc = creat_copy_attrs (STRINGP (current_buffer->filename)            desc = creat_copy_attrs (STRINGP (current_buffer->filename)
4927                                     ? XSTRING (current_buffer->filename)->data : 0,                                     ? SDATA (current_buffer->filename) : 0,
4928                                     fn);                                     fn);
4929        }        }
4930      else                /* Write to temporary name and rename if no errors */      else                /* Write to temporary name and rename if no errors */
# Line 4909  This does code conversion according to t Line 4936  This does code conversion according to t
4936            {            {
4937              temp_name = Fmake_temp_name (concat2 (temp_name,              temp_name = Fmake_temp_name (concat2 (temp_name,
4938                                                    build_string ("$$SAVE$$")));                                                    build_string ("$$SAVE$$")));
4939              fname = XSTRING (filename)->data;              fname = SDATA (filename);
4940              fn = XSTRING (temp_name)->data;              fn = SDATA (temp_name);
4941              desc = creat_copy_attrs (fname, fn);              desc = creat_copy_attrs (fname, fn);
4942              if (desc < 0)              if (desc < 0)
4943                {                {
# Line 4964  This does code conversion according to t Line 4991  This does code conversion according to t
4991    if (!NILP (append) && !NILP (Ffile_regular_p (filename)))    if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
4992      {      {
4993        long ret;        long ret;
4994          
4995        if (NUMBERP (append))        if (NUMBERP (append))
4996          ret = lseek (desc, XINT (append), 1);          ret = lseek (desc, XINT (append), 1);
4997        else        else
# Line 4978  This does code conversion according to t Line 5005  This does code conversion according to t
5005            report_file_error ("Lseek error", Fcons (filename, Qnil));            report_file_error ("Lseek error", Fcons (filename, Qnil));
5006          }          }
5007      }      }
5008      
5009    UNGCPRO;    UNGCPRO;
5010    
5011  #ifdef VMS  #ifdef VMS
# Line 5019  This does code conversion according to t Line 5046  This does code conversion according to t
5046    
5047    if (STRINGP (start))    if (STRINGP (start))
5048      {      {
5049        failure = 0 > a_write (desc, start, 0, XSTRING (start)->size,        failure = 0 > a_write (desc, start, 0, SCHARS (start),
5050                               &annotations, &coding);                               &annotations, &coding);
5051        save_errno = errno;        save_errno = errno;
5052      }      }
# Line 5129  This does code conversion according to t Line 5156  This does code conversion according to t
5156      current_buffer->modtime = st.st_mtime;      current_buffer->modtime = st.st_mtime;
5157    
5158    if (failure)    if (failure)
5159      error ("IO error writing %s: %s", XSTRING (filename)->data,      error ("IO error writing %s: %s", SDATA (filename),
5160             emacs_strerror (save_errno));             emacs_strerror (save_errno));
5161    
5162    if (visiting)    if (visiting)
# Line 5210  build_annotations (start, end) Line 5237  build_annotations (start, end)
5237    for (i = 0; CONSP (p); p = XCDR (p), ++i)    for (i = 0; CONSP (p); p = XCDR (p), ++i)
5238      {      {
5239        struct buffer *given_buffer = current_buffer;        struct buffer *given_buffer = current_buffer;
5240          
5241        Vwrite_region_annotations_so_far = annotations;        Vwrite_region_annotations_so_far = annotations;
5242    
5243        /* Value is either a list of annotations or nil if the function        /* Value is either a list of annotations or nil if the function
# Line 5224  build_annotations (start, end) Line 5251  build_annotations (start, end)
5251            XSETFASTINT (end, ZV);            XSETFASTINT (end, ZV);
5252            annotations = Qnil;            annotations = Qnil;
5253          }          }
5254          
5255        if (CONSP (res))        if (CONSP (res))
5256          annotations = merge (annotations, res, Qcar_less_than_car);          annotations = merge (annotations, res, Qcar_less_than_car);
5257      }      }
# Line 5304  a_write (desc, string, pos, nchars, anno Line 5331  a_write (desc, string, pos, nchars, anno
5331        tem = Fcdr (Fcar (*annot));        tem = Fcdr (Fcar (*annot));
5332        if (STRINGP (tem))        if (STRINGP (tem))
5333          {          {
5334            if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding))            if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
5335              return -1;              return -1;
5336          }          }
5337        *annot = Fcdr (*annot);        *annot = Fcdr (*annot);
# Line 5340  e_write (desc, string, start, end, codin Line 5367  e_write (desc, string, start, end, codin
5367    
5368    if (STRINGP (string))    if (STRINGP (string))
5369      {      {
5370        addr = XSTRING (string)->data;        addr = SDATA (string);
5371        nbytes = STRING_BYTES (XSTRING (string));        nbytes = SBYTES (string);
5372        coding->src_multibyte = STRING_MULTIBYTE (string);        coding->src_multibyte = STRING_MULTIBYTE (string);
5373      }      }
5374    else if (start < end)    else if (start < end)
# Line 5429  This means that the file has not been ch Line 5456  This means that the file has not been ch
5456    
5457    filename = ENCODE_FILE (b->filename);    filename = ENCODE_FILE (b->filename);
5458    
5459    if (stat (XSTRING (filename)->data, &st) < 0)    if (stat (SDATA (filename), &st) < 0)
5460      {      {
5461        /* If the file doesn't exist now and didn't exist before,        /* If the file doesn't exist now and didn't exist before,
5462           we say that it isn't modified, provided the error is a tame one.  */           we say that it isn't modified, provided the error is a tame one.  */
# Line 5497  An argument specifies the modification t Line 5524  An argument specifies the modification t
5524    
5525        filename = ENCODE_FILE (filename);        filename = ENCODE_FILE (filename);
5526    
5527        if (stat (XSTRING (filename)->data, &st) >= 0)        if (stat (SDATA (filename), &st) >= 0)
5528          current_buffer->modtime = st.st_mtime;          current_buffer->modtime = st.st_mtime;
5529      }      }
5530    
# Line 5511  auto_save_error (error) Line 5538  auto_save_error (error)
5538    Lisp_Object args[3], msg;    Lisp_Object args[3], msg;
5539    int i, nbytes;    int i, nbytes;
5540    struct gcpro gcpro1;    struct gcpro gcpro1;
5541      
5542    ring_bell ();    ring_bell ();
5543      
5544    args[0] = build_string ("Auto-saving %s: %s");    args[0] = build_string ("Auto-saving %s: %s");
5545    args[1] = current_buffer->name;    args[1] = current_buffer->name;
5546    args[2] = Ferror_message_string (error);    args[2] = Ferror_message_string (error);
5547    msg = Fformat (3, args);    msg = Fformat (3, args);
5548    GCPRO1 (msg);    GCPRO1 (msg);
5549    nbytes = STRING_BYTES (XSTRING (msg));    nbytes = SBYTES (msg);
5550    
5551    for (i = 0; i < 3; ++i)    for (i = 0; i < 3; ++i)
5552      {      {
5553        if (i == 0)        if (i == 0)
5554          message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));          message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
5555        else        else
5556          message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));          message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
5557        Fsleep_for (make_number (1), Qnil);        Fsleep_for (make_number (1), Qnil);
5558      }      }
5559    
# Line 5541  auto_save_1 () Line 5568  auto_save_1 ()
5568    
5569    /* Get visited file's mode to become the auto save file's mode.  */    /* Get visited file's mode to become the auto save file's mode.  */
5570    if (! NILP (current_buffer->filename)    if (! NILP (current_buffer->filename)
5571        && stat (XSTRING (current_buffer->filename)->data, &st) >= 0)        && stat (SDATA (current_buffer->filename), &st) >= 0)
5572      /* But make sure we can overwrite it later!  */      /* But make sure we can overwrite it later!  */
5573      auto_save_mode_bits = st.st_mode | 0600;      auto_save_mode_bits = st.st_mode | 0600;
5574    else    else
# Line 5561  do_auto_save_unwind (stream)  /* used as Line 5588  do_auto_save_unwind (stream)  /* used as
5588    if (!NILP (stream))    if (!NILP (stream))
5589      fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16      fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
5590                        | XFASTINT (XCDR (stream))));                        | XFASTINT (XCDR (stream))));
   pop_message ();  
5591    return Qnil;    return Qnil;
5592  }  }
5593    
# Line 5573  do_auto_save_unwind_1 (value)  /* used a Line 5599  do_auto_save_unwind_1 (value)  /* used a
5599    return Qnil;    return Qnil;
5600  }  }
5601    
5602    static Lisp_Object
5603    do_auto_save_make_dir (dir)
5604         Lisp_Object dir;
5605    {
5606      return call2 (Qmake_directory, dir, Qt);
5607    }
5608    
5609    static Lisp_Object
5610    do_auto_save_eh (ignore)
5611         Lisp_Object ignore;
5612    {
5613      return Qnil;
5614    }
5615    
5616  DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",  DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5617         doc: /* Auto-save all buffers that need it.         doc: /* Auto-save all buffers that need it.
5618  This is all buffers that have auto-saving enabled  This is all buffers that have auto-saving enabled
# Line 5594  A non-nil CURRENT-ONLY argument means sa Line 5634  A non-nil CURRENT-ONLY argument means sa
5634    Lisp_Object oquit;    Lisp_Object oquit;
5635    FILE *stream;    FILE *stream;
5636    Lisp_Object lispstream;    Lisp_Object lispstream;
5637    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
5638    int orig_minibuffer_auto_raise = minibuffer_auto_raise;    int orig_minibuffer_auto_raise = minibuffer_auto_raise;
5639    int message_p = 0;    int old_message_p = 0;
5640      struct gcpro gcpro1, gcpro2;
5641    
5642    if (max_specpdl_size < specpdl_size + 40)    if (max_specpdl_size < specpdl_size + 40)
5643      max_specpdl_size = specpdl_size + 40;      max_specpdl_size = specpdl_size + 40;
# Line 5604  A non-nil CURRENT-ONLY argument means sa Line 5645  A non-nil CURRENT-ONLY argument means sa
5645    if (minibuf_level)    if (minibuf_level)
5646      no_message = Qt;      no_message = Qt;
5647    
5648    if (NILP (no_message));    if (NILP (no_message))
5649      message_p = push_message ();      {
5650            old_message_p = push_message ();
5651          record_unwind_protect (pop_message_unwind, Qnil);
5652        }
5653    
5654    /* Ordinarily don't quit within this function,    /* Ordinarily don't quit within this function,
5655       but don't make it impossible to quit (in case we get hung in I/O).  */       but don't make it impossible to quit (in case we get hung in I/O).  */
5656    oquit = Vquit_flag;    oquit = Vquit_flag;
# Line 5621  A non-nil CURRENT-ONLY argument means sa Line 5665  A non-nil CURRENT-ONLY argument means sa
5665    if (STRINGP (Vauto_save_list_file_name))    if (STRINGP (Vauto_save_list_file_name))
5666      {      {
5667        Lisp_Object listfile;        Lisp_Object listfile;
5668          
5669        listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);        listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5670    
5671        /* Don't try to create the directory when shutting down Emacs,        /* Don't try to create the directory when shutting down Emacs,
# Line 5630  A non-nil CURRENT-ONLY argument means sa Line 5674  A non-nil CURRENT-ONLY argument means sa
5674        if (!NILP (Vrun_hooks))        if (!NILP (Vrun_hooks))
5675          {          {
5676            Lisp_Object dir;            Lisp_Object dir;
5677              dir = Qnil;
5678              GCPRO2 (dir, listfile);
5679            dir = Ffile_name_directory (listfile);            dir = Ffile_name_directory (listfile);
5680            if (NILP (Ffile_directory_p (dir)))            if (NILP (Ffile_directory_p (dir)))
5681              call2 (Qmake_directory, dir, Qt);              internal_condition_case_1 (do_auto_save_make_dir,
5682                                           dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
5683                                           do_auto_save_eh);
5684              UNGCPRO;
5685          }          }
5686          
5687        stream = fopen (XSTRING (listfile)->data, "w");        stream = fopen (SDATA (listfile), "w");
5688        if (stream != NULL)        if (stream != NULL)
5689          {          {
5690            /* Arrange to close that file whether or not we get an error.            /* Arrange to close that file whether or not we get an error.
# Line 5678  A non-nil CURRENT-ONLY argument means sa Line 5727  A non-nil CURRENT-ONLY argument means sa
5727            {            {
5728              if (!NILP (b->filename))              if (!NILP (b->filename))
5729                {                {
5730                  fwrite (XSTRING (b->filename)->data, 1,                  fwrite (SDATA (b->filename), 1,
5731                          STRING_BYTES (XSTRING (b->filename)), stream);                          SBYTES (b->filename), stream);
5732                }                }
5733              putc ('\n', stream);              putc ('\n', stream);
5734              fwrite (XSTRING (b->auto_save_file_name)->data, 1,              fwrite (SDATA (b->auto_save_file_name), 1,
5735                      STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);                      SBYTES (b->auto_save_file_name), stream);
5736              putc ('\n', stream);              putc ('\n', stream);
5737            }            }
5738    
# Line 5760  A non-nil CURRENT-ONLY argument means sa Line 5809  A non-nil CURRENT-ONLY argument means sa
5809    
5810    if (auto_saved && NILP (no_message))    if (auto_saved && NILP (no_message))
5811      {      {
5812        if (message_p)        if (old_message_p)
5813          {          {
5814              /* If we are going to restore an old message,
5815                 give time to read ours.  */
5816            sit_for (1, 0, 0, 0, 0);            sit_for (1, 0, 0, 0, 0);
5817            restore_message ();            restore_message ();
5818          }          }
5819        else        else
5820            /* If we displayed a message and then restored a state
5821               with no message, leave a "done" message on the screen.  */
5822          message1 ("Auto-saving...done");          message1 ("Auto-saving...done");
5823      }      }
5824    
5825    Vquit_flag = oquit;    Vquit_flag = oquit;
5826    
5827      /* This restores the message-stack status.  */
5828    unbind_to (count, Qnil);    unbind_to (count, Qnil);
5829    return Qnil;    return Qnil;
5830  }  }
# Line 5813  static Lisp_Object Line 5867  static Lisp_Object
5867  double_dollars (val)  double_dollars (val)
5868       Lisp_Object val;       Lisp_Object val;
5869  {  {
5870    register unsigned char *old, *new;    register const unsigned char *old;
5871      register unsigned char *new;
5872    register int n;    register int n;
5873    int osize, count;    int osize, count;
5874    
5875    osize = STRING_BYTES (XSTRING (val));    osize = SBYTES (val);
5876    
5877    /* Count the number of $ characters.  */    /* Count the number of $ characters.  */
5878    for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)    for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
5879      if (*old++ == '$') count++;      if (*old++ == '$') count++;
5880    if (count > 0)    if (count > 0)
5881      {      {
5882        old = XSTRING (val)->data;        old = SDATA (val);
5883        val = make_uninit_multibyte_string (XSTRING (val)->size + count,        val = make_uninit_multibyte_string (SCHARS (val) + count,
5884                                            osize + count);                                            osize + count);
5885        new = XSTRING (val)->data;        new = SDATA (val);
5886        for (n = osize; n > 0; n--)        for (n = osize; n > 0; n--)
5887          if (*old != '$')          if (*old != '$')
5888            *new++ = *old++;            *new++ = *old++;
# Line 5845  static Lisp_Object Line 5900  static Lisp_Object
5900  read_file_name_cleanup (arg)  read_file_name_cleanup (arg)
5901       Lisp_Object arg;       Lisp_Object arg;
5902  {  {
5903    current_buffer->directory = arg;    return (current_buffer->directory = arg);
5904  }  }
5905    
5906  DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,  DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
# Line 5870  DEFUN ("read-file-name-internal", Fread_ Line 5925  DEFUN ("read-file-name-internal", Fread_
5925    /* No need to protect ACTION--we only compare it with t and nil.  */    /* No need to protect ACTION--we only compare it with t and nil.  */
5926    GCPRO5 (string, realdir, name, specdir, orig_string);    GCPRO5 (string, realdir, name, specdir, orig_string);
5927    
5928    if (XSTRING (string)->size == 0)    if (SCHARS (string) == 0)
5929      {      {
5930        if (EQ (action, Qlambda))        if (EQ (action, Qlambda))
5931          {          {
# Line 5924  DEFUN ("read-file-name-internal", Fread_ Line 5979  DEFUN ("read-file-name-internal", Fread_
5979  #ifndef VMS  #ifndef VMS
5980        if (EQ (Vread_file_name_predicate, Qfile_directory_p))        if (EQ (Vread_file_name_predicate, Qfile_directory_p))
5981          {          {
5982            /* Brute-force speed up for directory checking:            /* Brute-force speed up for directory checking:
5983               Discard strings which don't end in a slash.  */               Discard strings which don't end in a slash.  */
5984            for (comp = Qnil; CONSP (all); all = XCDR (all))            for (comp = Qnil; CONSP (all); all = XCDR (all))
5985              {              {
5986                Lisp_Object tem = XCAR (all);                Lisp_Object tem = XCAR (all);
5987                int len;                int len;
5988                if (STRINGP (tem) &&                if (STRINGP (tem) &&
5989                    (len = XSTRING (tem)->size, len > 0) &&                    (len = SCHARS (tem), len > 0) &&
5990                    IS_DIRECTORY_SEP (XSTRING (tem)->data[len-1]))                    IS_DIRECTORY_SEP (SREF (tem, len-1)))
5991                  comp = Fcons (tem, comp);                  comp = Fcons (tem, comp);
5992              }              }
5993          }          }
# Line 5941  DEFUN ("read-file-name-internal", Fread_ Line 5996  DEFUN ("read-file-name-internal", Fread_
5996          {          {
5997            /* Must do it the hard (and slow) way.  */            /* Must do it the hard (and slow) way.  */
5998            GCPRO3 (all, comp, specdir);            GCPRO3 (all, comp, specdir);
5999            count = specpdl_ptr - specpdl;            count = SPECPDL_INDEX ();
6000            record_unwind_protect (read_file_name_cleanup, current_buffer->directory);            record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
6001            current_buffer->directory = realdir;            current_buffer->directory = realdir;
6002            for (comp = Qnil; CONSP (all); all = XCDR (all))            for (comp = Qnil; CONSP (all); all = XCDR (all))
# Line 5957  DEFUN ("read-file-name-internal", Fread_ Line 6012  DEFUN ("read-file-name-internal", Fread_
6012  #ifdef VMS  #ifdef VMS
6013    /* Supposedly this helps commands such as `cd' that read directory names,    /* Supposedly this helps commands such as `cd' that read directory names,
6014       but can someone explain how it helps them? -- RMS */       but can someone explain how it helps them? -- RMS */
6015    if (XSTRING (name)->size == 0)    if (SCHARS (name) == 0)
6016      return Qt;      return Qt;
6017  #endif /* VMS */  #endif /* VMS */
6018    if (!NILP (Vread_file_name_predicate))    if (!NILP (Vread_file_name_predicate))
# Line 5974  Default name to DEFAULT-FILENAME if user Line 6029  Default name to DEFAULT-FILENAME if user
6029  Fourth arg MUSTMATCH non-nil means require existing file's name.  Fourth arg MUSTMATCH non-nil means require existing file's name.
6030   Non-nil and non-t means also require confirmation after completion.   Non-nil and non-t means also require confirmation after completion.
6031  Fifth arg INITIAL specifies text to start with.  Fifth arg INITIAL specifies text to start with.
6032  If optional sixth arg PREDICATE is non-nil, possible completions and the  If optional sixth arg PREDICATE is non-nil, possible completions and the
6033  resulting file name must satisfy (funcall PREDICATE NAME).  resulting file name must satisfy (funcall PREDICATE NAME).
6034  DIR defaults to current buffer's directory default.  DIR defaults to current buffer's directory default.
6035    
# Line 5987  provides a file dialog box.  */) Line 6042  provides a file dialog box.  */)
6042    Lisp_Object val, insdef, tem;    Lisp_Object val, insdef, tem;
6043    struct gcpro gcpro1, gcpro2;    struct gcpro gcpro1, gcpro2;
6044    register char *homedir;    register char *homedir;
6045      Lisp_Object decoded_homedir;
6046    int replace_in_history = 0;    int replace_in_history = 0;
6047    int add_to_history = 0;    int add_to_history = 0;
6048    int count;    int count;
# Line 5994  provides a file dialog box.  */) Line 6050  provides a file dialog box.  */)
6050    if (NILP (dir))    if (NILP (dir))
6051      dir = current_buffer->directory;      dir = current_buffer->directory;
6052    if (NILP (default_filename))    if (NILP (default_filename))
6053      {      default_filename = !NILP (initial)
6054        if (! NILP (initial))        ? Fexpand_file_name (initial, dir)
6055          default_filename = Fexpand_file_name (initial, dir);        : current_buffer->filename;
       else  
         default_filename = current_buffer->filename;  
     }  
6056    
6057    /* If dir starts with user's homedir, change that to ~. */    /* If dir starts with user's homedir, change that to ~. */
6058    homedir = (char *) egetenv ("HOME");    homedir = (char *) egetenv ("HOME");
# Line 6012  provides a file dialog box.  */) Line 6065  provides a file dialog box.  */)
6065        CORRECT_DIR_SEPS (homedir);        CORRECT_DIR_SEPS (homedir);
6066      }      }
6067  #endif  #endif
6068      if (homedir != 0)
6069        decoded_homedir
6070          = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
6071    if (homedir != 0    if (homedir != 0
6072        && STRINGP (dir)        && STRINGP (dir)
6073        && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))        && !strncmp (SDATA (decoded_homedir), SDATA (dir),
6074        && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))                     SBYTES (decoded_homedir))
6075          && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
6076      {      {
6077        dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,        dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
6078                           STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);        dir = concat2 (build_string ("~"), dir);
       XSTRING (dir)->data[0] = '~';  
6079      }      }
6080    /* Likewise for default_filename.  */    /* Likewise for default_filename.  */
6081    if (homedir != 0    if (homedir != 0
6082        && STRINGP (default_filename)        && STRINGP (default_filename)
6083        && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))        && !strncmp (SDATA (decoded_homedir), SDATA (default_filename),
6084        && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))                     SBYTES (decoded_homedir))
6085          && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
6086      {      {
6087        default_filename        default_filename
6088          = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,          = Fsubstring (default_filename,
6089                         STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);                        make_number (SCHARS (decoded_homedir)), Qnil);
6090        XSTRING (default_filename)->data[0] = '~';        default_filename = concat2 (build_string ("~"), default_filename);
6091      }      }
6092    if (!NILP (default_filename))    if (!NILP (default_filename))
6093      {      {
# Line 6048  provides a file dialog box.  */) Line 6105  provides a file dialog box.  */)
6105            args[0] = insdef;            args[0] = insdef;
6106            args[1] = initial;            args[1] = initial;
6107            insdef = Fconcat (2, args);            insdef = Fconcat (2, args);
6108            pos = make_number (XSTRING (double_dollars (dir))->size);            pos = make_number (SCHARS (double_dollars (dir)));
6109            insdef = Fcons (double_dollars (insdef), pos);            insdef = Fcons (double_dollars (insdef), pos);
6110          }          }
6111        else        else
# Line 6074  provides a file dialog box.  */) Line 6131  provides a file dialog box.  */)
6131        RETURN_UNGCPRO (Ffuncall (7, args));        RETURN_UNGCPRO (Ffuncall (7, args));
6132      }      }
6133    
6134    count = specpdl_ptr - specpdl;    count = SPECPDL_INDEX ();
6135  #ifdef VMS  #ifdef VMS
6136    specbind (intern ("completion-ignore-case"), Qt);    specbind (intern ("completion-ignore-case"), Qt);
6137  #endif  #endif
6138    
6139    specbind (intern ("minibuffer-completing-file-name"), Qt);    specbind (intern ("minibuffer-completing-file-name"), Qt);
6140    specbind (intern ("read-file-name-predicate"),    specbind (intern ("read-file-name-predicate"),
6141              (NILP (predicate) ? Qfile_exists_p : predicate));              (NILP (predicate) ? Qfile_exists_p : predicate));
6142    
6143    GCPRO2 (insdef, default_filename);    GCPRO2 (insdef, default_filename);
6144      
6145  #if defined (USE_MOTIF) || defined (HAVE_NTGUI)  #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6146    if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))    if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
6147        && use_dialog_box        && use_dialog_box
6148        && have_menus_p ())        && have_menus_p ())
# Line 6093  provides a file dialog box.  */) Line 6150  provides a file dialog box.  */)
6150        /* If DIR contains a file name, split it.  */        /* If DIR contains a file name, split it.  */
6151        Lisp_Object file;        Lisp_Object file;
6152        file = Ffile_name_nondirectory (dir);        file = Ffile_name_nondirectory (dir);
6153        if (XSTRING (file)->size && NILP (default_filename))        if (SCHARS (file) && NILP (default_filename))
6154          {          {
6155            default_filename = file;            default_filename = file;
6156            dir = Ffile_name_directory (dir);            dir = Ffile_name_directory (dir);
# Line 6125  provides a file dialog box.  */) Line 6182  provides a file dialog box.  */)
6182        if (! replace_in_history)        if (! replace_in_history)
6183          add_to_history = 1;          add_to_history = 1;
6184    
6185        val = build_string ("");        val = empty_string;
6186      }      }
6187    
6188    unbind_to (count, Qnil);    unbind_to (count, Qnil);
# Line 6137  provides a file dialog box.  */) Line 6194  provides a file dialog box.  */)
6194    
6195    if (!NILP (tem) && !NILP (default_filename))    if (!NILP (tem) && !NILP (default_filename))
6196      val = default_filename;      val = default_filename;
6197    else if (XSTRING (val)->size == 0 && NILP (insdef))    else if (SCHARS (val) == 0 && NILP (insdef))
6198      {      {
6199        if (!NILP (default_filename))        if (!NILP (default_filename))
6200          val = default_filename;          val = default_filename;
# Line 6160  provides a file dialog box.  */) Line 6217  provides a file dialog box.  */)
6217          Fset (Qfile_name_history,          Fset (Qfile_name_history,
6218                Fcons (val1, tem));                Fcons (val1, tem));
6219      }      }
6220        
6221    return val;    return val;
6222  }  }
6223    
# Line 6285  same format as a regular save would use. Line 6342  same format as a regular save would use.
6342    staticpro (&Qformat_decode);    staticpro (&Qformat_decode);
6343    Qformat_annotate_function = intern ("format-annotate-function");    Qformat_annotate_function = intern ("format-annotate-function");
6344    staticpro (&Qformat_annotate_function);    staticpro (&Qformat_annotate_function);
6345            
6346    Qcar_less_than_car = intern ("car-less-than-car");    Qcar_less_than_car = intern ("car-less-than-car");
6347    staticpro (&Qcar_less_than_car);    staticpro (&Qcar_less_than_car);
6348    
# Line 6325  nil means use format `var'.  This variab Line 6382  nil means use format `var'.  This variab
6382    
6383    DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,    DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
6384                 doc: /* Directory separator character for built-in functions that return file names.                 doc: /* Directory separator character for built-in functions that return file names.
6385  The value should be either ?/ or ?\\ (any other value is treated as ?\\).  The value is always ?/.  Don't use this variable, just use `/'.  */);
 This variable affects the built-in functions only on Windows,  
 on other platforms, it is initialized so that Lisp code can find out  
 what the normal separator is.  
   
 WARNING: This variable is deprecated and will be removed in the near  
 future.  DO NOT USE IT.  */);  
6386    
6387    DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,    DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
6388                 doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.                 doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
# Line 6463  a non-nil value.  */); Line 6514  a non-nil value.  */);
6514    defsubr (&Sunix_sync);    defsubr (&Sunix_sync);
6515  #endif  #endif
6516  }  }
   

Legend:
Removed from v.1.449  
changed lines
  Added in v.1.449.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26