xemacs-beta: src/fileio.c comparison

comparison src/fileio.c @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	ee648375d8d6
children	54cc21c15cbb

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 #include "insdel.h"
 #include "lstream.h"
 #include "redisplay.h"
 #include "sysdep.h"
 #include "window.h"             /* minibuf_level */
+#ifdef MULE
+#include "mule-coding.h"
+#endif
 #ifdef HAVE_LIBGEN_H            /* Must come before sysfile.h */
 #include <libgen.h>
 #endif
 #include "sysfile.h"
 /* signal a file error when errno contains a meaningful value. */
 DOESNT_RETURN
 report_file_error (CONST char *string, Lisp_Object data)
 {
-/* #### 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_BINARY);
 /* System error messages are capitalized.  Downcase the initial
 unless it is followed by a slash.  */
-if (string_char_length (XSTRING (errstring)) >= 2
+if (string_char (XSTRING (errstring), 1) != '/')
-&& string_char (XSTRING (errstring), 1) != '/')
 set_string_char (XSTRING (errstring), 0,
 		     DOWNCASE (current_buffer,
 			       string_char (XSTRING (errstring), 0)));
 signal_error (Qfile_error,
 but we still do run any other handlers.  This lets handlers
 use the standard functions without calling themselves recursively.
 */
 (filename, operation))
 {
-/* This function does not GC */
 /* This function must not munge the match data.  */
 Lisp_Object chain, inhibited_handlers;
 CHECK_STRING (filename);
 }
 static Lisp_Object
 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object result = call2 (fn, arg0, arg1);
 CHECK_STRING (result);
 return (result);
 }
 static Lisp_Object
-call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
-{
-/* This function can call lisp */
-Lisp_Object result = call2 (fn, arg0, arg1);
-if (!NILP (result))
-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 */
+/* This function can GC */
 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
 CHECK_STRING (result);
 return (result);
 }
 Given a Unix syntax file name, returns a string ending in slash;
 on VMS, perhaps instead a string ending in `:', `]' or `>'.
 */
 (file))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Bufbyte *beg;
 Bufbyte *p;
 Lisp_Object handler;
 CHECK_STRING (file);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (file, Qfile_name_directory);
 if (!NILP (handler))
-return (call2_check_string_or_nil (handler, Qfile_name_directory,
+{
-				       file));
+Lisp_Object retval = call2 (handler, Qfile_name_directory,
+				  file);
+if (!NILP (retval))
+	CHECK_STRING (retval);
+return retval;
+}
 #ifdef FILE_SYSTEM_CASE
 file = FILE_SYSTEM_CASE (file);
 #endif
 beg = XSTRING_DATA (file);
 this is everything after the last slash,
 or the entire name if it contains no slash.
 */
 (file))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Bufbyte *beg, *p, *end;
 Lisp_Object handler;
 CHECK_STRING (file);
 If FILENAME is a directly usable file itself, return
 (file-name-directory FILENAME).
 The `call-process' and `start-process' functions use this function to
 get a current directory to run processes in.
 */
 (filename))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Lisp_Object handler;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
 For a Unix-syntax file name, just appends a slash.
 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.
 */
 (file))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 char *buf;
 Lisp_Object handler;
 CHECK_STRING (file);
 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
 it returns a file name such as \"[X]Y.DIR.1\".
 */
 (directory))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 char *buf;
 Lisp_Object handler;
 CHECK_STRING (directory);
 An initial `~USER/' expands to USER's home directory.
 See also the function `substitute-in-file-name'.
 */
 (name, defalt))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Bufbyte *nm;
 Bufbyte *newdir, *p, *o;
 int tlen;
 Bufbyte *target;
 else
 CHECK_STRING (defalt);
 if (!NILP (defalt))
 {
-struct gcpro gcpro1;
-GCPRO1 (defalt);		/* might be current_buffer->directory */
 handler = Ffind_file_name_handler (defalt, Qexpand_file_name);
-UNGCPRO;
 if (!NILP (handler))
 	return call3 (handler, Qexpand_file_name, name, defalt);
 }
 /* Make sure DEFALT is properly expanded.
 that would need adjusting, and people would add new pointers to
 the code and forget to adjust them, resulting in intermittent bugs.
 Putting this call here avoids all that crud.
 The EQ test avoids infinite recursion.  */
-if (! NILP(defalt) && !EQ (defalt, name)
+if (! NILP (defalt) && !EQ (defalt, name)
 /* This saves time in a common case.  */
 && ! (XSTRING_LENGTH (defalt) >= 3
-	    && (IS_DIRECTORY_SEP (XSTRING_BYTE (defalt, 0))
+	    && IS_DIRECTORY_SEP (string_byte (XSTRING (defalt), 0))
-		|| IS_DEVICE_SEP (XSTRING_BYTE (defalt, 1)))))
+	    && IS_DEVICE_SEP (string_byte (XSTRING (defalt), 1))))
 {
 struct gcpro gcpro1;
-GCPRO1 (defalt);		/* may be current_buffer->directory */
+GCPRO1 (name);
 defalt = Fexpand_file_name (defalt, Qnil);
 UNGCPRO;
 }
 #ifdef VMS
 #endif
 #ifdef FILE_SYSTEM_CASE
 name = FILE_SYSTEM_CASE (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));
 No component of the resulting pathname will be a symbolic link, as
 in the realpath() function.
 */
 (filename, defalt))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
+struct gcpro gcpro1;
 Lisp_Object expanded_name;
 Lisp_Object handler;
-struct gcpro gcpro1;
 CHECK_STRING (filename);
+GCPRO1 (filename);
 expanded_name = Fexpand_file_name (filename, defalt);
+UNGCPRO;
 if (!STRINGP (expanded_name))
 return Qnil;
 GCPRO1 (expanded_name);
 	  }
 }
 {
 int rlen = strlen (resolved_path);
-if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
+if (elen > 0 && string_byte (XSTRING (expanded_name), elen - 1) == '/'
 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
 	{
 	  if (rlen + 1 > countof (resolved_path))
 	    goto toolong;
 	  resolved_path[rlen] = '/';
 On VMS, `$' substitution is not done; this function does little and only
 duplicates what `expand-file-name' does.
 */
 (string))
 {
-/* This function can GC.  GC checked 1997.04.06. */
 Bufbyte *nm;
 Bufbyte *s, *p, *o, *x, *endp;
 Bufbyte *target = 0;
 int total = 0;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
 if (!NILP (handler))
-return (call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
+{
-				       string));
+Lisp_Object retval = call2 (handler, Qsubstitute_in_file_name,
+				  string);
+if (!NILP (retval))
+	CHECK_STRING (retval);
+return retval;
+}
 nm = XSTRING_DATA (string);
 #ifdef MSDOS
 dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
 substituted = !strcmp (nm, XSTRING_DATA (string));
 /* (directory-file-name (expand-file-name FOO)) */
 Lisp_Object
 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath;
 struct gcpro gcpro1;
+GCPRO1 (filename);
 abspath = Fexpand_file_name (filename, defdir);
-GCPRO1 (abspath);
 #ifdef VMS
 {
 Bufbyte c =
-XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1);
+string_byte (XSTRING (abspath), XSTRING_LENGTH (abspath) - 1);
 if (c == ':' || c == ']' || c == '>')
 abspath = Fdirectory_file_name (abspath);
 }
 #else
 /* Remove final slash, if any (unless path is root).
 stat behaves differently depending!  */
 if (XSTRING_LENGTH (abspath) > 1
-&& IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
+&& IS_DIRECTORY_SEP (string_byte (XSTRING (abspath),
-&& !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
+					XSTRING_LENGTH (abspath) - 1))
+&& !IS_DEVICE_SEP (string_byte (XSTRING (abspath),
+				      XSTRING_LENGTH (abspath) - 2)))
 /* We cannot take shortcuts; they might be wrong for magic file names.  */
 abspath = Fdirectory_file_name (abspath);
 #endif
 UNGCPRO;
 return abspath;
 static void
 barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring,
 			      int interactive, struct stat *statptr)
 {
-/* This function can call lisp */
 struct stat statbuf;
 /* stat is a good way to tell whether the file exists,
 regardless of what access permissions it has.  */
 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
 {
 Lisp_Object tem;
+struct gcpro gcpro1;
+GCPRO1 (absname);
 if (interactive)
-	{
+tem = call1
-	  Lisp_Object prompt;
+	  (Qyes_or_no_p,
-	  struct gcpro gcpro1;
+	   (emacs_doprnt_string_c
-	  prompt = emacs_doprnt_string_c
 	    ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
 	     Qnil, -1, XSTRING_DATA (absname),
-	     GETTEXT (querystring));
+	     GETTEXT (querystring))));
-	  GCPRO1 (prompt);
-	  tem = call1 (Qyes_or_no_p, prompt);
-	  UNGCPRO;
-	}
 else
 tem = Qnil;
+UNGCPRO;
 if (NILP (tem))
 	Fsignal (Qfile_already_exists,
 		 list2 (build_translated_string ("File already exists"),
 			absname));
 if (statptr)
 This is what happens in interactive use with M-x.
 Fourth arg KEEP-TIME non-nil means give the new file the same
 last-modified time as the old one.  (This works on only some systems.)
 A prefix arg makes KEEP-TIME non-nil.
 */
-(filename, newname, ok_if_already_exists, keep_time))
+(filename, newname, ok_if_already_exists, keep_date))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 int ifd, ofd, n;
 char buf[16 * 1024];
 struct stat st, out_st;
 Lisp_Object handler;
 int speccount = specpdl_depth ();
 handler = Ffind_file_name_handler (newname, Qcopy_file);
 if (!NILP (handler))
 {
 UNGCPRO;
 return call5 (handler, Qcopy_file, filename, newname,
-		  ok_if_already_exists, keep_time);
+		  ok_if_already_exists, keep_date);
 }
 /* When second argument is a directory, copy the file into it.
 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
 */
 args[0] = newname;
 args[1] = Qnil; args[2] = Qnil;
 NGCPRO1 (*args);
 ngcpro1.nvars = 3;
-if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
+if (string_byte (XSTRING (newname),
+		       XSTRING_LENGTH (newname) - 1) != '/')
 	args[i++] = build_string ("/");
 args[i++] = Ffile_name_nondirectory (filename);
 newname = Fconcat (i, args);
 NUNGCPRO;
 }
 if (close (ofd) < 0)
 report_file_error ("I/O error", Fcons (newname, Qnil));
 if (input_file_statable_p)
 {
-if (!NILP (keep_time))
+if (!NILP (keep_date))
 {
 EMACS_TIME atime, mtime;
 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
 Create a directory.  One argument, a file name string.
 */
 (dirname))
 {
-/* This function can GC.  GC checked 1997.04.06 */
+/* This function can GC */
 char dir [MAXPATHLEN];
 Lisp_Object handler;
 struct gcpro gcpro1;
+GCPRO1 (dirname);
 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));
+return (call2 (handler, Qmake_directory_internal,
+		   dirname));
 if (XSTRING_LENGTH (dirname) > (sizeof (dir) - 1))
 {
 return Fsignal (Qfile_error,
 		      list3 (build_translated_string ("Creating directory"),
 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
 Delete a directory.  One argument, a file name or directory name string.
 */
 (dirname))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Lisp_Object handler;
 struct gcpro gcpro1;
+GCPRO1 (dirname);
 CHECK_STRING (dirname);
+dirname =
-GCPRO1 (dirname);
+Fdirectory_file_name (Fexpand_file_name (dirname, Qnil));
-dirname = Fexpand_file_name (dirname, Qnil);
-dirname =  Fdirectory_file_name (dirname);
 handler = Ffind_file_name_handler (dirname, Qdelete_directory);
 UNGCPRO;
 if (!NILP (handler))
 return (call2 (handler, Qdelete_directory, dirname));
 Delete specified file.  One argument, a file name string.
 If file has multiple names, it continues to exist with the other names.
 */
 (filename))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Lisp_Object handler;
 struct gcpro gcpro1;
+GCPRO1 (filename);
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
-GCPRO1 (filename);
 handler = Ffind_file_name_handler (filename, Qdelete_file);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qdelete_file, filename);
 /* Delete file FILENAME, returning 1 if successful and 0 if failed.  */
 int
 internal_delete_file (Lisp_Object filename)
 {
-/* This function can GC.  GC checked 1997.04.06. */
 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
 				 internal_delete_file_1, Qnil));
 }
 DEFUN ("rename-file", Frename_file, 2, 3,
 A number as third arg means request confirmation if NEWNAME already exists.
 This is what happens in interactive use with M-x.
 */
 (filename, newname, ok_if_already_exists))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (filename, newname);
 CHECK_STRING (filename);
 A number as third arg means request confirmation if NEWNAME already exists.
 This is what happens in interactive use with M-x.
 */
 (filename, newname, ok_if_already_exists))
 {
-/* This function can GC.  GC checked 1997.04.06. */
+/* This function can GC */
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (filename, newname);
 CHECK_STRING (filename);
 A number as third arg means request confirmation if LINKNAME already exists.
 This happens for interactive use with M-x.
 */
 (filename, linkname, ok_if_already_exists))
 {
-/* This function can GC.  GC checked 1997.06.04. */
+/* This function can GC */
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (filename, linkname);
 CHECK_STRING (filename);
 CHECK_STRING (linkname);
 /* If the link target has a ~, we must expand it to get
 a truly valid file name.  Otherwise, do not expand;
 we want to permit links to relative file names.  */
-if (XSTRING_BYTE (filename, 0) == '~') /* #### Un*x-specific */
+if (string_byte (XSTRING (filename), 0) == '~') /* #### Un*x-specific */
 filename = Fexpand_file_name (filename, Qnil);
 linkname = Fexpand_file_name (linkname, Qnil);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 Return t if file FILENAME specifies an absolute path name.
 On Unix, this is a name starting with a `/' or a `~'.
 */
 (filename))
 {
-/* This function does not GC */
 Bufbyte *ptr;
 CHECK_STRING (filename);
 ptr = XSTRING_DATA (filename);
 if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
 Return t if file FILENAME exists.  (This does not mean you can read it.)
 See also `file-readable-p' and `file-attributes'.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct stat statbuf;
 struct gcpro gcpro1;
+GCPRO1 (filename);
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
+UNGCPRO;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 GCPRO1 (abspath);
 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
 Return t if FILENAME can be executed by you.
 For a directory, this means you can access files in that directory.
 */
 (filename))
-{
-/* This function can call lisp */
+{
+/* This function can GC */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct gcpro gcpro1;
 GCPRO1 (filename);
 Return t if file FILENAME exists and you can read it.
 See also `file-exists-p' and `file-attributes'.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath;
 Lisp_Object handler;
 int desc;
 struct gcpro gcpro1;
+GCPRO1 (filename);
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
+UNGCPRO;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 GCPRO1 (abspath);
 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
 Return t if file FILENAME can be written or created by you.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath, dir;
 Lisp_Object handler;
 struct stat statbuf;
 struct gcpro gcpro1;
+GCPRO1 (filename);
 CHECK_STRING (filename);
 abspath = Fexpand_file_name (filename, Qnil);
+UNGCPRO;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 GCPRO1 (abspath);
 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
 return (check_writable ((char *) XSTRING_DATA (abspath))
 	    ? Qt : Qnil);
-GCPRO1 (abspath);
 dir = Ffile_name_directory (abspath);
-UNGCPRO;
 #if defined (VMS) || defined (MSDOS)
 if (!NILP (dir))
-{
+dir = Fdirectory_file_name (dir);
-GCPRO1(dir);
-dir = Fdirectory_file_name (dir);
-UNGCPRO;
-}
 #endif /* VMS or MSDOS */
 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
 			  : "")
 	  ? Qt : Qnil);
 }
 The value is the name of the file to which it is linked.
 Otherwise returns nil.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 #ifdef S_IFLNK
 char *buf;
 int bufsize;
 int valsize;
 Lisp_Object val;
 Lisp_Object handler;
 struct gcpro gcpro1;
+GCPRO1 (filename);
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
+UNGCPRO;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
-GCPRO1 (filename);
 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
-UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_symlink_p, filename);
 bufsize = 100;
 while (1)
 A directory name spec may be given instead; then the value is t
 if the directory so specified exists and really is a directory.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
-GCPRO1 (current_buffer->directory);
+GCPRO1 (filename);
 abspath = expand_and_dir_to_file (filename,
 				    current_buffer->directory);
 UNGCPRO;
 /* If the file name has special constructs in it,
 if the directory so specified exists and really is a readable and
 searchable directory.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object handler;
+struct gcpro gcpro1;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
 if (!NILP (handler))
 return call2 (handler, Qfile_accessible_directory_p,
 		  filename);
+GCPRO1 (filename);
 if (NILP (Ffile_directory_p (filename)))
+{
+UNGCPRO;
 return (Qnil);
-else
+}
-return Ffile_executable_p (filename);
+handler = Ffile_executable_p (filename);
+UNGCPRO;
+return (handler);
 }
 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
 "Return t if file FILENAME is the name of a regular file.
 This is the sort of file that holds an ordinary stream of data bytes.
 */
 (filename))
 {
-/* This function can call lisp */
+REGISTER Lisp_Object abspath;
-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;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
-GCPRO1 (abspath);
 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
-UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_regular_p, abspath);
 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
 return Qnil;
 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
 Return mode bits of FILE, as an integer.
 */
 (filename))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
-GCPRO1 (current_buffer->directory);
+GCPRO1 (filename);
 abspath = expand_and_dir_to_file (filename,
 				    current_buffer->directory);
 UNGCPRO;
 /* If the file name has special constructs in it,
 Set mode bits of FILE to MODE (an integer).
 Only the 12 low bits of MODE are used.
 */
 (filename, mode))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath;
 Lisp_Object handler;
-struct gcpro gcpro1;
+struct gcpro gcpro1, gcpro2;
-GCPRO1 (current_buffer->directory);
+GCPRO2 (filename, mode);
 abspath = Fexpand_file_name (filename, current_buffer->directory);
+CHECK_INT (mode);
 UNGCPRO;
-CHECK_INT (mode);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 GCPRO1 (abspath);
 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
 If FILE1 does not exist, the answer is nil;
 otherwise, if FILE2 does not exist, the answer is t.
 */
 (file1, file2))
 {
-/* This function can call lisp */
+/* This function can GC */
 Lisp_Object abspath1, abspath2;
 struct stat st;
 int mtime1;
 Lisp_Object handler;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
 CHECK_STRING (file1);
 CHECK_STRING (file2);
 abspath1 = Qnil;
-abspath2 = Qnil;
+GCPRO2 (abspath1, file2);
+abspath1 = expand_and_dir_to_file (file1,
-GCPRO3 (abspath1, abspath2, current_buffer->directory);
+				     current_buffer->directory);
-abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
+abspath2 = expand_and_dir_to_file (file2,
-abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
+				     current_buffer->directory);
+UNGCPRO;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
+GCPRO2 (abspath1, abspath2);
 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
 if (NILP (handler))
 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
 UNGCPRO;
 if (!NILP (handler))
 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
 /* #define READ_BUF_SIZE (2 << 16) */
 #define READ_BUF_SIZE (1 << 15)
 DEFUN ("insert-file-contents-internal",
-Finsert_file_contents_internal, 1, 5, 0, /*
+Finsert_file_contents_internal, 1, 7, 0, /*
-Insert contents of file FILENAME after point.
+Insert contents of file FILENAME after point; no coding-system frobbing.
-Returns list of absolute file name and length of data inserted.
+This function is identical to `insert-file-contents' except for the
-If second argument VISIT is non-nil, the buffer's visited filename
+handling of the CODESYS and USED-CODESYS arguments under
-and last save file modtime are set, and it is marked unmodified.
+XEmacs/Mule. (When Mule support is not present, both functions are
-If visiting and the file does not exist, visiting is completed
+identical and ignore the CODESYS and USED-CODESYS arguments.)
-before the error is signaled.
+If support for Mule exists in this Emacs, the file is decoded according
-The optional third and fourth arguments BEG and END
+to CODESYS; if omitted, no conversion happens.  If USED-CODESYS is non-nil,
-specify what portion of the file to insert.
+it should be a symbol, and the actual coding system that was used for the
-If VISIT is non-nil, BEG and END must be nil.
+decoding is stored into it.  It will in general be different from CODESYS
-If optional fifth argument REPLACE is non-nil,
+if CODESYS specifies automatic encoding detection or end-of-line detection.
-it means replace the current buffer contents (in the accessible portion)
-with the file contents.  This is better than simply deleting and inserting
+Currently BEG and END refer to byte positions (as opposed to character
-the whole thing because (1) it preserves some marker positions
+positions), even in Mule. (Fixing this is very difficult.)
-and (2) it puts less data in the undo list.
+*/
-*/
+(filename, visit, beg, end, replace, codesys, used_codesys))
-(filename, visit, beg, end, replace))
+{
-{
+/* This function can GC */
-/* This function can call lisp */
-/* #### dmoore - this function hasn't been checked for gc recently */
 struct stat st;
 int fd;
 int saverrno = 0;
 Charcount inserted = 0;
 int speccount;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 Lisp_Object handler = Qnil, val;
 int total;
 Bufbyte read_buf[READ_BUF_SIZE];
 int mc_count;
 struct buffer *buf = current_buffer;
-Lisp_Object curbuf;
 int not_regular = 0;
 if (buf->base_buffer && ! NILP (visit))
 error ("Cannot do file visiting in an indirect buffer");
 /* No need to call Fbarf_if_buffer_read_only() here.
 That's called in begin_multiple_change() or wherever. */
 val = Qnil;
-/* #### dmoore - should probably check in various places to see if
+GCPRO4 (filename, val, visit, handler);
-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));
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
 if (!NILP (handler))
 {
-val = call6 (handler, Qinsert_file_contents, filename,
+val = call8 (handler, Qinsert_file_contents, filename,
-		   visit, beg, end, replace);
+		   visit, beg, end, replace, codesys, used_codesys);
 goto handled;
 }
+#ifdef MULE
+if (!NILP (used_codesys))
+CHECK_SYMBOL (used_codesys);
+#endif
 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
 error ("Attempt to visit less than an entire file");
 if (!NILP (beg))
 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
 						     LSTR_ALLOW_QUIT);
 NGCPRO1 (stream);
 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
+#ifdef MULE
+stream = make_decoding_input_stream
+(XLSTREAM (stream), Fget_coding_system (codesys));
+Lstream_set_character_mode (XLSTREAM (stream));
+Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
+#endif
 record_unwind_protect (close_stream_unwind, stream);
 /* No need to limit the amount of stuff we attempt to read. (It would
 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
 						  !NILP (visit)
 						  ? INSDEL_NO_LOCKING : 0);
 	inserted  += cc_inserted;
 	cur_point += cc_inserted;
 }
+#ifdef MULE
+if (!NILP (used_codesys))
+{
+	Fset (used_codesys,
+	      XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
+}
+#endif
 NUNGCPRO;
 }
 #ifdef DOS_NT
 /* Determine file type from name and remove LFs from CR-LFs if the file
 Fset_buffer (buf);
 Fkill_buffer (tembuf);
 return Qnil;
 }
-DEFUN ("write-region-internal", Fwrite_region_internal, 3, 6,
+DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
 "r\nFWrite region to file: ", /*
-Write current region into specified file.
+Write current region into specified file; no coding-system frobbing.
-When called from a program, takes three arguments:
+This function is identical to `write-region' except for the handling
-START, END and FILENAME.  START and END are buffer positions.
+of the CODESYS argument under XEmacs/Mule. (When Mule support is not
-Optional fourth argument APPEND if non-nil means
+present, both functions are identical and ignore the CODESYS argument.)
-append to existing file contents (if any).
+If support for Mule exists in this Emacs, the file is encoded according
-Optional fifth argument VISIT if t means
+to the value of CODESYS.  If this is nil, no code conversion occurs.
-set the last-save-file-modtime of buffer to this file's modtime
+*/
-and mark buffer not modified.
+(start, end, filename, append, visit, lockname, codesys))
-If VISIT is a string, it is a second file name;
+{
-the output goes to FILENAME, but the buffer is marked as visiting VISIT.
+/* This function can GC */
-VISIT is also the file name to lock and unlock for clash detection.
-If VISIT is neither t nor nil nor a string,
-that means do not print the \"Wrote file\" message.
-Kludgy feature: if START is a string, then that string is written
-to the file, instead of any buffer contents, and END is ignored.
-*/
-(start, end, filename, append, visit, lockname))
-{
-/* This function can call lisp */
 int desc;
 int failure;
 int save_errno = 0;
 struct stat st;
 Lisp_Object fn;
 Lisp_Object visit_file = Qnil;
 Lisp_Object annotations = Qnil;
 struct buffer *given_buffer;
 Bufpos start1, end1;
-/* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
-we should signal an error rather than blissfully continuing
-along.  ARGH, this function is going to lose lose lose.  We need
-to protect the current_buffer from being destroyed, but the
-multiple return points make this a pain in the butt. */
 #ifdef DOS_NT
 int buffer_file_type
 = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
 #endif /* DOS_NT */
+#ifdef MULE
+codesys = Fget_coding_system (codesys);
+#endif /* MULE */
 if (current_buffer->base_buffer && ! NILP (visit))
 error ("Cannot do file visiting in an indirect buffer");
 if (!NILP (start) && !STRINGP (start))
 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
 {
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 GCPRO5 (start, filename, visit, visit_file, lockname);
 if (visiting_other)
 visit_file = Fexpand_file_name (visit, Qnil);
 else
 if (NILP (handler) && STRINGP (visit))
 handler = Ffind_file_name_handler (visit, Qwrite_region);
 if (!NILP (handler))
 {
-Lisp_Object val = call6 (handler, Qwrite_region, start, end,
+Lisp_Object val = call7 (handler, Qwrite_region, start, end,
-filename, append, visit);
+filename, append, visit, codesys);
 	if (visiting)
 	  {
 	    BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
 	    current_buffer->save_length =
 	      make_int (BUF_SIZE (current_buffer));
 }
 #ifdef CLASH_DETECTION
 if (!auto_saving)
 {
-Lisp_Object curbuf;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+GCPRO4 (start, filename, visit_file, lockname);
-XSETBUFFER (curbuf, current_buffer);
-GCPRO5 (start, filename, visit_file, lockname, curbuf);
 lock_file (lockname);
 UNGCPRO;
 }
 #endif /* CLASH_DETECTION */
 	/* if fn exists, truncate to zero length */
 	vms_truncate (fn_data);
 	desc = open (fn_data, O_RDWR, 0);
 	if (desc < 0)
 	  desc = creat_copy_attrs ((STRINGP (current_buffer->filename)
-				    ? (char *)
+				    ? (char *) XSTRING_DATA (current_buffer->filename)
-				    XSTRING_DATA (current_buffer->filename)
 				    : 0),
 				   fn_data);
 }
 else		/* Write to temporary name and rename if no errors */
 {
 for each request.  So I've increased the buffer size
 to 64K.) */
 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
 Lstream_set_buffering (XLSTREAM (outstream),
 			   LSTREAM_BLOCKN_BUFFERED, 65536);
+#ifdef MULE
+outstream =
+make_encoding_output_stream ( XLSTREAM (outstream), codesys);
+Lstream_set_buffering (XLSTREAM (outstream),
+			   LSTREAM_BLOCKN_BUFFERED, 65536);
+#endif
 if (STRINGP (start))
 {
 	instream = make_lisp_string_input_stream (start, 0, -1);
 	start1 = 0;
 }
 tem = Fcar_safe (Fcar (*annot));
 if (INTP (tem))
 	nextpos = XINT (tem);
 else
 	nextpos = INT_MAX;
+#ifdef MULE
+/* If there are annotations left and we have Mule, then we
+	 have to do the I/O one emchar at a time so we can
+	 determine when to insert the annotation. */
+if (!NILP (*annot))
+	{
+	  Emchar ch;
+	  while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
+	    {
+	      if (Lstream_put_emchar (outstr, ch) < 0)
+		return -1;
+	      pos++;
+	    }
+	}
+else
+#endif
 	{
 	  while (pos != nextpos)
 	    {
 	      /* Otherwise there is no point to that.  Just go in batches. */
 	      int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
 Return t if last mod time of BUF's visited file matches what BUF records.
 This means that the file has not been changed since it was visited or saved.
 */
 (buf))
 {
-/* This function can call lisp */
+/* This function can GC */
 struct buffer *b;
 struct stat st;
 Lisp_Object handler;
 CHECK_BUFFER (buf);
 (instead of that of the visited file), in the form of a list
 (HIGH . LOW) or (HIGH LOW).
 */
 (time_list))
 {
-/* This function can call lisp */
+/* This function can GC */
 if (!NILP (time_list))
 {
 time_t the_time;
 lisp_to_time (time_list, &the_time);
 current_buffer->modtime = (int) the_time;
 else
 {
 Lisp_Object filename;
 struct stat st;
 Lisp_Object handler;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
-GCPRO3 (filename, time_list, current_buffer->filename);
+GCPRO2 (filename, time_list);
-filename = Fexpand_file_name (current_buffer->filename, Qnil);
+filename = Fexpand_file_name (current_buffer->filename,
+				    Qnil);
 /* If the file name has special constructs in it,
 	 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
 UNGCPRO;
 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))
 {
-/* This function can call lisp */
+/* This function can GC */
 unsigned long time_to_use = 0;
 int set_time_to_use = 0;
 struct stat st;
 CHECK_BUFFER (buf);
 }
 if (!set_time_to_use)
 {
 Lisp_Object filename = Qnil;
-struct gcpro gcpro1;
+struct gcpro gcpro1, gcpro2;
-GCPRO1 (filename);
+GCPRO2 (buf, filename);
-/* #### dmoore - do we need to protect XBUFFER (buf)->filename?
-	 What if a ^(*&^&*^*& handler renames a buffer?  I think I'm
-	 getting a headache now. */
 if (STRINGP (XBUFFER (buf)->filename))
-filename = Fexpand_file_name (XBUFFER (buf)->filename, Qnil);
+filename = Fexpand_file_name (XBUFFER (buf)->filename,
+				      Qnil);
 else
 filename = Qnil;
+UNGCPRO;
 if (!NILP (filename) && !NILP (Ffile_exists_p (filename)))
 {
 	  Lisp_Object handler;
 	  /* If the file name has special constructs in it,
 	     call the corresponding file handler.  */
+	  GCPRO1 (filename);
 	  handler = Ffind_file_name_handler (filename, Qset_buffer_modtime);
 	  UNGCPRO;
 	  if (!NILP (handler))
 	    /* The handler can find the file name the same way we did. */
 	    return (call2 (handler, Qset_buffer_modtime, Qnil));
 	      else
 		time_to_use = time ((time_t *) 0);
 	    }
 }
 else
-	{
+	time_to_use = time ((time_t *) 0);
-	  UNGCPRO;
-	  time_to_use = time ((time_t *) 0);
-	}
 }
 XBUFFER (buf)->modtime = time_to_use;
 return Qnil;
 }
 static Lisp_Object
 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
 {
-/* This function can call lisp */
+/* This function can GC */
 if (gc_in_progress)
-return Qnil;
-/* Don't try printing an error message after everything is gone! */
-if (preparing_for_armageddon)
 return Qnil;
 clear_echo_area (selected_frame (), Qauto_saving, 1);
 Fding (Qt, Qauto_save_error, Qnil);
-message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
+message ("Auto-saving...error for %s",
+	   XSTRING_DATA (current_buffer->name));
 Fsleep_for (make_int (1));
-message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
+message ("Auto-saving...error!for %s",
+	   XSTRING_DATA (current_buffer->name));
 Fsleep_for (make_int (1));
-message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
+message ("Auto-saving...error for %s",
+	   XSTRING_DATA (current_buffer->name));
 Fsleep_for (make_int (1));
 return Qnil;
 }
 static Lisp_Object
 auto_save_1 (Lisp_Object ignored)
 {
-/* This function can call lisp */
+/* This function can GC */
-/* #### I think caller is protecting current_buffer? */
 struct stat st;
 Lisp_Object fn = current_buffer->filename;
 Lisp_Object a  = current_buffer->auto_save_file_name;
 if (!STRINGP (a))
 readable by owner only.  This may annoy some small number of
 people, but the alternative removes all privacy from email. */
 auto_save_mode_bits = 0600;
 return
-Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil);
+/* !!#### need to deal with this 'escape-quoted everywhere */
-}
+Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
+#ifdef MULE
-static Lisp_Object
+			    Qescape_quoted
-auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
+#else
-{
+			    Qnil
-/* #### this function should spew an error message about not being
+#endif
-able to open the .saves file. */
+			    );
-return Qnil;
-}
-static Lisp_Object
-auto_save_expand_name (Lisp_Object name)
-{
-struct gcpro gcpro1;
-/* note that caller did NOT gc protect name, so we do it. */
-/* #### dmoore - this might not be neccessary, if condition_case_1
-protects it.  but I don't think it does. */
-GCPRO1 (name);
-RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
 }
 static Lisp_Object
 do_auto_save_unwind (Lisp_Object fd)
 Non-nil first argument means do not print any message if successful.
 Non-nil second argument means save only current buffer.
 */
 (no_message, current_only))
 {
-/* This function can call lisp */
+/* This function can GC */
-struct buffer *b;
+struct buffer *old = current_buffer, *b;
 Lisp_Object tail, buf;
 int auto_saved = 0;
 int do_handled_files;
 Lisp_Object oquit = Qnil;
 Lisp_Object listfile = Qnil;
-Lisp_Object old;
 int listdesc = -1;
 int speccount = specpdl_depth ();
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
-XSETBUFFER (old, current_buffer);
+GCPRO2 (oquit, listfile);
-GCPRO3 (oquit, listfile, old);
 check_quit (); /* make Vquit_flag accurate */
 /* Ordinarily don't quit within this function,
 but don't make it impossible to quit (in case we get hung in I/O).  */
 oquit = Vquit_flag;
 Vquit_flag = Qnil;
 no_message = Qt;
 run_hook (Qauto_save_hook);
 if (GC_STRINGP (Vauto_save_list_file_name))
-listfile = condition_case_1 (Qt,
+listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
-				 auto_save_expand_name,
-				 Vauto_save_list_file_name,
-				 auto_save_expand_name_error, Qnil);
 /* Make sure auto_saving is reset. */
 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
 auto_saving = 1;
 		 We only do this now so that the file only exists
 		 if we actually auto-saved any files. */
 	      if (!auto_saved && GC_STRINGP (listfile) && listdesc < 0)
 		{
 #ifdef DOS_NT
 		  listdesc = open ((char *) XSTRING_DATA (listfile),
 				   O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
 				   S_IREAD | S_IWRITE);
 #else /* not DOS_NT */
 		  listdesc = creat ((char *) XSTRING_DATA (listfile), 0666);
 #endif /* not DOS_NT */
 		  write (listdesc, auto_save_file_name_ext,
 			 auto_save_file_name_ext_len);
 		  write (listdesc, "\n", 1);
 		}
-	      /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
+	      condition_case_1 (Qt,
-		 based on values in Vbuffer_alist.  auto_save_1 may
+				auto_save_1, Qnil,
-		 cause lisp handlers to run.  Those handlers may kill
+				auto_save_error, Qnil);
-		 the buffer and then GC.  Since the buffer is killed,
-		 it's no longer in Vbuffer_alist so it might get reaped
-		 by the GC.  We also need to protect tail. */
-	      /* #### There is probably a lot of other code which has
-		 pointers into buffers which may get blown away by
-		 handlers. */
-	      {
-		struct gcpro gcpro1, gcpro2;
-		GCPRO2 (buf, tail);
-		condition_case_1 (Qt,
-				  auto_save_1, Qnil,
-				  auto_save_error, Qnil);
-		UNGCPRO;
-	      }
-	      /* Handler killed our saved current-buffer!  Pick any. */
-	      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);
 	      b->save_length = make_int (BUF_SIZE (b));
+	      set_buffer_internal (old);
 	      EMACS_GET_TIME (after_time);
 	      /* If auto-save took more than 60 seconds,
 		 assume it was an NFS failure that got a timeout.  */
 	      if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
 		b->auto_save_failure_time = EMACS_SECS (after_time);

Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 70:131b0175ea99 r20-0b30