160165Shibler /* File IO for GNU Emacs.
260165Shibler    Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
360165Shibler 
460165Shibler This file is part of GNU Emacs.
560165Shibler 
660165Shibler GNU Emacs is free software; you can redistribute it and/or modify
760165Shibler it under the terms of the GNU General Public License as published by
860165Shibler the Free Software Foundation; either version 1, or (at your option)
960165Shibler any later version.
1060165Shibler 
1160165Shibler GNU Emacs is distributed in the hope that it will be useful,
1260165Shibler but WITHOUT ANY WARRANTY; without even the implied warranty of
1360165Shibler MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1460165Shibler GNU General Public License for more details.
1560165Shibler 
1660165Shibler You should have received a copy of the GNU General Public License
1760165Shibler along with GNU Emacs; see the file COPYING.  If not, write to
1860165Shibler the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
1960165Shibler 
2060165Shibler 
2160165Shibler #include <sys/types.h>
2260165Shibler #ifdef hpux
2360165Shibler /* needed by <pwd.h> */
2460165Shibler #include <stdio.h>
2560165Shibler #undef NULL
2660165Shibler #endif
2760165Shibler #include <sys/stat.h>
2860165Shibler #include <pwd.h>
2960165Shibler #include <ctype.h>
3060165Shibler #include <sys/dir.h>
3160165Shibler #include <errno.h>
3260165Shibler 
3360165Shibler #ifndef VMS
3460165Shibler extern int errno;
3560165Shibler extern char *sys_errlist[];
3660165Shibler extern int sys_nerr;
3760165Shibler #endif
3860165Shibler 
3960165Shibler #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
4060165Shibler 
4160165Shibler #ifdef APOLLO
4260165Shibler #include <sys/time.h>
4360165Shibler #endif
4460165Shibler 
4560165Shibler #ifdef NULL
4660165Shibler #undef NULL
4760165Shibler #endif
4860165Shibler #include "config.h"
4960165Shibler #include "lisp.h"
5060165Shibler #include "buffer.h"
5160165Shibler #include "window.h"
5260165Shibler 
5360165Shibler #ifdef VMS
5460165Shibler #include <perror.h>
5560165Shibler #include <file.h>
5660165Shibler #include <rmsdef.h>
5760165Shibler #include <fab.h>
5860165Shibler #include <nam.h>
5960165Shibler #endif
6060165Shibler 
6160165Shibler #ifdef HAVE_TIMEVAL
6260165Shibler #ifdef HPUX
6360165Shibler #include <time.h>
6460165Shibler #else
6560165Shibler #include <sys/time.h>
6660165Shibler #endif
6760165Shibler #endif
6860165Shibler 
6960165Shibler #ifdef HPUX
7060165Shibler #include <netio.h>
7160165Shibler #include <errnet.h>
7260165Shibler #endif
7360165Shibler 
7460165Shibler #ifndef O_WRONLY
7560165Shibler #define O_WRONLY 1
7660165Shibler #endif
7760165Shibler 
7860165Shibler #define min(a, b) ((a) < (b) ? (a) : (b))
7960165Shibler #define max(a, b) ((a) > (b) ? (a) : (b))
8060165Shibler 
8160165Shibler /* Nonzero during writing of auto-save files */
8260165Shibler int auto_saving;
8360165Shibler 
8460165Shibler /* Nonzero means, when reading a filename in the minibuffer,
8560165Shibler  start out by inserting the default directory into the minibuffer. */
8660165Shibler int insert_default_directory;
8760165Shibler 
8860165Shibler /* On VMS, nonzero means write new files with record format stmlf.
8960165Shibler    Zero means use var format.  */
9060165Shibler int vms_stmlf_recfm;
9160165Shibler 
9260165Shibler Lisp_Object Qfile_error, Qfile_already_exists;
9360165Shibler 
report_file_error(string,data)9460165Shibler report_file_error (string, data)
9560165Shibler      char *string;
9660165Shibler      Lisp_Object data;
9760165Shibler {
9860165Shibler   Lisp_Object errstring;
9960165Shibler 
10060165Shibler   if (errno >= 0 && errno < sys_nerr)
10160165Shibler     errstring = build_string (sys_errlist[errno]);
10260165Shibler   else
10360165Shibler     errstring = build_string ("undocumented error code");
10460165Shibler 
10560165Shibler   /* System error messages are capitalized.  Downcase the initial. */
10660165Shibler   XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
10760165Shibler 
10860165Shibler   while (1)
10960165Shibler     Fsignal (Qfile_error,
11060165Shibler 	     Fcons (build_string (string), Fcons (errstring, data)));
11160165Shibler }
11260165Shibler 
11360165Shibler DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
11460165Shibler   1, 1, 0,
11560165Shibler   "Return the directory component in file name NAME.\n\
11660165Shibler Return nil if NAME does not include a directory.\n\
11760165Shibler Otherwise returns a directory spec.\n\
11860165Shibler Given a Unix syntax file name, returns a string ending in slash;\n\
11960165Shibler on VMS, perhaps instead a string ending in :, ] or >.")
12060165Shibler   (file)
12160165Shibler      Lisp_Object file;
12260165Shibler {
12360165Shibler   register unsigned char *beg;
12460165Shibler   register unsigned char *p;
12560165Shibler 
12660165Shibler   CHECK_STRING (file, 0);
12760165Shibler 
12860165Shibler   beg = XSTRING (file)->data;
12960165Shibler   p = beg + XSTRING (file)->size;
13060165Shibler 
13160165Shibler   while (p != beg && p[-1] != '/'
13260165Shibler #ifdef VMS
13360165Shibler 	 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
13460165Shibler #endif /* VMS */
13560165Shibler 	 ) p--;
13660165Shibler 
13760165Shibler   if (p == beg)
13860165Shibler     return Qnil;
13960165Shibler   return make_string (beg, p - beg);
14060165Shibler }
14160165Shibler 
14260165Shibler DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
14360165Shibler   1, 1, 0,
14460165Shibler   "Return file name NAME sans its directory.\n\
14560165Shibler For example, in a Unix-syntax file name,\n\
14660165Shibler this is everything after the last slash,\n\
14760165Shibler or the entire name if it contains no slash.")
14860165Shibler   (file)
14960165Shibler      Lisp_Object file;
15060165Shibler {
15160165Shibler   register unsigned char *beg, *p, *end;
15260165Shibler 
15360165Shibler   CHECK_STRING (file, 0);
15460165Shibler 
15560165Shibler   beg = XSTRING (file)->data;
15660165Shibler   end = p = beg + XSTRING (file)->size;
15760165Shibler 
15860165Shibler   while (p != beg && p[-1] != '/'
15960165Shibler #ifdef VMS
16060165Shibler 	 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
16160165Shibler #endif /* VMS */
16260165Shibler 	 ) p--;
16360165Shibler 
16460165Shibler   return make_string (p, end - p);
16560165Shibler }
16660165Shibler 
16760165Shibler char *
file_name_as_directory(out,in)16860165Shibler file_name_as_directory (out, in)
16960165Shibler      char *out, *in;
17060165Shibler {
17160165Shibler   int size = strlen (in) - 1;
17260165Shibler 
17360165Shibler   strcpy (out, in);
17460165Shibler 
17560165Shibler #ifdef VMS
17660165Shibler   /* Is it already a directory string? */
17760165Shibler   if (in[size] == ':' || in[size] == ']' || in[size] == '>')
17860165Shibler     return out;
17960165Shibler   /* Is it a VMS directory file name?  If so, hack VMS syntax.  */
18060165Shibler   else if (! index (in, '/')
18160165Shibler 	   && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
18260165Shibler 	       || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
18360165Shibler 	       || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
18460165Shibler 				|| ! strncmp (&in[size - 5], ".dir", 4))
18560165Shibler 		   && (in[size - 1] == '.' || in[size - 1] == ';')
18660165Shibler 		   && in[size] == '1')))
18760165Shibler     {
18860165Shibler       register char *p, *dot;
18960165Shibler       char brack;
19060165Shibler 
19160165Shibler       /* x.dir -> [.x]
19260165Shibler 	 dir:x.dir --> dir:[x]
19360165Shibler 	 dir:[x]y.dir --> dir:[x.y] */
19460165Shibler       p = in + size;
19560165Shibler       while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
19660165Shibler       if (p != in)
19760165Shibler 	{
19860165Shibler 	  strncpy (out, in, p - in);
19960165Shibler 	  out[p - in] = '\0';
20060165Shibler 	  if (*p == ':')
20160165Shibler 	    {
20260165Shibler 	      brack = ']';
20360165Shibler 	      strcat (out, ":[");
20460165Shibler 	    }
20560165Shibler 	  else
20660165Shibler 	    {
20760165Shibler 	      brack = *p;
20860165Shibler 	      strcat (out, ".");
20960165Shibler 	    }
21060165Shibler 	  p++;
21160165Shibler 	}
21260165Shibler       else
21360165Shibler 	{
21460165Shibler 	  brack = ']';
21560165Shibler 	  strcpy (out, "[.");
21660165Shibler 	}
21760165Shibler       if (dot = index (p, '.'))
21860165Shibler 	{
21960165Shibler 	  /* blindly remove any extension */
22060165Shibler 	  size = strlen (out) + (dot - p);
22160165Shibler 	  strncat (out, p, dot - p);
22260165Shibler 	}
22360165Shibler       else
22460165Shibler 	{
22560165Shibler 	  strcat (out, p);
22660165Shibler 	  size = strlen (out);
22760165Shibler 	}
22860165Shibler       out[size++] = brack;
22960165Shibler       out[size] = '\0';
23060165Shibler     }
23160165Shibler #else /* not VMS */
23260165Shibler   /* For Unix syntax, Append a slash if necessary */
23360165Shibler   if (out[size] != '/')
23460165Shibler     strcat (out, "/");
23560165Shibler #endif /* not VMS */
23660165Shibler   return out;
23760165Shibler }
23860165Shibler 
23960165Shibler DEFUN ("file-name-as-directory", Ffile_name_as_directory,
24060165Shibler        Sfile_name_as_directory, 1, 1, 0,
24160165Shibler   "Return a string representing file FILENAME interpreted as a directory.\n\
24260165Shibler This string can be used as the value of default-directory\n\
24360165Shibler or passed as second argument to expand-file-name.\n\
24460165Shibler For a Unix-syntax file name, just appends a slash.\n\
24560165Shibler On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
24660165Shibler   (file)
24760165Shibler      Lisp_Object file;
24860165Shibler {
24960165Shibler   char *buf;
25060165Shibler 
25160165Shibler   CHECK_STRING (file, 0);
25260165Shibler   if (NULL (file))
25360165Shibler     return Qnil;
25460165Shibler   buf = (char *) alloca (XSTRING (file)->size + 10);
25560165Shibler   return build_string (file_name_as_directory (buf, XSTRING (file)->data));
25660165Shibler }
25760165Shibler 
25860165Shibler /*
25960165Shibler  * Convert from directory name to filename.
26060165Shibler  * On VMS:
26160165Shibler  *       xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
26260165Shibler  *       xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
26360165Shibler  * On UNIX, it's simple: just make sure there is a terminating /
26460165Shibler 
26560165Shibler  * Value is nonzero if the string output is different from the input.
26660165Shibler  */
26760165Shibler 
directory_file_name(src,dst)26860165Shibler directory_file_name (src, dst)
26960165Shibler      char *src, *dst;
27060165Shibler {
27160165Shibler   long slen;
27260165Shibler #ifdef VMS
27360165Shibler   long rlen;
27460165Shibler   char * ptr, * rptr;
27560165Shibler   char bracket;
27660165Shibler   struct FAB fab = cc$rms_fab;
27760165Shibler   struct NAM nam = cc$rms_nam;
27860165Shibler   char esa[NAM$C_MAXRSS];
27960165Shibler #endif /* VMS */
28060165Shibler 
28160165Shibler   slen = strlen (src) - 1;
28260165Shibler #ifdef VMS
28360165Shibler   if (! index (src, '/')
28460165Shibler       && (src[slen] == ']' || src[slen] == ':' || src[slen] == '>'))
28560165Shibler     {
28660165Shibler       /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
28760165Shibler       fab.fab$l_fna = src;
28860165Shibler       fab.fab$b_fns = slen + 1;
28960165Shibler       fab.fab$l_nam = &nam;
29060165Shibler       fab.fab$l_fop = FAB$M_NAM;
29160165Shibler 
29260165Shibler       nam.nam$l_esa = esa;
29360165Shibler       nam.nam$b_ess = sizeof esa;
29460165Shibler       nam.nam$b_nop |= NAM$M_SYNCHK;
29560165Shibler 
29660165Shibler       /* We call SYS$PARSE to handle such things as [--] for us. */
29760165Shibler       if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
29860165Shibler 	{
29960165Shibler 	  slen = nam.nam$b_esl - 1;
30060165Shibler 	  if (esa[slen] == ';' && esa[slen - 1] == '.')
30160165Shibler 	    slen -= 2;
30260165Shibler 	  esa[slen + 1] = '\0';
30360165Shibler 	  src = esa;
30460165Shibler 	}
30560165Shibler       if (src[slen] != ']' && src[slen] != '>')
30660165Shibler 	{
30760165Shibler 	  /* what about when we have logical_name:???? */
30860165Shibler 	  if (src[slen] == ':')
30960165Shibler 	    {			/* Xlate logical name and see what we get */
31060165Shibler 	      ptr = strcpy (dst, src); /* upper case for getenv */
31160165Shibler 	      while (*ptr)
31260165Shibler 		{
31360165Shibler 		  if ('a' <= *ptr && *ptr <= 'z')
31460165Shibler 		    *ptr -= 040;
31560165Shibler 		  ptr++;
31660165Shibler 		}
31760165Shibler 	      dst[slen] = 0;	/* remove colon */
31860165Shibler 	      if (!(src = egetenv (dst)))
31960165Shibler 		return 0;
32060165Shibler 	      /* should we jump to the beginning of this procedure?
32160165Shibler 		 Good points: allows us to use logical names that xlate
32260165Shibler 		 to Unix names,
32360165Shibler 		 Bad points: can be a problem if we just translated to a device
32460165Shibler 		 name...
32560165Shibler 		 For now, I'll punt and always expect VMS names, and hope for
32660165Shibler 		 the best! */
32760165Shibler 	      slen = strlen (src) - 1;
32860165Shibler 	      if (src[slen] != ']' && src[slen] != '>')
32960165Shibler 		{ /* no recursion here! */
33060165Shibler 		  strcpy (dst, src);
33160165Shibler 		  return 0;
33260165Shibler 		}
33360165Shibler 	    }
33460165Shibler 	  else
33560165Shibler 	    {		/* not a directory spec */
33660165Shibler 	      strcpy (dst, src);
33760165Shibler 	      return 0;
33860165Shibler 	    }
33960165Shibler 	}
34060165Shibler       bracket = src[slen];
34160165Shibler       if (!(ptr = index (src, bracket - 2)))
34260165Shibler 	{ /* no opening bracket */
34360165Shibler 	  strcpy (dst, src);
34460165Shibler 	  return 0;
34560165Shibler 	}
34660165Shibler       if (!(rptr = rindex (src, '.')))
34760165Shibler 	rptr = ptr;
34860165Shibler       slen = rptr - src;
34960165Shibler       strncpy (dst, src, slen);
35060165Shibler       dst[slen] = '\0';
35160165Shibler       if (*rptr == '.')
35260165Shibler 	{
35360165Shibler 	  dst[slen++] = bracket;
35460165Shibler 	  dst[slen] = '\0';
35560165Shibler 	}
35660165Shibler       else
35760165Shibler 	{
35860165Shibler 	  /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
35960165Shibler 	     then translate the device and recurse. */
36060165Shibler 	  if (dst[slen - 1] == ':'
36160165Shibler 	      && dst[slen - 2] != ':'	/* skip decnet nodes */
36260165Shibler 	      && strcmp(src + slen, "[000000]") == 0)
36360165Shibler 	    {
36460165Shibler 	      dst[slen - 1] = '\0';
36560165Shibler 	      if ((ptr = egetenv (dst))
36660165Shibler 		  && (rlen = strlen (ptr) - 1) > 0
36760165Shibler 		  && (ptr[rlen] == ']' || ptr[rlen] == '>')
36860165Shibler 		  && ptr[rlen - 1] == '.')
36960165Shibler 		{
37060165Shibler 		  ptr[rlen - 1] = ']';
37160165Shibler 		  ptr[rlen] = '\0';
37260165Shibler 		  return directory_file_name (ptr, dst);
37360165Shibler 		}
37460165Shibler 	      else
37560165Shibler 		dst[slen - 1] = ':';
37660165Shibler 	    }
37760165Shibler 	  strcat (dst, "[000000]");
37860165Shibler 	  slen += 8;
37960165Shibler 	}
38060165Shibler       rptr++;
38160165Shibler       rlen = strlen (rptr) - 1;
38260165Shibler       strncat (dst, rptr, rlen);
38360165Shibler       dst[slen + rlen] = '\0';
38460165Shibler       strcat (dst, ".DIR.1");
38560165Shibler       return 1;
38660165Shibler     }
38760165Shibler #endif /* VMS */
38860165Shibler   /* Process as Unix format: just remove any final slash.
38960165Shibler      But leave "/" unchanged; do not change it to "".  */
39060165Shibler   strcpy (dst, src);
39160165Shibler   if (dst[slen] == '/' && slen > 1)
39260165Shibler     dst[slen] = 0;
39360165Shibler   return 1;
39460165Shibler }
39560165Shibler 
39660165Shibler DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
39760165Shibler   1, 1, 0,
39860165Shibler   "Returns the file name of the directory named DIR.\n\
39960165Shibler This is the name of the file that holds the data for the directory DIR.\n\
40060165Shibler In Unix-syntax, this just removes the final slash.\n\
40160165Shibler On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
40260165Shibler returns a file name such as \"[X]Y.DIR.1\".")
40360165Shibler   (directory)
40460165Shibler      Lisp_Object directory;
40560165Shibler {
40660165Shibler   char *buf;
40760165Shibler 
40860165Shibler   CHECK_STRING (directory, 0);
40960165Shibler 
41060165Shibler   if (NULL (directory))
41160165Shibler     return Qnil;
41260165Shibler #ifdef VMS
41360165Shibler   /* 20 extra chars is insufficient for VMS, since we might perform a
41460165Shibler      logical name translation. an equivalence string can be up to 255
41560165Shibler      chars long, so grab that much extra space...  - sss */
41660165Shibler   buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
41760165Shibler #else
41860165Shibler   buf = (char *) alloca (XSTRING (directory)->size + 20);
41960165Shibler #endif
42060165Shibler   directory_file_name (XSTRING (directory)->data, buf);
42160165Shibler   return build_string (buf);
42260165Shibler }
42360165Shibler 
42460165Shibler DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
42560165Shibler   "Generate temporary name (string) starting with PREFIX (a string).")
42660165Shibler   (prefix)
42760165Shibler      Lisp_Object prefix;
42860165Shibler {
42960165Shibler   Lisp_Object val;
43060165Shibler   val = concat2 (prefix, build_string ("XXXXXX"));
43160165Shibler   mktemp (XSTRING (val)->data);
43260165Shibler   return val;
43360165Shibler }
43460165Shibler 
43560165Shibler DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
43660165Shibler   "Convert FILENAME to absolute, and canonicalize it.\n\
43760165Shibler Second arg DEFAULT is directory to start with if FILENAME is relative\n\
43860165Shibler  (does not start with slash); if DEFAULT is nil or missing,\n\
43960165Shibler the current buffer's value of default-directory is used.\n\
44060165Shibler Filenames containing . or .. as components are simplified;\n\
44160165Shibler initial ~ is expanded.  See also the function  substitute-in-file-name.")
44260165Shibler      (name, defalt)
44360165Shibler      Lisp_Object name, defalt;
44460165Shibler {
44560165Shibler   unsigned char *nm;
44660165Shibler 
44760165Shibler   register unsigned char *newdir, *p, *o;
44860165Shibler   int tlen;
44960165Shibler   unsigned char *target;
45060165Shibler   struct passwd *pw;
45160165Shibler   int lose;
45260165Shibler #ifdef VMS
45360165Shibler   unsigned char * colon = 0;
45460165Shibler   unsigned char * close = 0;
45560165Shibler   unsigned char * slash = 0;
45660165Shibler   unsigned char * brack = 0;
45760165Shibler   int lbrack = 0, rbrack = 0;
45860165Shibler   int dots = 0;
45960165Shibler #endif /* VMS */
46060165Shibler 
46160165Shibler   CHECK_STRING (name, 0);
46260165Shibler 
46360165Shibler #ifdef VMS
46460165Shibler   /* Filenames on VMS are always upper case.  */
46560165Shibler   name = Fupcase (name);
46660165Shibler #endif
46760165Shibler 
46860165Shibler   nm = XSTRING (name)->data;
46960165Shibler 
47060165Shibler   /* If nm is absolute, flush ...// and detect /./ and /../.
47160165Shibler      If no /./ or /../ we can return right away. */
47260165Shibler   if (
47360165Shibler       nm[0] == '/'
47460165Shibler #ifdef VMS
47560165Shibler       || index (nm, ':')
47660165Shibler #endif /* VMS */
47760165Shibler       )
47860165Shibler     {
47960165Shibler       p = nm;
48060165Shibler       lose = 0;
48160165Shibler       while (*p)
48260165Shibler 	{
48360165Shibler 	  if (p[0] == '/' && p[1] == '/'
48460165Shibler #ifdef APOLLO
48560165Shibler 	      /* // at start of filename is meaningful on Apollo system */
48660165Shibler 	      && nm != p
48760165Shibler #endif /* APOLLO */
48860165Shibler 	      )
48960165Shibler 	    nm = p + 1;
49060165Shibler 	  if (p[0] == '/' && p[1] == '~')
49160165Shibler 	    nm = p + 1, lose = 1;
49260165Shibler 	  if (p[0] == '/' && p[1] == '.'
49360165Shibler 	      && (p[2] == '/' || p[2] == 0
49460165Shibler 		  || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
49560165Shibler 	    lose = 1;
49660165Shibler #ifdef VMS
49760165Shibler 	  if (p[0] == '\\')
49860165Shibler 	    lose = 1;
49960165Shibler 	  if (p[0] == '/') {
50060165Shibler 	    /* if dev:[dir]/, move nm to / */
50160165Shibler 	    if (!slash && p > nm && (brack || colon)) {
50260165Shibler 	      nm = (brack ? brack + 1 : colon + 1);
50360165Shibler 	      lbrack = rbrack = 0;
50460165Shibler 	      brack = 0;
50560165Shibler 	      colon = 0;
50660165Shibler 	    }
50760165Shibler 	    slash = p;
50860165Shibler 	  }
50960165Shibler 	  if (p[0] == '-')
51060165Shibler #ifndef VMS4_4
51160165Shibler 	    /* VMS pre V4.4,convert '-'s in filenames. */
51260165Shibler 	    if (lbrack == rbrack)
51360165Shibler 	      {
51460165Shibler 		if (dots < 2)	/* this is to allow negative version numbers */
51560165Shibler 		  p[0] = '_';
51660165Shibler 	      }
51760165Shibler 	    else
51860165Shibler #endif /* VMS4_4 */
51960165Shibler 	      if (lbrack > rbrack &&
52060165Shibler 		  ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
52160165Shibler 		   (p[1] == '.' || p[1] == ']' || p[1] == '>')))
52260165Shibler 		lose = 1;
52360165Shibler #ifndef VMS4_4
52460165Shibler 	      else
52560165Shibler 		p[0] = '_';
52660165Shibler #endif /* VMS4_4 */
52760165Shibler 	  /* count open brackets, reset close bracket pointer */
52860165Shibler 	  if (p[0] == '[' || p[0] == '<')
52960165Shibler 	    lbrack++, brack = 0;
53060165Shibler 	  /* count close brackets, set close bracket pointer */
53160165Shibler 	  if (p[0] == ']' || p[0] == '>')
53260165Shibler 	    rbrack++, brack = p;
53360165Shibler 	  /* detect ][ or >< */
53460165Shibler 	  if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
53560165Shibler 	    lose = 1;
53660165Shibler 	  if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
53760165Shibler 	    nm = p + 1, lose = 1;
53860165Shibler 	  if (p[0] == ':' && (colon || slash))
53960165Shibler 	    /* if dev1:[dir]dev2:, move nm to dev2: */
54060165Shibler 	    if (brack)
54160165Shibler 	      {
54260165Shibler 		nm = brack + 1;
54360165Shibler 		brack = 0;
54460165Shibler 	      }
54560165Shibler 	    /* if /pathname/dev:, move nm to dev: */
54660165Shibler 	    else if (slash)
54760165Shibler 	      nm = slash + 1;
54860165Shibler 	    /* if node::dev:, move colon following dev */
54960165Shibler 	    else if (colon && colon[-1] == ':')
55060165Shibler 	      colon = p;
55160165Shibler 	    /* if dev1:dev2:, move nm to dev2: */
55260165Shibler 	    else if (colon && colon[-1] != ':')
55360165Shibler 	      {
55460165Shibler 		nm = colon + 1;
55560165Shibler 		colon = 0;
55660165Shibler 	      }
55760165Shibler 	  if (p[0] == ':' && !colon)
55860165Shibler 	    {
55960165Shibler 	      if (p[1] == ':')
56060165Shibler 		p++;
56160165Shibler 	      colon = p;
56260165Shibler 	    }
56360165Shibler 	  if (lbrack == rbrack)
56460165Shibler 	    if (p[0] == ';')
56560165Shibler 	      dots = 2;
56660165Shibler 	    else if (p[0] == '.')
56760165Shibler 	      dots++;
56860165Shibler #endif /* VMS */
56960165Shibler 	  p++;
57060165Shibler 	}
57160165Shibler       if (!lose)
57260165Shibler 	{
57360165Shibler #ifdef VMS
57460165Shibler 	  if (index (nm, '/'))
57560165Shibler 	    return build_string (sys_translate_unix (nm));
57660165Shibler #endif /* VMS */
57760165Shibler 	  if (nm == XSTRING (name)->data)
57860165Shibler 	    return name;
57960165Shibler 	  return build_string (nm);
58060165Shibler 	}
58160165Shibler     }
58260165Shibler 
58360165Shibler   /* Now determine directory to start with and put it in NEWDIR.  */
58460165Shibler 
58560165Shibler   newdir = 0;
58660165Shibler 
58760165Shibler   if (nm[0] == '~')
58860165Shibler     {
58960165Shibler       if (nm[1] == '/'
59060165Shibler #ifdef VMS
59160165Shibler 	  || nm[1] == ':'
59260165Shibler #endif /* VMS */
59360165Shibler 	  || nm[1] == 0)
59460165Shibler 	{
59560165Shibler 	  /* Handle ~ on its own.  */
59660165Shibler 	  newdir = (unsigned char *) egetenv ("HOME");
59760165Shibler 	}
59860165Shibler       else
59960165Shibler 	{
60060165Shibler 	  /* Handle ~ followed by user name.  */
60160165Shibler 	  unsigned char *user = nm + 1;
60260165Shibler 	  /* Find end of name.  */
60360165Shibler 	  unsigned char *ptr = (unsigned char *) index (user, '/');
60460165Shibler 	  int len = ptr ? ptr - user : strlen (user);
60560165Shibler #ifdef VMS
60660165Shibler 	  unsigned char *ptr1 = index (user, ':');
60760165Shibler 	  if (ptr1 != 0 && ptr1 - user < len)
60860165Shibler 	    len = ptr1 - user;
60960165Shibler #endif /* VMS */
61060165Shibler 	  /* Copy the user name into temp storage.  */
61160165Shibler 	  o = (unsigned char *) alloca (len + 1);
61260165Shibler 	  bcopy ((char *) user, o, len);
61360165Shibler 	  o[len] = 0;
61460165Shibler 
61560165Shibler 	  /* Look up the user name.  */
61660165Shibler 	  pw = (struct passwd *) getpwnam (o);
61760165Shibler 	  if (!pw)
61860165Shibler 	    error ("User \"%s\" is not known", o);
61960165Shibler 	  newdir = (unsigned char *) pw->pw_dir;
62060165Shibler 
62160165Shibler 	  /* Discard the user name from NM.  */
62260165Shibler 	  nm += len;
62360165Shibler 	}
62460165Shibler 
62560165Shibler       /* Discard the ~ from NM.  */
62660165Shibler       nm++;
62760165Shibler #ifdef VMS
62860165Shibler       if (*nm != 0)
62960165Shibler 	nm++;			/* Don't leave the slash in nm.  */
63060165Shibler #endif /* VMS */
63160165Shibler 
63260165Shibler       if (newdir == 0)
63360165Shibler 	newdir = (unsigned char *) "";
63460165Shibler     }
63560165Shibler 
63660165Shibler   if (nm[0] != '/'
63760165Shibler #ifdef VMS
63860165Shibler       && !index (nm, ':')
63960165Shibler #endif /* not VMS */
64060165Shibler       && !newdir)
64160165Shibler     {
64260165Shibler       if (NULL (defalt))
64360165Shibler 	defalt = current_buffer->directory;
64460165Shibler       CHECK_STRING (defalt, 1);
64560165Shibler       newdir = XSTRING (defalt)->data;
64660165Shibler     }
64760165Shibler 
64860165Shibler   /* Now concatenate the directory and name to new space in the stack frame */
64960165Shibler 
65060165Shibler   tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
65160165Shibler   target = (unsigned char *) alloca (tlen);
65260165Shibler   *target = 0;
65360165Shibler 
65460165Shibler   if (newdir)
65560165Shibler     {
65660165Shibler #ifndef VMS
65760165Shibler       if (nm[0] == 0 || nm[0] == '/')
65860165Shibler 	strcpy (target, newdir);
65960165Shibler       else
66060165Shibler #endif
66160165Shibler       file_name_as_directory (target, newdir);
66260165Shibler     }
66360165Shibler 
66460165Shibler   strcat (target, nm);
66560165Shibler #ifdef VMS
66660165Shibler   if (index (target, '/'))
66760165Shibler     strcpy (target, sys_translate_unix (target));
66860165Shibler #endif /* VMS */
66960165Shibler 
67060165Shibler   /* Now canonicalize by removing /. and /foo/.. if they appear */
67160165Shibler 
67260165Shibler   p = target;
67360165Shibler   o = target;
67460165Shibler 
67560165Shibler   while (*p)
67660165Shibler     {
67760165Shibler #ifdef VMS
67860165Shibler       if (*p != ']' && *p != '>' && *p != '-')
67960165Shibler 	{
68060165Shibler 	  if (*p == '\\')
68160165Shibler 	    p++;
68260165Shibler 	  *o++ = *p++;
68360165Shibler 	}
68460165Shibler       else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
68560165Shibler 	/* brackets are offset from each other by 2 */
68660165Shibler 	{
68760165Shibler 	  p += 2;
68860165Shibler 	  if (*p != '.' && *p != '-' && o[-1] != '.')
68960165Shibler 	    /* convert [foo][bar] to [bar] */
69060165Shibler 	    while (o[-1] != '[' && o[-1] != '<')
69160165Shibler 	      o--;
69260165Shibler 	  else if (*p == '-' && *o != '.')
69360165Shibler 	    *--p = '.';
69460165Shibler 	}
69560165Shibler       else if (p[0] == '-' && o[-1] == '.' &&
69660165Shibler 	       (p[1] == '.' || p[1] == ']' || p[1] == '>'))
69760165Shibler 	/* flush .foo.- ; leave - if stopped by '[' or '<' */
69860165Shibler 	{
69960165Shibler 	  do
70060165Shibler 	    o--;
70160165Shibler 	  while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
70260165Shibler 	  if (p[1] == '.')	/* foo.-.bar ==> bar*/
70360165Shibler 	    p += 2;
70460165Shibler 	  else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
70560165Shibler 	    p++, o--;
70660165Shibler 	  /* else [foo.-] ==> [-] */
70760165Shibler 	}
70860165Shibler       else
70960165Shibler 	{
71060165Shibler #ifndef VMS4_4
71160165Shibler 	  if (*p == '-' &&
71260165Shibler 	      o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
71360165Shibler 	      p[1] != ']' && p[1] != '>' && p[1] != '.')
71460165Shibler 	    *p = '_';
71560165Shibler #endif /* VMS4_4 */
71660165Shibler 	  *o++ = *p++;
71760165Shibler 	}
71860165Shibler #else /* not VMS */
71960165Shibler       if (*p != '/')
72060165Shibler  	{
72160165Shibler 	  *o++ = *p++;
72260165Shibler 	}
72360165Shibler       else if (!strncmp (p, "//", 2)
72460165Shibler #ifdef APOLLO
72560165Shibler 	       /* // at start of filename is meaningful in Apollo system */
72660165Shibler 	       && o != target
72760165Shibler #endif /* APOLLO */
72860165Shibler 	       )
72960165Shibler 	{
73060165Shibler 	  o = target;
73160165Shibler 	  p++;
73260165Shibler 	}
73360165Shibler       else if (p[0] == '/' && p[1] == '.' &&
73460165Shibler 	       (p[2] == '/' || p[2] == 0))
73560165Shibler 	p += 2;
73660165Shibler       else if (!strncmp (p, "/..", 3)
73760165Shibler 	       /* `/../' is the "superroot" on certain file systems.  */
73860165Shibler 	       && o != target
73960165Shibler 	       && (p[3] == '/' || p[3] == 0))
74060165Shibler 	{
74160165Shibler 	  while (o != target && *--o != '/')
74260165Shibler 	    ;
74360165Shibler #ifdef APOLLO
74460165Shibler 	  if (o == target + 1 && o[-1] == '/' && o[0] == '/')
74560165Shibler 	    ++o;
74660165Shibler 	  else
74760165Shibler #endif APOLLO
74860165Shibler 	  if (o == target && *o == '/')
74960165Shibler 	    ++o;
75060165Shibler 	  p += 3;
75160165Shibler 	}
75260165Shibler       else
75360165Shibler  	{
75460165Shibler 	  *o++ = *p++;
75560165Shibler 	}
75660165Shibler #endif /* not VMS */
75760165Shibler     }
75860165Shibler 
75960165Shibler   return make_string (target, o - target);
76060165Shibler }
76160165Shibler 
76260165Shibler DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
76360165Shibler   Ssubstitute_in_file_name, 1, 1, 0,
76460165Shibler   "Substitute environment variables referred to in STRING.\n\
76560165Shibler A $ begins a request to substitute; the env variable name is the alphanumeric\n\
76660165Shibler characters and underscores after the $, or is surrounded by braces.\n\
76760165Shibler If a ~ appears following a /, everything through that / is discarded.\n\
76860165Shibler On VMS, $ substitution is not done; this function does little and only\n\
76960165Shibler duplicates what expand-file-name does.")
77060165Shibler   (string)
77160165Shibler      Lisp_Object string;
77260165Shibler {
77360165Shibler   unsigned char *nm;
77460165Shibler 
77560165Shibler   register unsigned char *s, *p, *o, *x, *endp;
77660165Shibler   unsigned char *target;
77760165Shibler   int total = 0;
77860165Shibler   int substituted = 0;
77960165Shibler   unsigned char *xnm;
78060165Shibler 
78160165Shibler   CHECK_STRING (string, 0);
78260165Shibler 
78360165Shibler   nm = XSTRING (string)->data;
78460165Shibler   endp = nm + XSTRING (string)->size;
78560165Shibler 
78660165Shibler   /* If /~ or // appears, discard everything through first slash. */
78760165Shibler 
78860165Shibler   for (p = nm; p != endp; p++)
78960165Shibler     {
79060165Shibler       if ((p[0] == '~' ||
79160165Shibler #ifdef APOLLO
79260165Shibler 	   /* // at start of file name is meaningful in Apollo system */
79360165Shibler 	   (p[0] == '/' && p - 1 != nm)
79460165Shibler #else /* not APOLLO */
79560165Shibler 	   p[0] == '/'
79660165Shibler #endif /* not APOLLO */
79760165Shibler 	   )
79860165Shibler 	  && p != nm &&
79960165Shibler #ifdef VMS
80060165Shibler 	  (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' ||
80160165Shibler #endif /* VMS */
80260165Shibler 	  p[-1] == '/')
80360165Shibler #ifdef VMS
80460165Shibler 	  )
80560165Shibler #endif /* VMS */
80660165Shibler 	{
80760165Shibler 	  nm = p;
80860165Shibler 	  substituted = 1;
80960165Shibler 	}
81060165Shibler     }
81160165Shibler 
81260165Shibler #ifdef VMS
81360165Shibler   return build_string (nm);
81460165Shibler #else
81560165Shibler 
81660165Shibler   /* See if any variables are substituted into the string
81760165Shibler      and find the total length of their values in `total' */
81860165Shibler 
81960165Shibler   for (p = nm; p != endp;)
82060165Shibler     if (*p != '$')
82160165Shibler       p++;
82260165Shibler     else
82360165Shibler       {
82460165Shibler 	p++;
82560165Shibler 	if (p == endp)
82660165Shibler 	  goto badsubst;
82760165Shibler 	else if (*p == '$')
82860165Shibler 	  {
82960165Shibler 	    /* "$$" means a single "$" */
83060165Shibler 	    p++;
83160165Shibler 	    total -= 1;
83260165Shibler 	    substituted = 1;
83360165Shibler 	    continue;
83460165Shibler 	  }
83560165Shibler 	else if (*p == '{')
83660165Shibler 	  {
83760165Shibler 	    o = ++p;
83860165Shibler 	    while (p != endp && *p != '}') p++;
83960165Shibler 	    if (*p != '}') goto missingclose;
84060165Shibler 	    s = p;
84160165Shibler 	  }
84260165Shibler 	else
84360165Shibler 	  {
84460165Shibler 	    o = p;
84560165Shibler 	    while (p != endp && (isalnum (*p) || *p == '_')) p++;
84660165Shibler 	    s = p;
84760165Shibler 	  }
84860165Shibler 
84960165Shibler 	/* Copy out the variable name */
85060165Shibler 	target = (unsigned char *) alloca (s - o + 1);
85160165Shibler 	strncpy (target, o, s - o);
85260165Shibler 	target[s - o] = 0;
85360165Shibler 
85460165Shibler 	/* Get variable value */
85560165Shibler 	o = (unsigned char *) egetenv (target);
85660165Shibler /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
85760165Shibler #if 0
85860165Shibler #ifdef USG
85960165Shibler 	if (!o && !strcmp (target, "USER"))
86060165Shibler 	  o = egetenv ("LOGNAME");
86160165Shibler #endif /* USG */
86260165Shibler #endif /* 0 */
86360165Shibler 	if (!o) goto badvar;
86460165Shibler 	total += strlen (o);
86560165Shibler 	substituted = 1;
86660165Shibler       }
86760165Shibler 
86860165Shibler   if (!substituted)
86960165Shibler     return string;
87060165Shibler 
87160165Shibler   /* If substitution required, recopy the string and do it */
87260165Shibler   /* Make space in stack frame for the new copy */
87360165Shibler   xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
87460165Shibler   x = xnm;
87560165Shibler 
87660165Shibler   /* Copy the rest of the name through, replacing $ constructs with values */
87760165Shibler   for (p = nm; *p;)
87860165Shibler     if (*p != '$')
87960165Shibler       *x++ = *p++;
88060165Shibler     else
88160165Shibler       {
88260165Shibler 	p++;
88360165Shibler 	if (p == endp)
88460165Shibler 	  goto badsubst;
88560165Shibler 	else if (*p == '$')
88660165Shibler 	  {
88760165Shibler 	    *x++ = *p++;
88860165Shibler 	    continue;
88960165Shibler 	  }
89060165Shibler 	else if (*p == '{')
89160165Shibler 	  {
89260165Shibler 	    o = ++p;
89360165Shibler 	    while (p != endp && *p != '}') p++;
89460165Shibler 	    if (*p != '}') goto missingclose;
89560165Shibler 	    s = p++;
89660165Shibler 	  }
89760165Shibler 	else
89860165Shibler 	  {
89960165Shibler 	    o = p;
90060165Shibler 	    while (p != endp && (isalnum (*p) || *p == '_')) p++;
90160165Shibler 	    s = p;
90260165Shibler 	  }
90360165Shibler 
90460165Shibler 	/* Copy out the variable name */
90560165Shibler 	target = (unsigned char *) alloca (s - o + 1);
90660165Shibler 	strncpy (target, o, s - o);
90760165Shibler 	target[s - o] = 0;
90860165Shibler 
90960165Shibler 	/* Get variable value */
91060165Shibler 	o = (unsigned char *) egetenv (target);
91160165Shibler /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
91260165Shibler #if 0
91360165Shibler #ifdef USG
91460165Shibler 	if (!o && !strcmp (target, "USER"))
91560165Shibler 	  o = egetenv ("LOGNAME");
91660165Shibler #endif /* USG */
91760165Shibler #endif /* 0 */
91860165Shibler 	if (!o)
91960165Shibler 	  goto badvar;
92060165Shibler 
92160165Shibler 	strcpy (x, o);
92260165Shibler 	x += strlen (o);
92360165Shibler       }
92460165Shibler 
92560165Shibler   *x = 0;
92660165Shibler 
92760165Shibler   /* If /~ or // appears, discard everything through first slash. */
92860165Shibler 
92960165Shibler   for (p = xnm; p != x; p++)
93060165Shibler     if ((p[0] == '~' ||
93160165Shibler #ifdef APOLLO
93260165Shibler 	 /* // at start of file name is meaningful in Apollo system */
93360165Shibler 	 (p[0] == '/' && p - 1 != xnm)
93460165Shibler #else /* not APOLLO */
93560165Shibler 	 p[0] == '/'
93660165Shibler #endif /* not APOLLO */
93760165Shibler 	 )
93860165Shibler 	&& p != nm && p[-1] == '/')
93960165Shibler       xnm = p;
94060165Shibler 
94160165Shibler   return make_string (xnm, x - xnm);
94260165Shibler 
94360165Shibler  badsubst:
94460165Shibler   error ("Bad format environment-variable substitution");
94560165Shibler  missingclose:
94660165Shibler   error ("Missing \"}\" in environment-variable substitution");
94760165Shibler  badvar:
94860165Shibler   error ("Substituting nonexistent environment variable \"%s\"", target);
94960165Shibler 
95060165Shibler   /* NOTREACHED */
95160165Shibler #endif /* not VMS */
95260165Shibler }
95360165Shibler 
95460165Shibler Lisp_Object
expand_and_dir_to_file(filename,defdir)95560165Shibler expand_and_dir_to_file (filename, defdir)
95660165Shibler      Lisp_Object filename, defdir;
95760165Shibler {
95860165Shibler   register Lisp_Object abspath;
95960165Shibler 
96060165Shibler   abspath = Fexpand_file_name (filename, defdir);
96160165Shibler #ifdef VMS
96260165Shibler   {
96360165Shibler     register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1];
96460165Shibler     if (c == ':' || c == ']' || c == '>')
96560165Shibler       abspath = Fdirectory_file_name (abspath);
96660165Shibler   }
96760165Shibler #else
96860165Shibler   /* Remove final slash, if any (unless path is root).
96960165Shibler      stat behaves differently depending!  */
97060165Shibler   if (XSTRING (abspath)->size > 1
97160165Shibler       && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
97260165Shibler     {
97360165Shibler       if (EQ (abspath, filename))
97460165Shibler 	abspath = Fcopy_sequence (abspath);
97560165Shibler       XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
97660165Shibler     }
97760165Shibler #endif
97860165Shibler   return abspath;
97960165Shibler }
98060165Shibler 
barf_or_query_if_file_exists(absname,querystring,interactive)98160165Shibler barf_or_query_if_file_exists (absname, querystring, interactive)
98260165Shibler      Lisp_Object absname;
98360165Shibler      unsigned char *querystring;
98460165Shibler      int interactive;
98560165Shibler {
98660165Shibler   register Lisp_Object tem;
98760165Shibler   struct gcpro gcpro1;
98860165Shibler 
98960165Shibler   if (access (XSTRING (absname)->data, 4) >= 0)
99060165Shibler     {
99160165Shibler       if (! interactive)
99260165Shibler 	Fsignal (Qfile_already_exists,
99360165Shibler 		 Fcons (build_string ("File already exists"),
99460165Shibler 			Fcons (absname, Qnil)));
99560165Shibler       GCPRO1 (absname);
99660165Shibler       tem = Fyes_or_no_p (format1 ("File %s already exists; %s anyway? ",
99760165Shibler 				   XSTRING (absname)->data, querystring));
99860165Shibler       UNGCPRO;
99960165Shibler       if (NULL (tem))
100060165Shibler 	Fsignal (Qfile_already_exists,
100160165Shibler 		 Fcons (build_string ("File already exists"),
100260165Shibler 			Fcons (absname, Qnil)));
100360165Shibler     }
100460165Shibler   return;
100560165Shibler }
100660165Shibler 
100760165Shibler DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
100860165Shibler   "fCopy file: \nFCopy %s to file: \np",
100960165Shibler   "Copy FILE to NEWNAME.  Both args strings.\n\
101060165Shibler Signals a  file-already-exists  error if NEWNAME already exists,\n\
101160165Shibler unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
101260165Shibler A number as third arg means request confirmation if NEWNAME already exists.\n\
101360165Shibler This is what happens in interactive use with M-x.\n\
101460165Shibler Fourth arg non-nil means give the new file the same last-modified time\n\
101560165Shibler that the old one has.  (This works on only some systems.)")
101660165Shibler   (filename, newname, ok_if_already_exists, keep_date)
101760165Shibler      Lisp_Object filename, newname, ok_if_already_exists, keep_date;
101860165Shibler {
101960165Shibler   int ifd, ofd, n;
102060165Shibler   char buf[16 * 1024];
102160165Shibler   struct stat st;
102260165Shibler   struct gcpro gcpro1, gcpro2;
102360165Shibler 
102460165Shibler   GCPRO2 (filename, newname);
102560165Shibler   CHECK_STRING (filename, 0);
102660165Shibler   CHECK_STRING (newname, 1);
102760165Shibler   filename = Fexpand_file_name (filename, Qnil);
102860165Shibler   newname = Fexpand_file_name (newname, Qnil);
102960165Shibler   if (NULL (ok_if_already_exists)
103060165Shibler       || XTYPE (ok_if_already_exists) == Lisp_Int)
103160165Shibler     barf_or_query_if_file_exists (newname, "copy to it",
103260165Shibler 				  XTYPE (ok_if_already_exists) == Lisp_Int);
103360165Shibler 
103460165Shibler   ifd = open (XSTRING (filename)->data, 0);
103560165Shibler   if (ifd < 0)
103660165Shibler     report_file_error ("Opening input file", Fcons (filename, Qnil));
103760165Shibler 
103860165Shibler #ifdef VMS
103960165Shibler   /* Create the copy file with the same record format as the input file */
104060165Shibler   ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
104160165Shibler #else
104260165Shibler   ofd = creat (XSTRING (newname)->data, 0666);
104360165Shibler #endif /* VMS */
104460165Shibler   if (ofd < 0)
104560165Shibler     {
104660165Shibler       close (ifd);
104760165Shibler       report_file_error ("Opening output file", Fcons (newname, Qnil));
104860165Shibler     }
104960165Shibler 
105060165Shibler   while ((n = read (ifd, buf, sizeof buf)) > 0)
105160165Shibler     if (write (ofd, buf, n) != n)
105260165Shibler       {
105360165Shibler 	close (ifd);
105460165Shibler 	close (ofd);
105560165Shibler 	report_file_error ("I/O error", Fcons (newname, Qnil));
105660165Shibler       }
105760165Shibler 
105860165Shibler   if (fstat (ifd, &st) >= 0)
105960165Shibler     {
106060165Shibler #ifdef HAVE_TIMEVAL
106160165Shibler       if (!NULL (keep_date))
106260165Shibler 	{
106360165Shibler #ifdef USE_UTIME
106460165Shibler /* AIX has utimes() in compatibility package, but it dies.  So use good old
106560165Shibler    utime interface instead. */
106660165Shibler 	  struct {
106760165Shibler 	    time_t atime;
106860165Shibler 	    time_t mtime;
106960165Shibler 	  } tv;
107060165Shibler 	  tv.atime = st.st_atime;
107160165Shibler 	  tv.mtime = st.st_mtime;
107260165Shibler 	  utime (XSTRING (newname)->data, &tv);
107360165Shibler #else /* not USE_UTIME */
107460165Shibler 	  struct timeval timevals[2];
107560165Shibler 	  timevals[0].tv_sec = st.st_atime;
107660165Shibler 	  timevals[1].tv_sec = st.st_mtime;
107760165Shibler 	  timevals[0].tv_usec = timevals[1].tv_usec = 0;
107860165Shibler 	  utimes (XSTRING (newname)->data, timevals);
107960165Shibler #endif /* not USE_UTIME */
108060165Shibler 	}
108160165Shibler #endif /* HAVE_TIMEVALS */
108260165Shibler 
108360165Shibler #ifdef APOLLO
108460165Shibler       if (!egetenv ("USE_DOMAIN_ACLS"))
108560165Shibler #endif
108660165Shibler       chmod (XSTRING (newname)->data, st.st_mode & 07777);
108760165Shibler     }
108860165Shibler 
108960165Shibler   close (ifd);
109060165Shibler   if (close (ofd) < 0)
109160165Shibler     report_file_error ("I/O error", Fcons (newname, Qnil));
109260165Shibler 
109360165Shibler   UNGCPRO;
109460165Shibler   return Qnil;
109560165Shibler }
109660165Shibler 
109760165Shibler DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
109860165Shibler   "Delete specified file.  One argument, a file name string.\n\
109960165Shibler If file has multiple names, it continues to exist with the other names.")
110060165Shibler   (filename)
110160165Shibler      Lisp_Object filename;
110260165Shibler {
110360165Shibler   CHECK_STRING (filename, 0);
110460165Shibler   filename = Fexpand_file_name (filename, Qnil);
110560165Shibler   if (0 > unlink (XSTRING (filename)->data))
110660165Shibler     report_file_error ("Removing old name", Flist (1, &filename));
110760165Shibler   return Qnil;
110860165Shibler }
110960165Shibler 
111060165Shibler DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
111160165Shibler   "fRename file: \nFRename %s to file: \np",
111260165Shibler   "Rename FILE as NEWNAME.  Both args strings.\n\
111360165Shibler If file has names other than FILE, it continues to have those names.\n\
111460165Shibler Signals a  file-already-exists  error if NEWNAME already exists\n\
111560165Shibler unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
111660165Shibler A number as third arg means request confirmation if NEWNAME already exists.\n\
111760165Shibler This is what happens in interactive use with M-x.")
111860165Shibler   (filename, newname, ok_if_already_exists)
111960165Shibler      Lisp_Object filename, newname, ok_if_already_exists;
112060165Shibler {
112160165Shibler #ifdef NO_ARG_ARRAY
112260165Shibler   Lisp_Object args[2];
112360165Shibler #endif
112460165Shibler   struct gcpro gcpro1, gcpro2;
112560165Shibler 
112660165Shibler   GCPRO2 (filename, newname);
112760165Shibler   CHECK_STRING (filename, 0);
112860165Shibler   CHECK_STRING (newname, 1);
112960165Shibler   filename = Fexpand_file_name (filename, Qnil);
113060165Shibler   newname = Fexpand_file_name (newname, Qnil);
113160165Shibler   if (NULL (ok_if_already_exists)
113260165Shibler       || XTYPE (ok_if_already_exists) == Lisp_Int)
113360165Shibler     barf_or_query_if_file_exists (newname, "rename to it",
113460165Shibler 				  XTYPE (ok_if_already_exists) == Lisp_Int);
113560165Shibler #ifndef BSD4_1
113660165Shibler   if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
113760165Shibler #else
113860165Shibler   if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
113960165Shibler       || 0 > unlink (XSTRING (filename)->data))
114060165Shibler #endif
114160165Shibler     {
114260165Shibler       if (errno == EXDEV)
114360165Shibler 	{
114460165Shibler 	  Fcopy_file (filename, newname, ok_if_already_exists, Qt);
114560165Shibler 	  Fdelete_file (filename);
114660165Shibler 	}
114760165Shibler       else
114860165Shibler #ifdef NO_ARG_ARRAY
114960165Shibler 	{
115060165Shibler 	  args[0] = filename;
115160165Shibler 	  args[1] = newname;
115260165Shibler 	  report_file_error ("Renaming", Flist (2, args));
115360165Shibler 	}
115460165Shibler #else
115560165Shibler 	report_file_error ("Renaming", Flist (2, &filename));
115660165Shibler #endif
115760165Shibler     }
115860165Shibler   UNGCPRO;
115960165Shibler   return Qnil;
116060165Shibler }
116160165Shibler 
116260165Shibler DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
116360165Shibler   "fAdd name to file: \nFName to add to %s: \np",
116460165Shibler   "Give FILE additional name NEWNAME.  Both args strings.\n\
116560165Shibler Signals a  file-already-exists  error if NEWNAME already exists\n\
116660165Shibler unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
116760165Shibler A number as third arg means request confirmation if NEWNAME already exists.\n\
116860165Shibler This is what happens in interactive use with M-x.")
116960165Shibler   (filename, newname, ok_if_already_exists)
117060165Shibler      Lisp_Object filename, newname, ok_if_already_exists;
117160165Shibler {
117260165Shibler #ifdef NO_ARG_ARRAY
117360165Shibler   Lisp_Object args[2];
117460165Shibler #endif
117560165Shibler   struct gcpro gcpro1, gcpro2;
117660165Shibler 
117760165Shibler   GCPRO2 (filename, newname);
117860165Shibler   CHECK_STRING (filename, 0);
117960165Shibler   CHECK_STRING (newname, 1);
118060165Shibler   filename = Fexpand_file_name (filename, Qnil);
118160165Shibler   newname = Fexpand_file_name (newname, Qnil);
118260165Shibler   if (NULL (ok_if_already_exists)
118360165Shibler       || XTYPE (ok_if_already_exists) == Lisp_Int)
118460165Shibler     barf_or_query_if_file_exists (newname, "make it a new name",
118560165Shibler 				  XTYPE (ok_if_already_exists) == Lisp_Int);
118660165Shibler   unlink (XSTRING (newname)->data);
118760165Shibler   if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
118860165Shibler     {
118960165Shibler #ifdef NO_ARG_ARRAY
119060165Shibler       args[0] = filename;
119160165Shibler       args[1] = newname;
119260165Shibler       report_file_error ("Adding new name", Flist (2, args));
119360165Shibler #else
119460165Shibler       report_file_error ("Adding new name", Flist (2, &filename));
119560165Shibler #endif
119660165Shibler     }
119760165Shibler 
119860165Shibler   UNGCPRO;
119960165Shibler   return Qnil;
120060165Shibler }
120160165Shibler 
120260165Shibler #ifdef S_IFLNK
120360165Shibler DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
120460165Shibler   "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
120560165Shibler   "Make a symbolic link to FILENAME, named LINKNAME.  Both args strings.\n\
120660165Shibler Signals a  file-already-exists  error if NEWNAME already exists\n\
120760165Shibler unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
120860165Shibler A number as third arg means request confirmation if NEWNAME already exists.\n\
120960165Shibler This happens for interactive use with M-x.")
121060165Shibler   (filename, newname, ok_if_already_exists)
121160165Shibler      Lisp_Object filename, newname, ok_if_already_exists;
121260165Shibler {
121360165Shibler #ifdef NO_ARG_ARRAY
121460165Shibler   Lisp_Object args[2];
121560165Shibler #endif
121660165Shibler   struct gcpro gcpro1, gcpro2;
121760165Shibler 
121860165Shibler   GCPRO2 (filename, newname);
121960165Shibler   CHECK_STRING (filename, 0);
122060165Shibler   CHECK_STRING (newname, 1);
122160165Shibler   filename = Fexpand_file_name (filename, Qnil);
122260165Shibler   newname = Fexpand_file_name (newname, Qnil);
122360165Shibler   if (NULL (ok_if_already_exists)
122460165Shibler       || XTYPE (ok_if_already_exists) == Lisp_Int)
122560165Shibler     barf_or_query_if_file_exists (newname, "make it a link",
122660165Shibler 				  XTYPE (ok_if_already_exists) == Lisp_Int);
122760165Shibler   if (0 > symlink (XSTRING (filename)->data, XSTRING (newname)->data))
122860165Shibler     {
122960165Shibler #ifdef NO_ARG_ARRAY
123060165Shibler       args[0] = filename;
123160165Shibler       args[1] = newname;
123260165Shibler       report_file_error ("Making symbolic link", Flist (2, args));
123360165Shibler #else
123460165Shibler       report_file_error ("Making symbolic link", Flist (2, &filename));
123560165Shibler #endif
123660165Shibler     }
123760165Shibler   UNGCPRO;
123860165Shibler   return Qnil;
123960165Shibler }
124060165Shibler #endif /* S_IFLNK */
124160165Shibler 
124260165Shibler #ifdef VMS
124360165Shibler 
124460165Shibler DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
124560165Shibler        2, 2,
124660165Shibler        "sDefine logical name: \nsDefine logical name %s as: ",
124760165Shibler        "Define the job-wide logical name NAME to have the value STRING.\n\
124860165Shibler If STRING is nil or a null string, the logical name NAME is deleted.")
124960165Shibler   (varname, string)
125060165Shibler      Lisp_Object varname;
125160165Shibler      Lisp_Object string;
125260165Shibler {
125360165Shibler   CHECK_STRING (varname, 0);
125460165Shibler   if (NULL (string))
125560165Shibler     delete_logical_name (XSTRING (varname)->data);
125660165Shibler   else
125760165Shibler     {
125860165Shibler       CHECK_STRING (string, 1);
125960165Shibler 
126060165Shibler       if (XSTRING (string)->size == 0)
126160165Shibler         delete_logical_name (XSTRING (varname)->data);
126260165Shibler       else
126360165Shibler         define_logical_name (XSTRING (varname)->data, XSTRING (string)->data);
126460165Shibler     }
126560165Shibler 
126660165Shibler   return string;
126760165Shibler }
126860165Shibler #endif /* VMS */
126960165Shibler 
127060165Shibler #ifdef HPUX_NET
127160165Shibler 
127260165Shibler DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
127360165Shibler        "Open a network connection to PATH using LOGIN as the login string.")
127460165Shibler      (path, login)
127560165Shibler      Lisp_Object path, login;
127660165Shibler {
127760165Shibler   int netresult;
127860165Shibler 
127960165Shibler   CHECK_STRING (path, 0);
128060165Shibler   CHECK_STRING (login, 0);
128160165Shibler 
128260165Shibler   netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
128360165Shibler 
128460165Shibler   if (netresult == -1)
128560165Shibler     return Qnil;
128660165Shibler   else
128760165Shibler     return Qt;
128860165Shibler }
128960165Shibler #endif /* HPUX_NET */
129060165Shibler 
129160165Shibler DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
129260165Shibler        1, 1, 0,
129360165Shibler        "Return t if file FILENAME specifies an absolute path name.")
129460165Shibler      (filename)
129560165Shibler      Lisp_Object filename;
129660165Shibler {
129760165Shibler   unsigned char *ptr;
129860165Shibler 
129960165Shibler   CHECK_STRING (filename, 0);
130060165Shibler   ptr = XSTRING (filename)->data;
130160165Shibler   if (*ptr == '/' || *ptr == '~'
130260165Shibler #ifdef VMS
130360165Shibler /* ??? This criterion is probably wrong for '<'.  */
130460165Shibler       || index (ptr, ':') || index (ptr, '<')
130560165Shibler       || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
130660165Shibler 	  && ptr[1] != '.')
130760165Shibler #endif /* VMS */
130860165Shibler       )
130960165Shibler     return Qt;
131060165Shibler   else
131160165Shibler     return Qnil;
131260165Shibler }
131360165Shibler 
131460165Shibler DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
131560165Shibler   "Return t if file FILENAME exists.  (This does not mean you can read it.)\n\
131660165Shibler See also file-readable-p and file-attributes.")
131760165Shibler   (filename)
131860165Shibler      Lisp_Object filename;
131960165Shibler {
132060165Shibler   Lisp_Object abspath;
132160165Shibler 
132260165Shibler   CHECK_STRING (filename, 0);
132360165Shibler   abspath = Fexpand_file_name (filename, Qnil);
132460165Shibler   return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
132560165Shibler }
132660165Shibler 
132760165Shibler DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
132860165Shibler   "Return t if file FILENAME exists and you can read it.\n\
132960165Shibler See also file-exists-p and file-attributes.")
133060165Shibler   (filename)
133160165Shibler      Lisp_Object filename;
133260165Shibler {
133360165Shibler   Lisp_Object abspath;
133460165Shibler 
133560165Shibler   CHECK_STRING (filename, 0);
133660165Shibler   abspath = Fexpand_file_name (filename, Qnil);
133760165Shibler   return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
133860165Shibler }
133960165Shibler 
134060165Shibler DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
134160165Shibler   "If file FILENAME is the name of a symbolic link\n\
134260165Shibler returns the name of the file to which it is linked.\n\
134360165Shibler Otherwise returns NIL.")
134460165Shibler   (filename)
134560165Shibler      Lisp_Object filename;
134660165Shibler {
134760165Shibler #ifdef S_IFLNK
134860165Shibler   char *buf;
134960165Shibler   int bufsize;
135060165Shibler   int valsize;
135160165Shibler   Lisp_Object val;
135260165Shibler 
135360165Shibler   CHECK_STRING (filename, 0);
135460165Shibler   filename = Fexpand_file_name (filename, Qnil);
135560165Shibler 
135660165Shibler   bufsize = 100;
135760165Shibler   while (1)
135860165Shibler     {
135960165Shibler       buf = (char *) xmalloc (bufsize);
136060165Shibler       bzero (buf, bufsize);
136160165Shibler       valsize = readlink (XSTRING (filename)->data, buf, bufsize);
136260165Shibler       if (valsize < bufsize) break;
136360165Shibler       /* Buffer was not long enough */
136460165Shibler       free (buf);
136560165Shibler       bufsize *= 2;
136660165Shibler     }
136760165Shibler   if (valsize == -1)
136860165Shibler     {
136960165Shibler       free (buf);
137060165Shibler       return Qnil;
137160165Shibler     }
137260165Shibler   val = make_string (buf, valsize);
137360165Shibler   free (buf);
137460165Shibler   return val;
137560165Shibler #else /* not S_IFLNK */
137660165Shibler   return Qnil;
137760165Shibler #endif /* not S_IFLNK */
137860165Shibler }
137960165Shibler 
138060165Shibler /* Having this before file-symlink-p mysteriously caused it to be forgotten
138160165Shibler    on the RT/PC.  */
138260165Shibler DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
138360165Shibler   "Return t if file FILENAME can be written or created by you.")
138460165Shibler   (filename)
138560165Shibler      Lisp_Object filename;
138660165Shibler {
138760165Shibler   Lisp_Object abspath, dir;
138860165Shibler 
138960165Shibler   CHECK_STRING (filename, 0);
139060165Shibler   abspath = Fexpand_file_name (filename, Qnil);
139160165Shibler   if (access (XSTRING (abspath)->data, 0) >= 0)
139260165Shibler     return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
139360165Shibler   dir = Ffile_name_directory (abspath);
139460165Shibler #ifdef VMS
139560165Shibler   if (!NULL (dir))
139660165Shibler     dir = Fdirectory_file_name (dir);
139760165Shibler #endif /* VMS */
139860165Shibler   return (access (!NULL (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
139960165Shibler 	  ? Qt : Qnil);
140060165Shibler }
140160165Shibler 
140260165Shibler DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
140360165Shibler   "Return t if file FILENAME is the name of a directory as a file.\n\
140460165Shibler A directory name spec may be given instead; then the value is t\n\
140560165Shibler if the directory so specified exists and really is a directory.")
140660165Shibler   (filename)
140760165Shibler      Lisp_Object filename;
140860165Shibler {
140960165Shibler   register Lisp_Object abspath;
141060165Shibler   struct stat st;
141160165Shibler 
141260165Shibler   abspath = expand_and_dir_to_file (filename, current_buffer->directory);
141360165Shibler 
141460165Shibler   if (stat (XSTRING (abspath)->data, &st) < 0)
141560165Shibler     return Qnil;
141660165Shibler   return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
141760165Shibler }
141860165Shibler 
141960165Shibler DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
142060165Shibler   "Return mode bits of FILE, as an integer.")
142160165Shibler   (filename)
142260165Shibler      Lisp_Object filename;
142360165Shibler {
142460165Shibler   Lisp_Object abspath;
142560165Shibler   struct stat st;
142660165Shibler 
142760165Shibler   abspath = expand_and_dir_to_file (filename, current_buffer->directory);
142860165Shibler 
142960165Shibler   if (stat (XSTRING (abspath)->data, &st) < 0)
143060165Shibler     return Qnil;
143160165Shibler   return make_number (st.st_mode & 07777);
143260165Shibler }
143360165Shibler 
143460165Shibler DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
143560165Shibler   "Set mode bits of FILE to MODE (an integer).\n\
143660165Shibler Only the 12 low bits of MODE are used.")
143760165Shibler   (filename, mode)
143860165Shibler      Lisp_Object filename, mode;
143960165Shibler {
144060165Shibler   Lisp_Object abspath;
144160165Shibler 
144260165Shibler   abspath = Fexpand_file_name (filename, current_buffer->directory);
144360165Shibler   CHECK_NUMBER (mode, 1);
144460165Shibler 
144560165Shibler #ifndef APOLLO
144660165Shibler   if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
144760165Shibler     report_file_error ("Doing chmod", Fcons (abspath, Qnil));
144860165Shibler #else /* APOLLO */
144960165Shibler   if (!egetenv ("USE_DOMAIN_ACLS"))
145060165Shibler     {
145160165Shibler       struct stat st;
145260165Shibler       struct timeval tvp[2];
145360165Shibler 
145460165Shibler       /* chmod on apollo also change the file's modtime; need to save the
145560165Shibler 	 modtime and then restore it. */
145660165Shibler       if (stat (XSTRING (abspath)->data, &st) < 0)
145760165Shibler 	{
145860165Shibler 	  report_file_error ("Doing chmod", Fcons (abspath, Qnil));
145960165Shibler 	  return (Qnil);
146060165Shibler 	}
146160165Shibler 
146260165Shibler       if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
146360165Shibler  	report_file_error ("Doing chmod", Fcons (abspath, Qnil));
146460165Shibler 
146560165Shibler       /* reset the old accessed and modified times.  */
146660165Shibler       tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
146760165Shibler       tvp[0].tv_usec = 0;
146860165Shibler       tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
146960165Shibler       tvp[1].tv_usec = 0;
147060165Shibler 
147160165Shibler       if (utimes (XSTRING (abspath)->data, tvp) < 0)
147260165Shibler  	report_file_error ("Doing utimes", Fcons (abspath, Qnil));
147360165Shibler     }
147460165Shibler #endif /* APOLLO */
147560165Shibler 
147660165Shibler   return Qnil;
147760165Shibler }
147860165Shibler 
147960165Shibler DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
148060165Shibler   "Return t if file FILE1 is newer than file FILE2.\n\
148160165Shibler If FILE1 does not exist, the answer is nil;\n\
148260165Shibler otherwise, if FILE2 does not exist, the answer is t.")
148360165Shibler   (file1, file2)
148460165Shibler      Lisp_Object file1, file2;
148560165Shibler {
148660165Shibler   Lisp_Object abspath;
148760165Shibler   struct stat st;
148860165Shibler   int mtime1;
148960165Shibler 
149060165Shibler   CHECK_STRING (file1, 0);
149160165Shibler   CHECK_STRING (file2, 0);
149260165Shibler 
149360165Shibler   abspath = expand_and_dir_to_file (file1, current_buffer->directory);
149460165Shibler 
149560165Shibler   if (stat (XSTRING (abspath)->data, &st) < 0)
149660165Shibler     return Qnil;
149760165Shibler 
149860165Shibler   mtime1 = st.st_mtime;
149960165Shibler 
150060165Shibler   abspath = expand_and_dir_to_file (file2, current_buffer->directory);
150160165Shibler 
150260165Shibler   if (stat (XSTRING (abspath)->data, &st) < 0)
150360165Shibler     return Qt;
150460165Shibler 
150560165Shibler   return (mtime1 > st.st_mtime) ? Qt : Qnil;
150660165Shibler }
150760165Shibler 
close_file_unwind(fd)150860165Shibler close_file_unwind (fd)
150960165Shibler      Lisp_Object fd;
151060165Shibler {
151160165Shibler   close (XFASTINT (fd));
151260165Shibler }
151360165Shibler 
151460165Shibler DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
151560165Shibler   1, 2, 0,
151660165Shibler   "Insert contents of file FILENAME after point.\n\
151760165Shibler Returns list of absolute pathname and length of data inserted.\n\
151860165Shibler If second argument VISIT is non-nil, the buffer's visited filename\n\
151960165Shibler and last save file modtime are set, and it is marked unmodified.\n\
152060165Shibler If visiting and the file does not exist, visiting is completed\n\
152160165Shibler before the error is signaled.")
152260165Shibler   (filename, visit)
152360165Shibler      Lisp_Object filename, visit;
152460165Shibler {
152560165Shibler   struct stat st;
152660165Shibler   register int fd;
152760165Shibler   register int inserted = 0;
152860165Shibler   register int i = 0;
152960165Shibler   int count = specpdl_ptr - specpdl;
153060165Shibler   struct gcpro gcpro1;
153160165Shibler 
153260165Shibler   GCPRO1 (filename);
153360165Shibler   if (!NULL (current_buffer->read_only))
153460165Shibler     Fbarf_if_buffer_read_only();
153560165Shibler 
153660165Shibler   CHECK_STRING (filename, 0);
153760165Shibler   filename = Fexpand_file_name (filename, Qnil);
153860165Shibler 
153960165Shibler   fd = -1;
154060165Shibler 
154160165Shibler #ifndef APOLLO
154260165Shibler   if (stat (XSTRING (filename)->data, &st) < 0
154360165Shibler 	|| (fd = open (XSTRING (filename)->data, 0)) < 0)
154460165Shibler #else
154560165Shibler   if ((fd = open (XSTRING (filename)->data, 0)) < 0
154660165Shibler       || fstat (fd, &st) < 0)
154760165Shibler #endif /* not APOLLO */
154860165Shibler     {
154960165Shibler       if (fd >= 0) close (fd);
155060165Shibler       if (NULL (visit))
155160165Shibler 	report_file_error ("Opening input file", Fcons (filename, Qnil));
155260165Shibler       st.st_mtime = -1;
155360165Shibler       goto notfound;
155460165Shibler     }
155560165Shibler 
155660165Shibler   record_unwind_protect (close_file_unwind, make_number (fd));
155760165Shibler 
155860165Shibler   /* Supposedly happens on VMS.  */
155960165Shibler   if (st.st_size < 0)
156060165Shibler     error ("File size is negative");
156160165Shibler   {
156260165Shibler     register Lisp_Object temp;
156360165Shibler 
156460165Shibler     /* Make sure point-max won't overflow after this insertion.  */
156560165Shibler     XSET (temp, Lisp_Int, st.st_size + Z);
156660165Shibler     if (st.st_size + Z != XINT (temp))
156760165Shibler       error ("maximum buffer size exceeded");
156860165Shibler   }
156960165Shibler 
157060165Shibler   if (NULL (visit))
157160165Shibler     prepare_to_modify_buffer ();
157260165Shibler 
157360165Shibler   move_gap (point);
157460165Shibler   if (GAP_SIZE < st.st_size)
1575*60297Shibler     make_gap ((int)st.st_size - GAP_SIZE);
157660165Shibler 
157760165Shibler   while (1)
157860165Shibler     {
157960165Shibler       int try = min (st.st_size - inserted, 64 << 10);
158060165Shibler       int this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
158160165Shibler 
158260165Shibler       if (this <= 0)
158360165Shibler 	{
158460165Shibler 	  i = this;
158560165Shibler 	  break;
158660165Shibler 	}
158760165Shibler 
158860165Shibler       GPT += this;
158960165Shibler       GAP_SIZE -= this;
159060165Shibler       ZV += this;
159160165Shibler       Z += this;
159260165Shibler       inserted += this;
159360165Shibler     }
159460165Shibler 
159560165Shibler   if (inserted > 0)
159660165Shibler     MODIFF++;
159760165Shibler   record_insert (point, inserted);
159860165Shibler 
159960165Shibler   close (fd);
160060165Shibler 
160160165Shibler   /* Discard the unwind protect */
160260165Shibler   specpdl_ptr = specpdl + count;
160360165Shibler 
160460165Shibler   if (i < 0)
160560165Shibler     error ("IO error reading %s: %s",
160660165Shibler 	   XSTRING (filename)->data, err_str (errno));
160760165Shibler 
160860165Shibler  notfound:
160960165Shibler 
161060165Shibler   if (!NULL (visit))
161160165Shibler     {
161260165Shibler       current_buffer->undo_list = Qnil;
161360165Shibler #ifdef APOLLO
161460165Shibler       stat (XSTRING (filename)->data, &st);
161560165Shibler #endif
161660165Shibler       current_buffer->modtime = st.st_mtime;
161760165Shibler       current_buffer->save_modified = MODIFF;
161860165Shibler       current_buffer->auto_save_modified = MODIFF;
161960165Shibler       XFASTINT (current_buffer->save_length) = Z - BEG;
162060165Shibler #ifdef CLASH_DETECTION
162160165Shibler       if (!NULL (current_buffer->filename))
162260165Shibler 	unlock_file (current_buffer->filename);
162360165Shibler       unlock_file (filename);
162460165Shibler #endif /* CLASH_DETECTION */
162560165Shibler       current_buffer->filename = filename;
162660165Shibler       /* If visiting nonexistent file, return nil.  */
162760165Shibler       if (st.st_mtime == -1)
162860165Shibler 	report_file_error ("Opening input file", Fcons (filename, Qnil));
162960165Shibler     }
163060165Shibler 
163160165Shibler   UNGCPRO;
163260165Shibler   return Fcons (filename, Fcons (make_number (inserted), Qnil));
163360165Shibler }
163460165Shibler 
163560165Shibler DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
163660165Shibler   "r\nFWrite region to file: ",
163760165Shibler   "Write current region into specified file.\n\
163860165Shibler When called from a program, takes three arguments:\n\
163960165Shibler START, END and FILENAME.  START and END are buffer positions.\n\
164060165Shibler Optional fourth argument APPEND if non-nil means\n\
164160165Shibler   append to existing file contents (if any).\n\
164260165Shibler Optional fifth argument VISIT if t means\n\
164360165Shibler   set last-save-file-modtime of buffer to this file's modtime\n\
164460165Shibler   and mark buffer not modified.\n\
164560165Shibler If VISIT is neither t nor nil, it means do not print\n\
164660165Shibler   the \"Wrote file\" message.")
164760165Shibler   (start, end, filename, append, visit)
164860165Shibler      Lisp_Object start, end, filename, append, visit;
164960165Shibler {
165060165Shibler   register int desc;
165160165Shibler   int failure;
165260165Shibler   int save_errno;
165360165Shibler   unsigned char *fn;
165460165Shibler   struct stat st;
165560165Shibler   int tem;
165660165Shibler   int count = specpdl_ptr - specpdl;
165760165Shibler #ifdef VMS
165860165Shibler   unsigned char *fname = 0;	/* If non-0, original filename (must rename) */
165960165Shibler #endif /* VMS */
166060165Shibler 
166160165Shibler   /* Special kludge to simplify auto-saving */
166260165Shibler   if (NULL (start))
166360165Shibler     {
166460165Shibler       XFASTINT (start) = BEG;
166560165Shibler       XFASTINT (end) = Z;
166660165Shibler     }
166760165Shibler   else
166860165Shibler     validate_region (&start, &end);
166960165Shibler 
167060165Shibler   filename = Fexpand_file_name (filename, Qnil);
167160165Shibler   fn = XSTRING (filename)->data;
167260165Shibler 
167360165Shibler #ifdef CLASH_DETECTION
167460165Shibler   if (!auto_saving)
167560165Shibler     lock_file (filename);
167660165Shibler #endif /* CLASH_DETECTION */
167760165Shibler 
167860165Shibler   desc = -1;
167960165Shibler   if (!NULL (append))
168060165Shibler     desc = open (fn, O_WRONLY);
168160165Shibler 
168260165Shibler   if (desc < 0)
168360165Shibler #ifdef VMS
168460165Shibler     if (auto_saving)	/* Overwrite any previous version of autosave file */
168560165Shibler       {
168660165Shibler 	vms_truncate (fn);	/* if fn exists, truncate to zero length */
168760165Shibler 	desc = open (fn, O_RDWR);
168860165Shibler 	if (desc < 0)
168960165Shibler 	  desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String
169060165Shibler 				   ? XSTRING (current_buffer->filename)->data : 0,
169160165Shibler 				   fn);
169260165Shibler       }
169360165Shibler     else		/* Write to temporary name and rename if no errors */
169460165Shibler       {
169560165Shibler 	Lisp_Object temp_name;
169660165Shibler 	temp_name = Ffile_name_directory (filename);
169760165Shibler 
169860165Shibler 	if (!NULL (temp_name))
169960165Shibler 	  {
170060165Shibler 	    temp_name = Fmake_temp_name (concat2 (temp_name,
170160165Shibler 						  build_string ("$$SAVE$$")));
170260165Shibler 	    fname = XSTRING (filename)->data;
170360165Shibler 	    fn = XSTRING (temp_name)->data;
170460165Shibler 	    desc = creat_copy_attrs (fname, fn);
170560165Shibler 	    if (desc < 0)
170660165Shibler 	      {
170760165Shibler 		/* If we can't open the temporary file, try creating a new
170860165Shibler 		   version of the original file.  VMS "creat" creates a
170960165Shibler 		   new version rather than truncating an existing file. */
171060165Shibler 		fn = fname;
171160165Shibler 		fname = 0;
171260165Shibler 		desc = creat (fn, 0666);
171360165Shibler 		if (desc < 0)
171460165Shibler 		  {
171560165Shibler 		    /* We can't make a new version;
171660165Shibler 		       try to truncate and rewrite existing version if any.  */
171760165Shibler 		    vms_truncate (fn);
171860165Shibler 		    desc = open (fn, O_RDWR);
171960165Shibler 		  }
172060165Shibler 	      }
172160165Shibler 	  }
172260165Shibler 	else
172360165Shibler 	  desc = creat (fn, 0666);
172460165Shibler       }
172560165Shibler #else /* not VMS */
172660165Shibler   desc = creat (fn, 0666);
172760165Shibler #endif /* not VMS */
172860165Shibler 
172960165Shibler   if (desc < 0)
173060165Shibler     {
173160165Shibler #ifdef CLASH_DETECTION
173260165Shibler       save_errno = errno;
173360165Shibler       if (!auto_saving) unlock_file (filename);
173460165Shibler       errno = save_errno;
173560165Shibler #endif /* CLASH_DETECTION */
173660165Shibler       report_file_error ("Opening output file", Fcons (filename, Qnil));
173760165Shibler     }
173860165Shibler 
173960165Shibler   record_unwind_protect (close_file_unwind, make_number (desc));
174060165Shibler 
174160165Shibler   if (!NULL (append))
1742*60297Shibler     if (lseek (desc, (off_t) 0, 2) < 0)
174360165Shibler       {
174460165Shibler #ifdef CLASH_DETECTION
174560165Shibler 	if (!auto_saving) unlock_file (filename);
174660165Shibler #endif /* CLASH_DETECTION */
174760165Shibler 	report_file_error ("Lseek error", Fcons (filename, Qnil));
174860165Shibler       }
174960165Shibler 
175060165Shibler #ifdef VMS
175160165Shibler /*
175260165Shibler  * Kludge Warning: The VMS C RTL likes to insert carriage returns
175360165Shibler  * if we do writes that don't end with a carriage return. Furthermore
175460165Shibler  * it cannot handle writes of more then 16K. The modified
175560165Shibler  * version of "sys_write" in SYSDEP.C (see comment there) copes with
175660165Shibler  * this EXCEPT for the last record (iff it doesn't end with a carriage
175760165Shibler  * return). This implies that if your buffer doesn't end with a carriage
175860165Shibler  * return, you get one free... tough. However it also means that if
175960165Shibler  * we make two calls to sys_write (a la the following code) you can
176060165Shibler  * get one at the gap as well. The easiest way to fix this (honest)
176160165Shibler  * is to move the gap to the next newline (or the end of the buffer).
176260165Shibler  * Thus this change.
176360165Shibler  *
176460165Shibler  * Yech!
176560165Shibler  */
176660165Shibler   if (GPT > BEG && GPT_ADDR[-1] != '\n')
176760165Shibler     move_gap (find_next_newline (GPT, 1));
176860165Shibler #endif
176960165Shibler 
177060165Shibler   failure = 0;
177160165Shibler   if (XINT (start) != XINT (end))
177260165Shibler     {
177360165Shibler       if (XINT (start) < GPT)
177460165Shibler 	{
177560165Shibler 	  register int end1 = XINT (end);
177660165Shibler 	  tem = XINT (start);
177760165Shibler 	  failure = 0 > e_write (desc, &FETCH_CHAR (tem),
177860165Shibler 				 min (GPT, end1) - tem);
177960165Shibler 	  save_errno = errno;
178060165Shibler 	}
178160165Shibler 
178260165Shibler       if (XINT (end) > GPT && !failure)
178360165Shibler 	{
178460165Shibler 	  tem = XINT (start);
178560165Shibler 	  tem = max (tem, GPT);
178660165Shibler 	  failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem);
178760165Shibler 	  save_errno = errno;
178860165Shibler 	}
178960165Shibler     }
179060165Shibler 
179160165Shibler #ifndef USG
179260165Shibler #ifndef VMS
179360165Shibler #ifndef BSD4_1
179460165Shibler #ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY
179560165Shibler 		   on alliant, for no visible reason.  */
179660165Shibler   /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
179760165Shibler      Disk full in NFS may be reported here.  */
179860165Shibler   if (fsync (desc) < 0)
179960165Shibler     failure = 1, save_errno = errno;
180060165Shibler #endif
180160165Shibler #endif
180260165Shibler #endif
180360165Shibler #endif
180460165Shibler 
180560165Shibler #if 0
180660165Shibler   /* Spurious "file has changed on disk" warnings have been
180760165Shibler      observed on Sun 3 as well.  Maybe close changes the modtime
180860165Shibler      with nfs as well.  */
180960165Shibler 
181060165Shibler   /* On VMS and APOLLO, must do the stat after the close
181160165Shibler      since closing changes the modtime.  */
181260165Shibler #ifndef VMS
181360165Shibler #ifndef APOLLO
181460165Shibler   /* Recall that #if defined does not work on VMS.  */
181560165Shibler #define FOO
181660165Shibler   fstat (desc, &st);
181760165Shibler #endif
181860165Shibler #endif
181960165Shibler #endif /* 0 */
182060165Shibler 
182160165Shibler   /* NFS can report a write failure now.  */
182260165Shibler   if (close (desc) < 0)
182360165Shibler     failure = 1, save_errno = errno;
182460165Shibler 
182560165Shibler #ifdef VMS
182660165Shibler   /* If we wrote to a temporary name and had no errors, rename to real name. */
182760165Shibler   if (fname)
182860165Shibler     {
182960165Shibler       if (!failure)
183060165Shibler 	failure = (rename (fn, fname) != 0), save_errno = errno;
183160165Shibler       fn = fname;
183260165Shibler     }
183360165Shibler #endif /* VMS */
183460165Shibler 
183560165Shibler #ifndef FOO
183660165Shibler   stat (fn, &st);
183760165Shibler #endif
183860165Shibler   /* Discard the unwind protect */
183960165Shibler   specpdl_ptr = specpdl + count;
184060165Shibler 
184160165Shibler #ifdef CLASH_DETECTION
184260165Shibler   if (!auto_saving)
184360165Shibler     unlock_file (filename);
184460165Shibler #endif /* CLASH_DETECTION */
184560165Shibler 
184660165Shibler   /* Do this before reporting IO error
184760165Shibler      to avoid a "file has changed on disk" warning on
184860165Shibler      next attempt to save.  */
184960165Shibler   if (EQ (visit, Qt))
185060165Shibler     current_buffer->modtime = st.st_mtime;
185160165Shibler 
185260165Shibler   if (failure)
185360165Shibler     error ("IO error writing %s: %s", fn, err_str (save_errno));
185460165Shibler 
185560165Shibler   if (EQ (visit, Qt))
185660165Shibler     {
185760165Shibler       current_buffer->save_modified = MODIFF;
185860165Shibler       XFASTINT (current_buffer->save_length) = Z - BEG;
185960165Shibler       current_buffer->filename = filename;
186060165Shibler     }
186160165Shibler   else if (!NULL (visit))
186260165Shibler     return Qnil;
186360165Shibler 
186460165Shibler   if (!auto_saving)
186560165Shibler     message ("Wrote %s", fn);
186660165Shibler 
186760165Shibler   return Qnil;
186860165Shibler }
186960165Shibler 
187060165Shibler int
e_write(desc,addr,len)187160165Shibler e_write (desc, addr, len)
187260165Shibler      int desc;
187360165Shibler      register char *addr;
187460165Shibler      register int len;
187560165Shibler {
187660165Shibler   char buf[16 * 1024];
187760165Shibler   register char *p, *end;
187860165Shibler 
187960165Shibler   if (!EQ (current_buffer->selective_display, Qt))
188060165Shibler     return write (desc, addr, len) - len;
188160165Shibler   else
188260165Shibler     {
188360165Shibler       p = buf;
188460165Shibler       end = p + sizeof buf;
188560165Shibler       while (len--)
188660165Shibler 	{
188760165Shibler 	  if (p == end)
188860165Shibler 	    {
188960165Shibler 	      if (write (desc, buf, sizeof buf) != sizeof buf)
189060165Shibler 		return -1;
189160165Shibler 	      p = buf;
189260165Shibler 	    }
189360165Shibler 	  *p = *addr++;
189460165Shibler 	  if (*p++ == '\015')
189560165Shibler 	    p[-1] = '\n';
189660165Shibler 	}
189760165Shibler       if (p != buf)
189860165Shibler 	if (write (desc, buf, p - buf) != p - buf)
189960165Shibler 	  return -1;
190060165Shibler     }
190160165Shibler   return 0;
190260165Shibler }
190360165Shibler 
190460165Shibler DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
190560165Shibler   Sverify_visited_file_modtime, 1, 1, 0,
190660165Shibler   "Return t if last mod time of BUF's visited file matches what BUF records.\n\
190760165Shibler This means that the file has not been changed since it was visited or saved.")
190860165Shibler   (buf)
190960165Shibler      Lisp_Object buf;
191060165Shibler {
191160165Shibler   struct buffer *b;
191260165Shibler   struct stat st;
191360165Shibler 
191460165Shibler   CHECK_BUFFER (buf, 0);
191560165Shibler   b = XBUFFER (buf);
191660165Shibler 
191760165Shibler   if (XTYPE (b->filename) != Lisp_String) return Qt;
191860165Shibler   if (b->modtime == 0) return Qt;
191960165Shibler 
192060165Shibler   if (stat (XSTRING (b->filename)->data, &st) < 0)
192160165Shibler     {
192260165Shibler       /* If the file doesn't exist now and didn't exist before,
192360165Shibler 	 we say that it isn't modified, provided the error is a tame one.  */
192460165Shibler       if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
192560165Shibler 	st.st_mtime = -1;
192660165Shibler       else
192760165Shibler 	st.st_mtime = 0;
192860165Shibler     }
192960165Shibler   if (st.st_mtime == b->modtime
193060165Shibler       /* If both are positive, accept them if they are off by one second.  */
193160165Shibler       || (st.st_mtime > 0 && b->modtime > 0
193260165Shibler 	  && (st.st_mtime == b->modtime + 1
193360165Shibler 	      || st.st_mtime == b->modtime - 1)))
193460165Shibler     return Qt;
193560165Shibler   return Qnil;
193660165Shibler }
193760165Shibler 
193860165Shibler DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
193960165Shibler   Sclear_visited_file_modtime, 0, 0, 0,
194060165Shibler   "Clear out records of last mod time of visited file.\n\
194160165Shibler Next attempt to save will certainly not complain of a discrepancy.")
194260165Shibler   ()
194360165Shibler {
194460165Shibler   current_buffer->modtime = 0;
194560165Shibler   return Qnil;
194660165Shibler }
194760165Shibler 
194860165Shibler Lisp_Object
auto_save_error()194960165Shibler auto_save_error ()
195060165Shibler {
195160165Shibler   unsigned char *name = XSTRING (current_buffer->name)->data;
195260165Shibler 
195360165Shibler   bell ();
195460165Shibler   message ("Autosaving...error for %s", name);
195560165Shibler   Fsleep_for (make_number (1));
195660165Shibler   message ("Autosaving...error!for %s", name);
195760165Shibler   Fsleep_for (make_number (1));
195860165Shibler   message ("Autosaving...error for %s", name);
195960165Shibler   Fsleep_for (make_number (1));
196060165Shibler   return Qnil;
196160165Shibler }
196260165Shibler 
196360165Shibler Lisp_Object
auto_save_1()196460165Shibler auto_save_1 ()
196560165Shibler {
196660165Shibler   return
196760165Shibler     Fwrite_region (Qnil, Qnil,
196860165Shibler 		   current_buffer->auto_save_file_name,
196960165Shibler 		   Qnil, Qlambda);
197060165Shibler }
197160165Shibler 
197260165Shibler DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 1, "",
197360165Shibler   "Auto-save all buffers that need it.\n\
197460165Shibler This is all buffers that have auto-saving enabled\n\
197560165Shibler and are changed since last auto-saved.\n\
197660165Shibler Auto-saving writes the buffer into a file\n\
197760165Shibler so that your editing is not lost if the system crashes.\n\
197860165Shibler This file is not the file you visited; that changes only when you save.\n\n\
197960165Shibler Non-nil argument means do not print any message if successful.")
198060165Shibler   (nomsg)
198160165Shibler      Lisp_Object nomsg;
198260165Shibler {
198360165Shibler   struct buffer *old = current_buffer, *b;
198460165Shibler   Lisp_Object tail, buf;
198560165Shibler   int auto_saved = 0;
198660165Shibler   int tried = 0;
198760165Shibler   char *omessage = echo_area_contents;
198860165Shibler   /* No GCPRO needed, because (when it matters) all Lisp_Object variables
198960165Shibler      point to non-strings reached from Vbuffer_alist.  */
199060165Shibler 
199160165Shibler   auto_saving = 1;
199260165Shibler   if (minibuf_level)
199360165Shibler     nomsg = Qt;
199460165Shibler 
199560165Shibler   for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
199660165Shibler        tail = XCONS (tail)->cdr)
199760165Shibler     {
199860165Shibler       buf = XCONS (XCONS (tail)->car)->cdr;
199960165Shibler       b = XBUFFER (buf);
200060165Shibler       /* Check for auto save enabled
200160165Shibler 	 and file changed since last auto save
200260165Shibler 	 and file changed since last real save.  */
200360165Shibler       if (XTYPE (b->auto_save_file_name) == Lisp_String
200460165Shibler 	  && b->save_modified < BUF_MODIFF (b)
200560165Shibler 	  && b->auto_save_modified < BUF_MODIFF (b))
200660165Shibler 	{
200760165Shibler 	  /* If we at least consider a buffer for auto-saving,
200860165Shibler 	     don't try again for a suitable time.  */
200960165Shibler 	  tried++;
201060165Shibler 	  if ((XFASTINT (b->save_length) * 10
201160165Shibler 	       > (BUF_Z (b) - BUF_BEG (b)) * 13)
201260165Shibler 	      /* A short file is likely to change a large fraction;
201360165Shibler 		 spare the user annoying messages.  */
201460165Shibler 	      && XFASTINT (b->save_length) > 5000
201560165Shibler 	      /* These messages are frequent and annoying for `*mail*'.  */
201660165Shibler 	      && !EQ (b->filename, Qnil))
201760165Shibler 	    {
201860165Shibler 	      /* It has shrunk too much; don't checkpoint. */
201960165Shibler 	      message ("Buffer %s has shrunk a lot; not autosaving it",
202060165Shibler 		       XSTRING (b->name)->data);
202160165Shibler 	      Fsleep_for (make_number (1));
202260165Shibler 	      continue;
202360165Shibler 	    }
202460165Shibler 	  set_buffer_internal (b);
202560165Shibler 	  if (!auto_saved && NULL (nomsg))
202660165Shibler 	    message1 ("Auto-saving...");
202760165Shibler 	  internal_condition_case (auto_save_1, Qt, auto_save_error);
202860165Shibler 	  auto_saved++;
202960165Shibler 	  b->auto_save_modified = BUF_MODIFF (b);
203060165Shibler 	  XFASTINT (current_buffer->save_length) = Z - BEG;
203160165Shibler 	  set_buffer_internal (old);
203260165Shibler 	}
203360165Shibler     }
203460165Shibler 
203560165Shibler   if (tried)
203660165Shibler     record_auto_save ();
203760165Shibler 
203860165Shibler   if (auto_saved && NULL (nomsg))
203960165Shibler     message1 (omessage ? omessage : "Auto-saving...done");
204060165Shibler 
204160165Shibler   auto_saving = 0;
204260165Shibler   return Qnil;
204360165Shibler }
204460165Shibler 
204560165Shibler DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
204660165Shibler   Sset_buffer_auto_saved, 0, 0, 0,
204760165Shibler   "Mark current buffer as auto-saved with its current text.\n\
204860165Shibler No auto-save file will be written until the buffer changes again.")
204960165Shibler   ()
205060165Shibler {
205160165Shibler   current_buffer->auto_save_modified = MODIFF;
205260165Shibler   XFASTINT (current_buffer->save_length) = Z - BEG;
205360165Shibler   return Qnil;
205460165Shibler }
205560165Shibler 
205660165Shibler DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
205760165Shibler   0, 0, 0,
205860165Shibler   "Return t if buffer has been auto-saved since last read in or saved.")
205960165Shibler   ()
206060165Shibler {
206160165Shibler   return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
206260165Shibler }
206360165Shibler 
206460165Shibler /* Reading and completing file names */
206560165Shibler extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
206660165Shibler 
206760165Shibler DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
206860165Shibler   3, 3, 0,
206960165Shibler   "Internal subroutine for read-file-name.  Do not call this.")
207060165Shibler   (string, dir, action)
207160165Shibler      Lisp_Object string, dir, action;
207260165Shibler   /* action is nil for complete, t for return list of completions,
207360165Shibler      lambda for verify final value */
207460165Shibler {
207560165Shibler   Lisp_Object name, specdir, realdir, val;
207660165Shibler   if (XSTRING (string)->size == 0)
207760165Shibler     {
207860165Shibler       name = string;
207960165Shibler       realdir = dir;
208060165Shibler       if (EQ (action, Qlambda))
208160165Shibler 	return Qnil;
208260165Shibler     }
208360165Shibler   else
208460165Shibler     {
208560165Shibler       string = Fsubstitute_in_file_name (string);
208660165Shibler       name = Ffile_name_nondirectory (string);
208760165Shibler       realdir = Ffile_name_directory (string);
208860165Shibler       if (NULL (realdir))
208960165Shibler 	realdir = dir;
209060165Shibler       else
209160165Shibler 	realdir = Fexpand_file_name (realdir, dir);
209260165Shibler     }
209360165Shibler 
209460165Shibler   if (NULL (action))
209560165Shibler     {
209660165Shibler       specdir = Ffile_name_directory (string);
209760165Shibler       val = Ffile_name_completion (name, realdir);
209860165Shibler       if (XTYPE (val) != Lisp_String)
209960165Shibler 	return (val);
210060165Shibler 
210160165Shibler       if (!NULL (specdir))
210260165Shibler 	val = concat2 (specdir, val);
210360165Shibler #ifndef VMS
210460165Shibler       {
210560165Shibler 	register unsigned char *old, *new;
210660165Shibler 	register int n;
210760165Shibler 	int osize, count;
210860165Shibler 
210960165Shibler 	osize = XSTRING (val)->size;
211060165Shibler 	/* Quote "$" as "$$" to get it past substitute-in-file-name */
211160165Shibler 	for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
211260165Shibler 	  if (*old++ == '$') count++;
211360165Shibler 	if (count > 0)
211460165Shibler 	  {
211560165Shibler 	    old = XSTRING (val)->data;
211660165Shibler 	    val = Fmake_string (make_number (osize + count), make_number (0));
211760165Shibler 	    new = XSTRING (val)->data;
211860165Shibler 	    for (n = osize; n > 0; n--)
211960165Shibler 	      if (*old != '$')
212060165Shibler 		*new++ = *old++;
212160165Shibler 	      else
212260165Shibler 		{
212360165Shibler 		  *new++ = '$';
212460165Shibler 		  *new++ = '$';
212560165Shibler 		  old++;
212660165Shibler 		}
212760165Shibler 	  }
212860165Shibler       }
212960165Shibler #endif /* Not VMS */
213060165Shibler       return (val);
213160165Shibler     }
213260165Shibler 
213360165Shibler   if (EQ (action, Qt))
213460165Shibler     return Ffile_name_all_completions (name, realdir);
213560165Shibler   /* Only other case actually used is ACTION = lambda */
213660165Shibler #ifdef VMS
213760165Shibler   /* Supposedly this helps commands such as `cd' that read directory names,
213860165Shibler      but can someone explain how it helps them? -- RMS */
213960165Shibler   if (XSTRING (name)->size == 0)
214060165Shibler     return Qt;
214160165Shibler #endif /* VMS */
214260165Shibler   return Ffile_exists_p (string);
214360165Shibler }
214460165Shibler 
214560165Shibler DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 4, 0,
214660165Shibler   "Read file name, prompting with PROMPT and completing in directory DIR.\n\
214760165Shibler Value is not expanded!  You must call expand-file-name yourself.\n\
214860165Shibler Default name to DEFAULT if user enters a null string.\n\
214960165Shibler Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
215060165Shibler  Non-nil and non-t means also require confirmation after completion.\n\
215160165Shibler DIR defaults to current buffer's directory default.")
215260165Shibler   (prompt, dir, defalt, mustmatch)
215360165Shibler      Lisp_Object prompt, dir, defalt, mustmatch;
215460165Shibler {
215560165Shibler   Lisp_Object val, insdef, tem;
215660165Shibler   struct gcpro gcpro1, gcpro2;
215760165Shibler   register char *homedir;
215860165Shibler   int count;
215960165Shibler 
216060165Shibler   if (NULL (dir))
216160165Shibler     dir = current_buffer->directory;
216260165Shibler   if (NULL (defalt))
216360165Shibler     defalt = current_buffer->filename;
216460165Shibler 
216560165Shibler   /* If dir starts with user's homedir, change that to ~. */
216660165Shibler   homedir = (char *) egetenv ("HOME");
216760165Shibler   if (homedir != 0
216860165Shibler       && XTYPE (dir) == Lisp_String
216960165Shibler       && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
217060165Shibler       && XSTRING (dir)->data[strlen (homedir)] == '/')
217160165Shibler     {
217260165Shibler       dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
217360165Shibler 			 XSTRING (dir)->size - strlen (homedir) + 1);
217460165Shibler       XSTRING (dir)->data[0] = '~';
217560165Shibler     }
217660165Shibler 
217760165Shibler   if (insert_default_directory)
217860165Shibler     insdef = dir;
217960165Shibler   else
218060165Shibler     insdef = build_string ("");
218160165Shibler 
218260165Shibler #ifdef VMS
218360165Shibler   count = specpdl_ptr - specpdl;
218460165Shibler   specbind (intern ("completion-ignore-case"), Qt);
218560165Shibler #endif
218660165Shibler 
218760165Shibler   GCPRO2 (insdef, defalt);
218860165Shibler   val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
218960165Shibler 			  dir, mustmatch,
219060165Shibler 			  insert_default_directory ? insdef : Qnil);
219160165Shibler 
219260165Shibler #ifdef VMS
219360165Shibler   unbind_to (count);
219460165Shibler #endif
219560165Shibler 
219660165Shibler   UNGCPRO;
219760165Shibler   if (NULL (val))
219860165Shibler     error ("No file name specified");
219960165Shibler   tem = Fstring_equal (val, insdef);
220060165Shibler   if (!NULL (tem) && !NULL (defalt))
220160165Shibler     return defalt;
220260165Shibler   return Fsubstitute_in_file_name (val);
220360165Shibler }
220460165Shibler 
syms_of_fileio()220560165Shibler syms_of_fileio ()
220660165Shibler {
220760165Shibler   Qfile_error = intern ("file-error");
220860165Shibler   staticpro (&Qfile_error);
220960165Shibler   Qfile_already_exists = intern("file-already-exists");
221060165Shibler   staticpro (&Qfile_already_exists);
221160165Shibler 
221260165Shibler   Fput (Qfile_error, Qerror_conditions,
221360165Shibler 	Fcons (Qfile_error, Fcons (Qerror, Qnil)));
221460165Shibler   Fput (Qfile_error, Qerror_message,
221560165Shibler 	build_string ("File error"));
221660165Shibler 
221760165Shibler   Fput (Qfile_already_exists, Qerror_conditions,
221860165Shibler 	Fcons (Qfile_already_exists,
221960165Shibler 	       Fcons (Qfile_error, Fcons (Qerror, Qnil))));
222060165Shibler   Fput (Qfile_already_exists, Qerror_message,
222160165Shibler 	build_string ("File already exists"));
222260165Shibler 
222360165Shibler   DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
222460165Shibler     "*Non-nil means when reading a filename start with default dir in minibuffer.");
222560165Shibler   insert_default_directory = 1;
222660165Shibler 
222760165Shibler   DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
222860165Shibler     "*Non-nil means write new files with record format `stmlf'.\n\
222960165Shibler nil means use format `var'.  This variable is meaningful only on VMS.");
223060165Shibler   vms_stmlf_recfm = 0;
223160165Shibler 
223260165Shibler   defsubr (&Sfile_name_directory);
223360165Shibler   defsubr (&Sfile_name_nondirectory);
223460165Shibler   defsubr (&Sfile_name_as_directory);
223560165Shibler   defsubr (&Sdirectory_file_name);
223660165Shibler   defsubr (&Smake_temp_name);
223760165Shibler   defsubr (&Sexpand_file_name);
223860165Shibler   defsubr (&Ssubstitute_in_file_name);
223960165Shibler   defsubr (&Scopy_file);
224060165Shibler   defsubr (&Sdelete_file);
224160165Shibler   defsubr (&Srename_file);
224260165Shibler   defsubr (&Sadd_name_to_file);
224360165Shibler #ifdef S_IFLNK
224460165Shibler   defsubr (&Smake_symbolic_link);
224560165Shibler #endif /* S_IFLNK */
224660165Shibler #ifdef VMS
224760165Shibler   defsubr (&Sdefine_logical_name);
224860165Shibler #endif /* VMS */
224960165Shibler #ifdef HPUX_NET
225060165Shibler   defsubr (&Ssysnetunam);
225160165Shibler #endif /* HPUX_NET */
225260165Shibler   defsubr (&Sfile_name_absolute_p);
225360165Shibler   defsubr (&Sfile_exists_p);
225460165Shibler   defsubr (&Sfile_readable_p);
225560165Shibler   defsubr (&Sfile_writable_p);
225660165Shibler   defsubr (&Sfile_symlink_p);
225760165Shibler   defsubr (&Sfile_directory_p);
225860165Shibler   defsubr (&Sfile_modes);
225960165Shibler   defsubr (&Sset_file_modes);
226060165Shibler   defsubr (&Sfile_newer_than_file_p);
226160165Shibler   defsubr (&Sinsert_file_contents);
226260165Shibler   defsubr (&Swrite_region);
226360165Shibler   defsubr (&Sverify_visited_file_modtime);
226460165Shibler   defsubr (&Sclear_visited_file_modtime);
226560165Shibler   defsubr (&Sdo_auto_save);
226660165Shibler   defsubr (&Sset_buffer_auto_saved);
226760165Shibler   defsubr (&Srecent_auto_save_p);
226860165Shibler 
226960165Shibler   defsubr (&Sread_file_name_internal);
227060165Shibler   defsubr (&Sread_file_name);
227160165Shibler }
2272