xemacs-beta: src/fileio.c comparison

comparison src/fileio.c @ 151:59463afc5666 r20-3b2

Import from CVS: tag r20-3b2

author	cvs
date	Mon, 13 Aug 2007 09:37:19 +0200
parents	538048ae2ab8
children	85ec50267440

comparison

equal deleted inserted replaced

-:8ebb1c0f0f6f
+:59463afc5666
 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
 will create a new file with the same mode as the original */
 static int auto_save_mode_bits;
 /* Alist of elements (REGEXP . HANDLER) for file names
 whose I/O is done with a special handler.  */
 Lisp_Object Vfile_name_handler_alist;
 /* Format for auto-save files */
 Lisp_Object Vauto_save_file_format;
 /* #### dmoore - This uses current_buffer, better make sure no one
 has GC'd the current buffer.  File handlers are giving me a headache
 maybe I'll just always protect current_buffer around all of those
 calls. */
-/* mrb: #### Needs to be fixed at a lower level; errstring needs to
-be MULEized.  The following at least prevents a crash... */
-Lisp_Object errstring = build_ext_string (strerror (errno), FORMAT_NATIVE);
-/* System error messages are capitalized.  Downcase the initial
-unless it is followed by a slash.  */
-if (string_char (XSTRING (errstring), 1) != '/')
-set_string_char (XSTRING (errstring), 0,
-		     DOWNCASE (current_buffer,
-			       string_char (XSTRING (errstring), 0)));
 signal_error (Qfile_error,
 Fcons (build_translated_string (string),
-		       Fcons (errstring, data)));
+		       Fcons (lisp_strerror (errno), data)));
 }
 void
 maybe_report_file_error (CONST char *string, Lisp_Object data,
 			 Lisp_Object class, Error_behavior errb)
 {
-Lisp_Object errstring;
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
-errstring = build_string (strerror (errno));
-/* System error messages are capitalized.  Downcase the initial
-unless it is followed by a slash.  */
-if (string_char (XSTRING (errstring), 1) != '/')
-set_string_char (XSTRING (errstring), 0,
-		     DOWNCASE (current_buffer,
-			       string_char (XSTRING (errstring), 0)));
 maybe_signal_error (Qfile_error,
 		      Fcons (build_translated_string (string),
-			     Fcons (errstring, data)),
+			     Fcons (lisp_strerror (errno), data)),
 		      class, errb);
 }
 /* signal a file error when errno does not contain a meaningful value. */
 DOESNT_RETURN
 signal_double_file_error_2 (CONST char *string1, CONST char *string2,
 			    Lisp_Object data1, Lisp_Object data2)
 {
 signal_error (Qfile_error,
 list4 (build_translated_string (string1),
 		       build_translated_string (string2),
 		       data1, data2));
 }
 void
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
 maybe_signal_error (Qfile_error,
 		      list4 (build_translated_string (string1),
 			     build_translated_string (string2),
 			     data1, data2),
 		      class, errb);
+}
+/* Just like strerror(3), except return a lisp string instead of char *.
+The string needs to be converted since it may be localized.
+Perhaps this should use strerror-coding-system instead? */
+Lisp_Object
+lisp_strerror (int errnum)
+{
+return build_ext_string (strerror (errnum), FORMAT_NATIVE);
 }
 static Lisp_Object
 close_file_unwind (Lisp_Object fd)
 {
 CHECK_STRING (result);
 return (result);
 }
 static Lisp_Object
 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
 Lisp_Object arg1, Lisp_Object arg2)
 {
 /* This function can call lisp */
 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
 CHECK_STRING (result);
 /* The NT version places the drive letter at the beginning already.  */
 #else /* not WINDOWSNT */
 /* On MSDOG we must put the drive letter in by hand.  */
 res1 = res + 2;
 #endif /* not WINDOWSNT */
 if (getdefdir (drive + 1, res))
 	{
 #ifdef MSDOS
 	  res[0] = drive + 'a';
 	  res[1] = ':';
 #endif /* MSDOS */
 /* Handle // as root for apollo's.  */
 if ((slen > 2 && dst[slen - 1] == '/')
 || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
 dst[slen - 1] = 0;
 #else
 if (slen > 1
 && IS_DIRECTORY_SEP (dst[slen - 1])
 #ifdef DOS_NT
 && !IS_ANY_SEP (dst[slen - 2])
 #endif
 )
 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
 Convert FILENAME to absolute, and canonicalize it.
 Second arg DEFAULT is directory to start with if FILENAME is relative
 (does not start with slash); if DEFAULT is nil or missing,
 the current buffer's value of default-directory is used.
 Path components that are `.' are removed, and
 path components followed by `..' are removed, along with the `..' itself;
 note that these simplifications are done without checking the resulting
 paths in the file system.
 An initial `~/' expands to your home directory.
 An initial `~USER/' expands to USER's home directory.
 */
 (name, defalt))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Bufbyte *nm;
 Bufbyte *newdir, *p, *o;
 int tlen;
 Bufbyte *target;
 struct passwd *pw;
 #ifdef VMS
 int drive = -1;
 int relpath = 0;
 Bufbyte *tmp, *defdir;
 #endif /* DOS_NT */
 Lisp_Object handler;
 CHECK_STRING (name);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (name, Qexpand_file_name);
 #endif
 /* #### dmoore - this is ugly, clean this up.  Looks like nm
 pointing into name should be safe during all of this, though. */
 nm = XSTRING_DATA (name);
 #ifdef MSDOS
 /* First map all backslashes to slashes.  */
 dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
 #endif
 	  if (!IS_DIRECTORY_SEP (*nm))
 	    {
 	      defdir = alloca (MAXPATHLEN + 1);
 	      relpath = getdefdir (tolower (drive) - 'a' + 1, defdir);
 	    }
 	}
 }
 #endif /* DOS_NT */
 /* Handle // and /~ in middle of file name
 by discarding everything through the first / of that sequence.  */
 /* "//" anywhere isn't necessarily hairy; we just start afresh
 	 with the second slash.  */
 if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
 #if defined (APOLLO) || defined (WINDOWSNT)
 	  /* // at start of filename is meaningful on Apollo
 	     and WindowsNT systems */
 	  && nm != p
 #endif /* APOLLO || WINDOWSNT */
 	  )
 	nm = p + 1;
 newdir = XSTRING_DATA (defalt);
 }
 #ifdef DOS_NT
 if (newdir == 0 && relpath)
 newdir = defdir;
 #endif /* DOS_NT */
 if (newdir != 0)
 {
 /* Get rid of any slash at the end of newdir.  */
 int length = strlen ((char *) newdir);
 tlen = 0;
 /* Now concatenate the directory and name to new space in the stack frame */
 tlen += strlen ((char *) nm) + 1;
 #ifdef DOS_NT
 /* Add reserved space for drive name.  (The Microsoft x86 compiler
 produces incorrect code if the following two lines are combined.)  */
 target = (Bufbyte *) alloca (tlen + 2);
 target += 2;
 #else  /* not DOS_NT */
 target = (Bufbyte *) alloca (tlen);
 	{
 	  *o++ = *p++;
 	}
 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
 #if defined (APOLLO) || defined (WINDOWSNT)
 	       /* // at start of filename is meaningful in Apollo
 		  and WindowsNT systems */
 	       && o != target
 #endif /* APOLLO */
 	       )
 	{
 	       && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
 	{
 	  while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
 	    ;
 #if defined (APOLLO) || defined (WINDOWSNT)
 	  if (o == target + 1
 	      && IS_DIRECTORY_SEP (o[-1]) && IS_DIRECTORY_SEP (o[0]))
 	    ++o;
 	  else
 #endif /* APOLLO || WINDOWSNT */
 	  if (o == target && IS_ANY_SEP (*o))
 {
 char resolved_path[MAXPATHLEN];
 char path[MAXPATHLEN];
 char *p = path;
 int elen = XSTRING_LENGTH (expanded_name);
 if (elen >= countof (path))
 goto toolong;
 memcpy (path, XSTRING_DATA (expanded_name), elen + 1);
 /* memset (resolved_path, 0, sizeof (resolved_path)); */
 /* Try doing it all at once. */
 /* !!#### Does realpath() Mule-encapsulate? */
 		   the error, and places in resolved_path the absolute pathname
 		   of the path component which could not be resolved." */
 		if (p)
 		  {
 		    int plen = elen - (p - path);
 		    if (rlen > 1 && resolved_path[rlen - 1] == '/')
 		      rlen = rlen - 1;
 		    if (plen + rlen + 1 > countof (resolved_path))
 		      goto toolong;
 	  prompt = emacs_doprnt_string_c
 	    ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
 	     Qnil, -1, XSTRING_DATA (absname),
 	     GETTEXT (querystring));
 	  GCPRO1 (prompt);
 	  tem = call1 (Qyes_or_no_p, prompt);
 	  UNGCPRO;
 	}
 else
 {
 Lisp_Object args[3];
 struct gcpro ngcpro1;
 int i = 1;
 args[0] = newname;
 args[1] = Qnil; args[2] = Qnil;
 NGCPRO1 (*args);
 ngcpro1.nvars = 3;
 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
 	args[i++] = build_string ("/");
 args[i++] = Ffile_name_nondirectory (filename);
 newname = Fconcat (i, args);
 {
 /* This function can GC.  GC checked 1997.04.06. */
 char dir [MAXPATHLEN];
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (dirname);
 dirname = Fexpand_file_name (dirname, Qnil);
 GCPRO1 (dirname);
 handler = Ffind_file_name_handler (dirname, Qmake_directory_internal);
 UNGCPRO;
 if (!NILP (handler))
 return (call2 (handler, Qmake_directory_internal, dirname));
 if (XSTRING_LENGTH (dirname) > (sizeof (dir) - 1))
 {
 return Fsignal (Qfile_error,
 		      list3 (build_translated_string ("Creating directory"),
 			     build_translated_string ("pathame too long"),
 (dirname))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (dirname);
 GCPRO1 (dirname);
 dirname = Fexpand_file_name (dirname, Qnil);
 dirname =  Fdirectory_file_name (dirname);
 (filename))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
 GCPRO1 (filename);
 handler = Ffind_file_name_handler (filename, Qdelete_file);
 {
 Lisp_Object args[3];
 struct gcpro ngcpro1;
 int i = 1;
 args[0] = newname;
 args[1] = Qnil; args[2] = Qnil;
 NGCPRO1 (*args);
 ngcpro1.nvars = 3;
 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
 	args[i++] = build_string ("/");
 args[i++] = Ffile_name_nondirectory (filename);
 newname = Fconcat (i, args);
 Open a network connection to PATH using LOGIN as the login string.
 */
 (path, login))
 {
 int netresult;
 CHECK_STRING (path);
 CHECK_STRING (login);
 /* netunam, being a strange-o system call only used once, is not
 encapsulated. */
 {
 char *path_ext;
 char *login_ext;
 GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext);
 GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext);
 netresult = netunam (path_ext, login_ext);
 }
 if (netresult == -1)
 return Qnil;
 /* This function can call lisp */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct stat statbuf;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 {
 /* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 /* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath;
 Lisp_Object handler;
 int desc;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 /* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath, dir;
 Lisp_Object handler;
 struct stat statbuf;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 int bufsize;
 int valsize;
 Lisp_Object val;
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 /* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
 GCPRO1 (current_buffer->directory);
 abspath = expand_and_dir_to_file (filename,
 				    current_buffer->directory);
 UNGCPRO;
 /* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
 GCPRO1 (current_buffer->directory);
 abspath = expand_and_dir_to_file (filename,
 				    current_buffer->directory);
 UNGCPRO;
 {
 /* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct gcpro gcpro1;
 GCPRO1 (current_buffer->directory);
 abspath = Fexpand_file_name (filename, current_buffer->directory);
 UNGCPRO;
 CHECK_INT (mode);
 This setting is inherited by subprocesses.
 */
 (mode))
 {
 CHECK_INT (mode);
 umask ((~ XINT (mode)) & 0777);
 return Qnil;
 }
 curbuf was killed and if so signal an error? */
 XSETBUFFER (curbuf, buf);
 GCPRO5 (filename, val, visit, handler, curbuf);
 mc_count = (NILP (replace)) ?
 begin_multiple_change (buf, BUF_PT  (buf), BUF_PT (buf)) :
 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z  (buf));
 speccount = specpdl_depth (); /* begin_multiple_change also adds
 CHECK_SYMBOL (used_codesys);
 #endif
 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
 error ("Attempt to visit less than an entire file");
 if (!NILP (beg))
 CHECK_INT (beg);
 else
 beg = Qzero;
 	Charcount cc_inserted;
 	QUIT;
 	this_len = Lstream_read (XLSTREAM (stream), read_buf,
 				 sizeof (read_buf));
 	if (this_len <= 0)
 	  {
 	    if (this_len < 0)
 	      saverrno = errno;
 	    break;
 }
 /* Decode file format */
 if (inserted > 0)
 {
 Lisp_Object insval = call3 (Qformat_decode,
 Qnil, make_int (inserted), visit);
 CHECK_INT (insval);
 inserted = XINT (insval);
 }
 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
 /* If build_annotations switched buffers, switch back to BUF.
 Kill the temporary buffer that was selected in the meantime.  */
 static Lisp_Object
 build_annotations_unwind (Lisp_Object buf)
 {
 Lisp_Object tembuf;
 if (XBUFFER (buf) == current_buffer)
 if (NILP (handler) && STRINGP (visit))
 handler = Ffind_file_name_handler (visit, Qwrite_region);
 if (!NILP (handler))
 {
 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
 filename, append, visit, lockname, codesys);
 	if (visiting)
 	  {
 	    BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
 	    current_buffer->save_length =
 if (desc < 0)
 #ifndef VMS
 {
 #ifdef DOS_NT
 desc = open ((char *) XSTRING_DATA (fn),
 (O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type),
 (S_IREAD | S_IWRITE));
 #else /* not DOS_NT */
 desc = creat ((char *) XSTRING_DATA (fn),
 		    ((auto_saving) ? auto_save_mode_bits : 0666));
 #endif /* DOS_NT */
 	failure = 1;
 	save_errno = errno;
 }
 #endif
 /* Spurious "file has changed on disk" warnings have been
 observed on Suns as well.
 It seems that `close' can change the modtime, under nfs.
 (This has supposedly been fixed in Sunos 4,
 but who knows about all the other machines with NFS?)  */
 build_annotations (switches back to the original current buffer
 as necessary). */
 XCAR (desc_locative) = Qnil;
 unbind_to (speccount, Qnil);
 }
 #ifdef VMS
 /* If we wrote to a temporary name and had no errors, rename to real name. */
 if (!NILP (fname))
 {
 if (!failure)
 	{
 	  failure = (rename ((char *) XSTRING_DATA (fn),
 			     (char *) XSTRING_DATA (fname))
 		     != 0);
 	  save_errno = errno;
 	}
 fn = fname;
 next attempt to save.  */
 if (visiting)
 current_buffer->modtime = st.st_mtime;
 if (failure)
 error ("IO error writing %s: %s",
 XSTRING_DATA (fn),
 strerror (save_errno));
 if (visiting)
 {
 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
 	  fsp = Ffile_symlink_p (fn);
 	  if (NILP (fsp))
 	    message ("Wrote %s", XSTRING_DATA (fn));
 	  else
 	    message ("Wrote %s (symlink to %s)",
 		     XSTRING_DATA (fn), XSTRING_DATA (fsp));
 	  UNGCPRO;
 	}
 }
 return Qnil;
 	{
 	  while (pos != nextpos)
 	    {
 	      /* Otherwise there is no point to that.  Just go in batches. */
 	      int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
 	      chunk = Lstream_read (instr, largebuf, chunk);
 	      if (chunk < 0)
 		return -1;
 	      if (chunk == 0) /* EOF */
 		break;
 {
 Lisp_Object filename;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2, gcpro3;
 GCPRO3 (filename, time_list, current_buffer->filename);
 filename = Fexpand_file_name (current_buffer->filename, Qnil);
 /* If the file name has special constructs in it,
 	 call the corresponding file handler.  */
 return Qnil;
 }
 DEFUN ("set-buffer-modtime", Fset_buffer_modtime, 1, 2, 0, /*
 Update BUFFER's recorded modification time from the associated
 file's modtime, if there is an associated file. If not, use the
 current time. In either case, if the optional arg TIME is supplied,
 it will be used if it is either an integer or a cons of two integers.
 */
 (buf, in_time))
 {
 {
 time_to_use = XINT (in_time);
 set_time_to_use = 1;
 }
 else if ((CONSP (in_time)) &&
 (INTP (Fcar (in_time))) &&
 (INTP (Fcdr (in_time))))
 	{
 	  time_t the_time;
 	  lisp_to_time (in_time, &the_time);
 	  time_to_use = (unsigned long) the_time;
 	  time_to_use = time ((time_t *) 0);
 	}
 }
 XBUFFER (buf)->modtime = time_to_use;
 return Qnil;
 }
 static Lisp_Object
 	  b = XBUFFER (buf);
 	  if (!GC_NILP (current_only)
 	      && b != current_buffer)
 	    continue;
 	  /* Don't auto-save indirect buffers.
 	     The base buffer takes care of it.  */
 	  if (b->base_buffer)
 	    continue;
 		 auto save name.  */
 	      if (listdesc >= 0)
 		{
 		  Extbyte *auto_save_file_name_ext;
 		  Extcount auto_save_file_name_ext_len;
 		  GET_STRING_FILENAME_DATA_ALLOCA
 		    (b->auto_save_file_name,
 		     auto_save_file_name_ext,
 		     auto_save_file_name_ext_len);
 		  if (!NILP (b->filename))
 		    {
 		      Extbyte *filename_ext;
 		      Extcount filename_ext_len;
 		      GET_STRING_FILENAME_DATA_ALLOCA (b->filename,
 						       filename_ext,
 						       filename_ext_len);
 		      write (listdesc, filename_ext, filename_ext_len);
 		    }
 	      if (!BUFFER_LIVE_P (XBUFFER (old)))
 		XSETBUFFER (old, current_buffer);
 	      set_buffer_internal (XBUFFER (old));
 	      auto_saved++;
 	      /* Handler killed their own buffer! */
 	      if (!BUFFER_LIVE_P(b))
 		continue;
 	      b->auto_save_modified = BUF_MODIFF (b);

Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 151:59463afc5666 r20-3b2