xemacs-beta: src/fileio.c comparison

comparison src/fileio.c @ 371:cc15677e0335 r21-2b1

Import from CVS: tag r21-2b1

author	cvs
date	Mon, 13 Aug 2007 11:03:08 +0200
parents	a4f53d9b3154
children	6240c7796c7a

comparison

equal deleted inserted replaced

-:bd866891f083
+:cc15677e0335
 {
 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
 Bufbyte *res = alloca (MAXPATHLEN + 1);
 if (getdefdir (toupper (*beg) - 'A' + 1, res))
 	{
-	  char *c=((char *) res) + strlen ((char *) res);
+	  if (!IS_DIRECTORY_SEP (res[strlen ((char *) res) - 1]))
-	  if (!IS_DIRECTORY_SEP (*c))
+	    strcat ((char *) res, "/");
-	    {
-	      *c++ = DIRECTORY_SEP;
-	      *c = '\0';
-	    }
 	  beg = res;
 	  p = beg + strlen ((char *) beg);
 	}
 }
+CORRECT_DIR_SEPS (beg);
 #endif /* WINDOWSNT */
 return make_string (beg, p - beg);
 }
 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
 	{
 	  out[size] = DIRECTORY_SEP;
 	  out[size + 1] = '\0';
 	}
 }
+#ifdef WINDOWSNT
+CORRECT_DIR_SEPS (out);
+#endif
 return out;
 }
 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
 Return a string representing file FILENAME interpreted as a directory.
 && !IS_ANY_SEP (dst[slen - 2])
 #endif /* WINDOWSNT */
 )
 dst[slen - 1] = 0;
 #endif /* APOLLO */
+#ifdef WINDOWSNT
+CORRECT_DIR_SEPS (dst);
+#endif /* WINDOWSNT */
 return 1;
 }
 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
 Return the file name of the directory named DIR.
 An initial `~USER/' expands to USER's home directory.
 See also the function `substitute-in-file-name'.
 */
 (name, default_directory))
 {
-/* This function can GC.  GC-checked 7-11-00 ben */
+/* This function can GC */
 Bufbyte *nm;
 Bufbyte *newdir, *p, *o;
 int tlen;
 Bufbyte *target;
 int length;
 Lisp_Object handler;
 #ifdef __CYGWIN32__
 char *user;
 #endif
-struct gcpro gcpro1, gcpro2;
-/* both of these get set below */
-GCPRO2 (name, default_directory);
 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);
 if (!NILP (handler))
-{
+return call3_check_string (handler, Qexpand_file_name, name,
-UNGCPRO;
+			       default_directory);
-return call3_check_string (handler, Qexpand_file_name, name,
-				 default_directory);
-}
 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted.  */
 if (NILP (default_directory))
 default_directory = current_buffer->directory;
 if (! STRINGP (default_directory))
 if (!NILP (default_directory))
 {
 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
 if (!NILP (handler))
-	{
+	return call3 (handler, Qexpand_file_name, name, default_directory);
-	  UNGCPRO;
-	  return call3 (handler, Qexpand_file_name, name, default_directory);
-	}
 }
 o = XSTRING_DATA (default_directory);
 /* Make sure DEFAULT_DIRECTORY is properly expanded.
 /* Detect Unix absolute file names (/... alone is not absolute on
 	 DOS or Windows).  */
 && ! (IS_DIRECTORY_SEP (o[0]))
 #endif /* not WINDOWSNT */
 )
+{
-default_directory = Fexpand_file_name (default_directory, Qnil);
+struct gcpro gcpro1;
+GCPRO1 (name);
+default_directory = Fexpand_file_name (default_directory, Qnil);
+UNGCPRO;
+}
 #ifdef FILE_SYSTEM_CASE
 name = FILE_SYSTEM_CASE (name);
 #endif
 	    {
 	      name = make_string (nm - 2, p - nm + 2);
 	      XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
 	      XSTRING_DATA (name)[1] = ':';
 	    }
-	  RETURN_UNGCPRO (name);
+	  return name;
 #else /* not WINDOWSNT */
 	  if (nm == XSTRING_DATA (name))
-	    RETURN_UNGCPRO (name);
+	    return name;
-	  RETURN_UNGCPRO (build_string ((char *) nm));
+	  return build_string ((char *) nm);
 #endif /* not WINDOWSNT */
 	}
 }
 /* At this point, nm might or might not be an absolute file name.  We
 abort ();
 }
 CORRECT_DIR_SEPS (target);
 #endif /* WINDOWSNT */
-RETURN_UNGCPRO (make_string (target, o - target));
+return make_string (target, o - target);
 }
 #if 0 /* FSFmacs */
 /* another older version of expand-file-name; */
 #endif
 if (!NILP (handler))
 return call2_check_string (handler, Qfile_truename, expanded_name);
 {
 char resolved_path[MAXPATHLEN];
-char *path;
+char path[MAXPATHLEN];
-char *p;
+char *p = path;
 int elen = XSTRING_LENGTH (expanded_name);
-GET_STRING_FILENAME_DATA_ALLOCA(expanded_name,path,elen);
+if (elen >= countof (path))
-p = path;
-if (elen > MAXPATHLEN)
 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?
+/* !!#### Does realpath() Mule-encapsulate? */
-Answer: Nope! So we do it above */
 if (!xrealpath (path, resolved_path))
 {
 	/* Didn't resolve it -- have to do it one component at a time. */
 	/* "realpath" is a typically useless, stupid un*x piece of crap.
 	   It claims to return a useful value in the "error" case, but since
 	    goto toolong;
 	  resolved_path[rlen] = '/';
 	  resolved_path[rlen + 1] = 0;
 	  rlen = rlen + 1;
 	}
-return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_FILENAME);
+return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY);
 }
 toolong:
 errno = ENAMETOOLONG;
 goto lose;
 				  INTP (ok_if_already_exists), 0);
 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
 on NT here. --marcpa */
 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
-Reverted to previous behavior pending a working fix. (jhar) */
+Reverted to previous behaviour pending a working fix. (jhar) */
 #if defined(WINDOWSNT)
 /* Windows does not support this operation.  */
 report_file_error ("Adding new name", Flist (2, &filename));
 #else /* not defined(WINDOWSNT) */
 UNGCPRO;
 return Qnil;
 }
+#ifdef S_IFLNK
 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
 Make a symbolic link to FILENAME, named LINKNAME.  Both args strings.
 Signals a `file-already-exists' error if a file LINKNAME already exists
 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
 This happens for interactive use with M-x.
 */
 (filename, linkname, ok_if_already_exists))
 {
 /* This function can GC.  GC checked 1997.06.04. */
-/* XEmacs change: run handlers even if local machine doesn't have symlinks */
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (filename, linkname);
 CHECK_STRING (filename);
 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
 if (!NILP (handler))
 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
 			   linkname, ok_if_already_exists));
-#ifdef S_IFLNK
 if (NILP (ok_if_already_exists)
 || INTP (ok_if_already_exists))
 barf_or_query_if_file_exists (linkname, "make it a link",
 				  INTP (ok_if_already_exists), 0);
 		   (char *) XSTRING_DATA (linkname)))
 {
 report_file_error ("Making symbolic link",
 			 list2 (filename, linkname));
 }
-#endif /* S_IFLNK */
 UNGCPRO;
 return Qnil;
 }
+#endif /* S_IFLNK */
 #ifdef HPUX_NET
 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
 Open a network connection to PATH using LOGIN as the login string.
 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; GC checked 7-11-00 ben */
+/* This function can call lisp */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct stat statbuf;
 struct gcpro gcpro1;
 For a directory, this means you can access files in that directory.
 */
 (filename))
 {
-/* This function can GC.  GC checked 07-11-2000 ben. */
+/* This function can GC.  GC checked 1997.04.10. */
 Lisp_Object abspath;
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
 if (!NILP (handler))
 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
-#if defined(WINDOWSNT) || defined(__CYGWIN32__)
+#ifdef WINDOWSNT
 /* Under MS-DOS and Windows, open does not work for directories.  */
 UNGCPRO;
 if (access (XSTRING_DATA (abspath), 0) == 0)
 return Qt;
 else
 Otherwise returns nil.
 */
 (filename))
 {
 /* This function can GC.  GC checked 1997.04.10. */
-/* XEmacs change: run handlers even if local machine doesn't have symlinks */
 #ifdef S_IFLNK
 char *buf;
 int bufsize;
 int valsize;
 Lisp_Object val;
-#endif
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
 UNGCPRO;
 if (!NILP (handler))
 return call2 (handler, Qfile_symlink_p, filename);
-#ifdef S_IFLNK
 bufsize = 100;
 while (1)
 {
 buf = xnew_array_and_zero (char, bufsize);
 valsize = readlink ((char *) XSTRING_DATA (filename),
 if (!NILP (replace) || !NILP (beg) || !NILP (end))
 	{
 	  end_multiple_change (buf, mc_count);
-	  RETURN_UNGCPRO (Fsignal (Qfile_error,
+	  return Fsignal (Qfile_error,
-				   list2 (build_translated_string("not a regular file"),
+			  list2 (build_translated_string("not a regular file"),
-					  filename)));
+				 filename));
 	}
 }
 #endif /* S_IFREG */
 if (!NILP (beg))
 /* This function can call lisp */
 int desc;
 int failure;
 int save_errno = 0;
 struct stat st;
-Lisp_Object fn = Qnil;
+Lisp_Object fn;
 int speccount = specpdl_depth ();
 int visiting_other = STRINGP (visit);
 int visiting = (EQ (visit, Qt) || visiting_other);
 int quietly = (!visiting && !NILP (visit));
 Lisp_Object visit_file = Qnil;
 Lisp_Object annotations = Qnil;
 struct buffer *given_buffer;
 Bufpos start1, end1;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-struct gcpro ngcpro1, ngcpro2;
+/* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
-Lisp_Object curbuf;
-XSETBUFFER (curbuf, current_buffer);
-/* start, end, visit, and append are never modified in this fun
-so we don't protect them. */
-GCPRO5 (visit_file, filename, codesys, lockname, annotations);
-NGCPRO2 (curbuf, fn);
-/* [[ 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. ]] we do
+multiple return points make this a pain in the butt. */
-protect curbuf now. --ben */
 #ifdef FILE_CODING
 codesys = Fget_coding_system (codesys);
 #endif /* FILE_CODING */
 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
 visit_file = filename;
 filename = Fexpand_file_name (filename, Qnil);
+UNGCPRO;
 if (NILP (lockname))
 lockname = visit_file;
-/* We used to UNGCPRO here.  BAD!  visit_file is used below after
-more Lisp calling. */
 /* If the file name has special constructs in it,
 call the corresponding file handler.  */
 handler = Ffind_file_name_handler (filename, Qwrite_region);
 /* If FILENAME has no handler, see if VISIT has one.  */
 if (NILP (handler) && STRINGP (visit))
 	    BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
 	    current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
 	    current_buffer->filename = visit_file;
 	    MARK_MODELINE_CHANGED;
 	  }
-	NUNGCPRO;
-	UNGCPRO;
 	return val;
 }
 }
 #ifdef CLASH_DETECTION
 if (!auto_saving)
-lock_file (lockname);
+{
+Lisp_Object curbuf;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+XSETBUFFER (curbuf, current_buffer);
+GCPRO5 (start, filename, visit_file, lockname, curbuf);
+lock_file (lockname);
+UNGCPRO;
+}
 #endif /* CLASH_DETECTION */
 /* Special kludge to simplify auto-saving.  */
 if (NILP (start))
 {
 }
 {
 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
 Lisp_Object instream = Qnil, outstream = Qnil;
-struct gcpro nngcpro1, nngcpro2;
+struct gcpro gcpro1, gcpro2;
 /* need to gcpro; QUIT could happen out of call to write() */
-NNGCPRO2 (instream, outstream);
+GCPRO2 (instream, outstream);
 record_unwind_protect (close_file_unwind, desc_locative);
 if (!NILP (append))
 {
 {
 	failure = 1;
 	save_errno = errno;
 }
 Lstream_close (XLSTREAM (instream));
+UNGCPRO;
 #ifdef HAVE_FSYNC
 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
 Disk full in NFS may be reported here.  */
 /* mib says that closing the file will try to write as fast as NFS can do
 	failure = 1;
 	save_errno = errno;
 }
 #endif /* HAVE_FSYNC */
-/*
+/* Spurious "file has changed on disk" warnings have been
-* On VMS and APOLLO, must do the stat after the close
+observed on Suns as well.
-* since closing changes the modtime.
+It seems that `close' can change the modtime, under nfs.
-*
-* Spurious "file has changed on disk" warnings have been
+(This has supposedly been fixed in Sunos 4,
-* observed on Suns as well.  It seems that `close' can change
+but who knows about all the other machines with NFS?)  */
-* the modtime, under nfs.  (This has supposedly been fixed in
+/* On VMS and APOLLO, must do the stat after the close
-* Sunos 4, but who knows about all the other machines with
+since closing changes the modtime.  */
-* NFS?)
+/* As it does on Windows too - kkm */
-*
+#if !defined (WINDOWSNT) /* !defined (VMS) && !defined (APOLLO) */
-* This is reported to happen under Windows also.
+fstat (desc, &st);
-*
+#endif
-* So we don't do the stat here.  It is done after the
-* descriptor is closed.
-*/
 /* NFS can report a write failure now.  */
 if (close (desc) < 0)
 {
 	failure = 1;
 /* Discard the close unwind-protect.  Execute the one for
 build_annotations (switches back to the original current buffer
 as necessary). */
 XCAR (desc_locative) = Qnil;
 unbind_to (speccount, Qnil);
-NNUNGCPRO;
 }
-/*
+#if defined (WINDOWSNT) /* defined (VMS) || defined (APOLLO) */
-* stat the file after the file is closed to avoid having the
-* modtime change on us when the file is closed.
-*/
 stat ((char *) XSTRING_DATA (fn), &st);
+#endif
 #ifdef CLASH_DETECTION
 if (!auto_saving)
 unlock_file (lockname);
 #endif /* CLASH_DETECTION */
 current_buffer->filename = visit_file;
 MARK_MODELINE_CHANGED;
 }
 else if (quietly)
 {
-NUNGCPRO;
-UNGCPRO;
 return Qnil;
 }
 if (!auto_saving)
 {
 if (visiting_other)
 message ("Wrote %s", XSTRING_DATA (visit_file));
 else
 	{
-	  Lisp_Object fsp = Qnil;
+	  struct gcpro gcpro1;
-	  struct gcpro nngcpro1;
+	  Lisp_Object fsp;
+	  GCPRO1 (fn);
-	  NNGCPRO1 (fsp);
 	  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));
-	  NNUNGCPRO;
+	  UNGCPRO;
 	}
 }
-NUNGCPRO;
-UNGCPRO;
 return Qnil;
 }
 /* #### This is such a load of shit!!!!  There is no way we should define
 something so stupid as a subr, just sort the fucking list more
 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; GC checked 7-11-00 ben */
+/* This function can call lisp */
 struct buffer *b;
 struct stat st;
 Lisp_Object handler;
 CHECK_BUFFER (buf);
 lisp_to_time (time_list, &the_time);
 current_buffer->modtime = (int) the_time;
 }
 else
 {
-Lisp_Object filename = Qnil;
+Lisp_Object filename;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2, gcpro3;
 GCPRO3 (filename, time_list, current_buffer->filename);
 DEFSUBR (Fmake_directory_internal);
 DEFSUBR (Fdelete_directory);
 DEFSUBR (Fdelete_file);
 DEFSUBR (Frename_file);
 DEFSUBR (Fadd_name_to_file);
+#ifdef S_IFLNK
 DEFSUBR (Fmake_symbolic_link);
+#endif /* S_IFLNK */
 #ifdef HPUX_NET
 DEFSUBR (Fsysnetunam);
 #endif /* HPUX_NET */
 DEFSUBR (Ffile_name_absolute_p);
 DEFSUBR (Ffile_exists_p);
 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
 This variable affects the built-in functions only on Windows,
 on other platforms, it is initialized so that Lisp code can find out
 what the normal separator is.
 */ );
-#ifdef WINDOWSNT
-Vdirectory_sep_char = make_char ('\\');
-#else
 Vdirectory_sep_char = make_char ('/');
-#endif
+}
-}

Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 371:cc15677e0335 r21-2b1