xemacs-beta: src/fileio.c comparison

comparison src/fileio.c @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13

author	cvs
date	Mon, 13 Aug 2007 09:49:09 +0200
parents	15872534500d
children	e121b013d1f0

comparison

equal deleted inserted replaced

-:a38aed19690b
+:8eaf7971accc
 static Lisp_Object
 restore_point_unwind (Lisp_Object point_marker)
 {
 BUF_SET_PT (current_buffer, marker_position (point_marker));
-return (Fset_marker (point_marker, Qnil, Qnil));
+return Fset_marker (point_marker, Qnil, Qnil);
 }
 /* Versions of read() and write() that allow quitting out of the actual
 I/O.  We don't use immediate_quit (i.e. direct longjmp() out of the
 signal handler) because that's way too losing.
 	  if (STRINGP (string)
 	      && (fast_lisp_string_match (string, filename) >= 0))
 	    {
 	      Lisp_Object handler = XCDR (elt);
 	      if (NILP (Fmemq (handler, inhibited_handlers)))
-		return (handler);
+		return handler;
 	    }
 	}
 QUIT;
 }
 return Qnil;
 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
 {
 /* This function can call lisp */
 Lisp_Object result = call2 (fn, arg0, arg1);
 CHECK_STRING (result);
-return (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);
+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);
-return (result);
+return result;
 }
 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
 Return the directory component in file name NAME.
 /* 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,
+return call2_check_string_or_nil (handler, Qfile_name_directory, file);
-				       file));
 #ifdef FILE_SYSTEM_CASE
 file = FILE_SYSTEM_CASE (file);
 #endif
 beg = XSTRING_DATA (file);
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
 if (!NILP (handler))
-return (call2_check_string (handler, Qfile_name_nondirectory,
+return call2_check_string (handler, Qfile_name_nondirectory, file);
-				file));
 beg = XSTRING_DATA (file);
 end = p = beg + XSTRING_LENGTH (file);
 while (p != beg && !IS_ANY_SEP (p[-1])
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
 if (!NILP (handler))
-return (call2_check_string (handler, Qfile_name_as_directory,
+return call2_check_string (handler, Qfile_name_as_directory, file);
-				file));
 buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
 return build_string (file_name_as_directory
 		       (buf, (char *) XSTRING_DATA (file)));
 }
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
 if (!NILP (handler))
-return (call2_check_string (handler, Qdirectory_file_name,
+return call2_check_string (handler, Qdirectory_file_name, directory);
-				directory));
 #ifdef VMS
 /* 20 extra chars is insufficient for VMS, since we might perform a
 logical name translation. an equivalence string can be up to 255
 chars long, so grab that much extra space...  - sss */
 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20 + 255);
 paths in the file system.
 An initial `~/' expands to your home directory.
 An initial `~USER/' expands to USER's home directory.
 See also the function `substitute-in-file-name'.
 */
-(name, defalt))
+(name, default_))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Bufbyte *nm;
 Bufbyte *newdir, *p, *o;
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (name, Qexpand_file_name);
 if (!NILP (handler))
-return (call3_check_string (handler, Qexpand_file_name, name,
+return call3_check_string (handler, Qexpand_file_name, name, default_);
-				defalt));
+/* Use the buffer's default-directory if DEFAULT_ is omitted.  */
-/* Use the buffer's default-directory if DEFALT is omitted.  */
+if (NILP (default_))
-if (NILP (defalt))
+default_ = current_buffer->directory;
-defalt = current_buffer->directory;
+if (NILP (default_))		/* this should be a meaningful error */
-if (NILP (defalt))		/* this should be a meaningful error */
 {
 /* #### If we had a minibuffer-only frame up then current_buffer
 	 is likely to not have a directory setting.  We should
 	 probably redo things to make sure that current_buffer stays
 	 set to something sensible. */
 if (!preparing_for_armageddon)
 	signal_simple_error ("default-directory is not set",
 			     make_buffer (current_buffer));
 }
 else
-CHECK_STRING (defalt);
+CHECK_STRING (default_);
-if (!NILP (defalt))
+if (!NILP (default_))
 {
 struct gcpro gcpro1;
-GCPRO1 (defalt);		/* might be current_buffer->directory */
+GCPRO1 (default_);	/* might be current_buffer->directory */
-handler = Ffind_file_name_handler (defalt, Qexpand_file_name);
+handler = Ffind_file_name_handler (default_, Qexpand_file_name);
 UNGCPRO;
 if (!NILP (handler))
-	return call3 (handler, Qexpand_file_name, name, defalt);
+	return call3 (handler, Qexpand_file_name, name, default_);
 }
-/* Make sure DEFALT is properly expanded.
+/* Make sure DEFAULT_ is properly expanded.
 It would be better to do this down below where we actually use
-defalt.  Unfortunately, calling Fexpand_file_name recursively
+default_.  Unfortunately, calling Fexpand_file_name recursively
 could invoke GC, and the strings might be relocated.  This would
 be annoying because we have pointers into strings lying around
 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(default_) && !EQ (default_, name)
 /* This saves time in a common case.  */
-&& ! (XSTRING_LENGTH (defalt) >= 3
+&& ! (XSTRING_LENGTH (default_) >= 3
-	    && (IS_DIRECTORY_SEP (XSTRING_BYTE (defalt, 0))
+	    && (IS_DIRECTORY_SEP (XSTRING_BYTE (default_, 0))
-		|| IS_DEVICE_SEP (XSTRING_BYTE (defalt, 1)))))
+		|| IS_DEVICE_SEP (XSTRING_BYTE (default_, 1)))))
 {
 struct gcpro gcpro1;
-GCPRO1 (defalt);		/* may be current_buffer->directory */
+GCPRO1 (default_);	/* may be current_buffer->directory */
-defalt = Fexpand_file_name (defalt, Qnil);
+default_ = Fexpand_file_name (default_, Qnil);
 UNGCPRO;
 }
 #ifdef VMS
 /* Filenames on VMS are always upper case.  */
 #endif /* not VMS */
 #ifdef DOS_NT
 && drive == -1
 #endif /* DOS_NT */
 && !newdir
-&& STRINGP (defalt))
+&& STRINGP (default_))
 {
-newdir = XSTRING_DATA (defalt);
+newdir = XSTRING_DATA (default_);
 }
 #ifdef DOS_NT
 if (newdir == 0 && relpath)
 newdir = defdir;
 (does not start with slash); if DEFAULT is nil or missing,
 the current buffer's value of default-directory is used.
 No component of the resulting pathname will be a symbolic link, as
 in the realpath() function.
 */
-(filename, defalt))
+(filename, default_))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Lisp_Object expanded_name;
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
-expanded_name = Fexpand_file_name (filename, defalt);
+expanded_name = Fexpand_file_name (filename, default_);
 if (!STRINGP (expanded_name))
 return Qnil;
 GCPRO1 (expanded_name);
 handler = Ffind_file_name_handler (expanded_name, Qfile_truename);
 UNGCPRO;
 if (!NILP (handler))
-return (call2_check_string (handler, Qfile_truename,
+return call2_check_string (handler, Qfile_truename, expanded_name);
-				expanded_name));
 #ifdef VMS
-return (expanded_name);
+return expanded_name;
 #else
 {
 char resolved_path[MAXPATHLEN];
 char path[MAXPATHLEN];
 char *p = path;
 /* 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,
+return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
-				       string));
+				      string);
 nm = XSTRING_DATA (string);
 #ifdef MSDOS
 dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
 substituted = !strcmp (nm, XSTRING_DATA (string));
 }
 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
 Create a directory.  One argument, a file name string.
 */
-(dirname))
+(dirname_))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 char dir [MAXPATHLEN];
 Lisp_Object handler;
 struct gcpro gcpro1;
-CHECK_STRING (dirname);
+CHECK_STRING (dirname_);
-dirname = Fexpand_file_name (dirname, Qnil);
+dirname_ = Fexpand_file_name (dirname_, Qnil);
-GCPRO1 (dirname);
+GCPRO1 (dirname_);
-handler = Ffind_file_name_handler (dirname, Qmake_directory_internal);
+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))
+if (XSTRING_LENGTH (dirname_) > (sizeof (dir) - 1))
 {
 return Fsignal (Qfile_error,
 		      list3 (build_translated_string ("Creating directory"),
 			     build_translated_string ("pathame too long"),
-			     dirname));
+			     dirname_));
 }
-strncpy (dir, (char *) XSTRING_DATA (dirname),
+strncpy (dir, (char *) XSTRING_DATA (dirname_),
-	   XSTRING_LENGTH (dirname) + 1);
+	   XSTRING_LENGTH (dirname_) + 1);
 #ifndef VMS
-if (dir [XSTRING_LENGTH (dirname) - 1] == '/')
+if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
-dir [XSTRING_LENGTH (dirname) - 1] = 0;
+dir [XSTRING_LENGTH (dirname_) - 1] = 0;
 #endif
 #ifdef WINDOWSNT
 if (mkdir (dir) != 0)
 #else
 if (mkdir (dir, 0777) != 0)
 #endif
-report_file_error ("Creating directory", list1 (dirname));
+report_file_error ("Creating directory", list1 (dirname_));
 return Qnil;
 }
 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
 Delete a directory.  One argument, a file name or directory name string.
 */
-(dirname))
+(dirname_))
 {
 /* This function can GC.  GC checked 1997.04.06. */
 Lisp_Object handler;
 struct gcpro gcpro1;
-CHECK_STRING (dirname);
+CHECK_STRING (dirname_);
-GCPRO1 (dirname);
+GCPRO1 (dirname_);
-dirname = Fexpand_file_name (dirname, Qnil);
+dirname_ = Fexpand_file_name (dirname_, Qnil);
-dirname = Fdirectory_file_name (dirname);
+dirname_ = Fdirectory_file_name (dirname_);
-handler = Ffind_file_name_handler (dirname, Qdelete_directory);
+handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
 UNGCPRO;
 if (!NILP (handler))
-return (call2 (handler, Qdelete_directory, dirname));
+return (call2 (handler, Qdelete_directory, dirname_));
-if (rmdir ((char *) XSTRING_DATA (dirname)) != 0)
+if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
-report_file_error ("Removing directory", list1 (dirname));
+report_file_error ("Removing directory", list1 (dirname_));
 return Qnil;
 }
 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
 #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;
-if (!NILP (end))
-CHECK_INT (end);
 fd = -1;
 #ifndef APOLLO
 if (stat ((char *) XSTRING_DATA (filename), &st) < 0)
 #else /* APOLLO */
 /* This code will need to be changed in order to work on named
 pipes, and it's probably just not worth it.  So we should at
 least signal an error.  */
 if (!S_ISREG (st.st_mode))
 {
-if (NILP (visit))
+not_regular = 1;
+if (!NILP (visit))
+	goto notfound;
+if (!NILP (replace) || !NILP (beg) || !NILP (end))
 	{
 	  end_multiple_change (buf, mc_count);
 	  return Fsignal (Qfile_error,
 			  list2 (build_translated_string("not a regular file"),
 				 filename));
 	}
-else
-	{
-	  not_regular = 1;
-	  goto notfound;
-	}
 }
 #endif
+if (!NILP (beg))
+CHECK_INT (beg);
+else
+beg = Qzero;
+if (!NILP (end))
+CHECK_INT (end);
 if (fd < 0)
 if ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY, 0)) < 0)
 goto badopen;
 if (st.st_size < 0)
 error ("File size is negative");
 if (NILP (end))
 {
-end = make_int (st.st_size);
+if (!not_regular)
-if (XINT (end) != st.st_size)
+	{
-	error ("maximum buffer size exceeded");
+	  end = make_int (st.st_size);
+	  if (XINT (end) != st.st_size)
+	    error ("Maximum buffer size exceeded");
+	}
 }
 /* If requested, replace the accessible part of the buffer
 with the file contents.  Avoid replacing text at the
 beginning or end of the buffer that matches the file contents;
 /* Insert from the file at the proper position.  */
 BUF_SET_PT (buf, same_at_start);
 }
 #endif /* FSFMACS_SPEEDY_INSERT */
-total = XINT (end) - XINT (beg);
+if (!not_regular)
+{
+Lisp_Object temp;
+total = XINT (end) - XINT (beg);
+/* Make sure point-max won't overflow after this insertion.  */
+XSETINT (temp, total);
+if (total != XINT (temp))
+	error ("Maximum buffer size exceeded");
+}
+else
+/* For a special file, all we can do is guess.  */
+total = READ_BUF_SIZE;
 if (XINT (beg) != 0
 #ifdef FSFMACS_SPEEDY_INSERT
 /* why was this here? asked jwz.  The reason is that the replace-mode
 	 connivings above will normally put the file pointer other than

Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 173:8eaf7971accc r20-3b13