xemacs-beta: src/fileio.c comparison

comparison src/fileio.c @ 116:9f59509498e1 r20-1b10

Import from CVS: tag r20-1b10

author	cvs
date	Mon, 13 Aug 2007 09:23:06 +0200
parents	8619ce7e4c50
children	cca96a509cfe

comparison

equal deleted inserted replaced

-:f109f7dabbe2
+:9f59509498e1
 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 GC */
+/* This function can call lisp */
 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 GC */
+/* 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 GC */
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 Bufbyte *beg;
 Bufbyte *p;
 Lisp_Object handler;
 CHECK_STRING (file);
 this is everything after the last slash,
 or the entire name if it contains no slash.
 */
 (file))
 {
-/* This function can GC */
+/* This function can call lisp */
 Bufbyte *beg, *p, *end;
 Lisp_Object handler;
 CHECK_STRING (file);
 The `call-process' and `start-process' functions use this function to
 get a current directory to run processes in.
 */
 (filename))
 {
-/* This function can GC */
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 Bufbyte *nm;
 Bufbyte *newdir, *p, *o;
 int tlen;
 Bufbyte *target;
 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 (XSTRING_BYTE (defalt, 0))
-	    && IS_DEVICE_SEP (XSTRING_BYTE (defalt, 1))))
+		|| IS_DEVICE_SEP (XSTRING_BYTE (defalt, 1)))))
 {
 struct gcpro gcpro1;
 GCPRO1 (defalt);		/* may be current_buffer->directory */
 defalt = Fexpand_file_name (defalt, Qnil);
 No component of the resulting pathname will be a symbolic link, as
 in the realpath() function.
 */
 (filename, defalt))
 {
-/* This function can GC */
+/* This function can call lisp */
 struct gcpro gcpro1;
 Lisp_Object expanded_name;
 Lisp_Object handler;
 CHECK_STRING (filename);
 On VMS, `$' substitution is not done; this function does little and only
 duplicates what `expand-file-name' does.
 */
 (string))
 {
+/* This function can call lisp */
 Bufbyte *nm;
 Bufbyte *s, *p, *o, *x, *endp;
 Bufbyte *target = 0;
 int total = 0;
 /* (directory-file-name (expand-file-name FOO)) */
 Lisp_Object
 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
 {
-/* This function can GC */
+/* This function can call lisp */
 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);
 if (c == ':' || c == ']' || c == '>')
 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
+	{
-	  (Qyes_or_no_p,
+	  Lisp_Object prompt;
-	   (emacs_doprnt_string_c
+	  struct gcpro gcpro1;
+	  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)
 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))
 {
-/* This function can GC */
+/* This function can call lisp */
 int ifd, ofd, n;
 char buf[16 * 1024];
 struct stat st, out_st;
 Lisp_Object handler;
 int speccount = specpdl_depth ();
 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
 Create a directory.  One argument, a file name string.
 */
 (dirname))
 {
-/* This function can GC */
+/* This function can call lisp */
 char dir [MAXPATHLEN];
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (dirname);
 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 */
+/* This function can call lisp */
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (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 */
+/* This function can call lisp */
 Lisp_Object handler;
 struct gcpro gcpro1;
 CHECK_STRING (filename);
 filename = Fexpand_file_name (filename, Qnil);
 /* Delete file FILENAME, returning 1 if successful and 0 if failed.  */
 int
 internal_delete_file (Lisp_Object filename)
 {
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 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 */
+/* This function can call lisp */
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (filename, linkname);
 CHECK_STRING (filename);
 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 GC */
+/* This function can call lisp */
 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);
 For a directory, this means you can access files in that directory.
 */
 (filename))
 {
-/* This function can GC */
+/* This function can call lisp */
 Lisp_Object abspath;
 Lisp_Object handler;
 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_executable_p);
 Return t if file FILENAME exists and you can read it.
 See also `file-exists-p' and `file-attributes'.
 */
 (filename))
 {
-/* This function can GC */
+/* This function can call lisp */
 Lisp_Object abspath;
 Lisp_Object handler;
 int desc;
 struct gcpro gcpro1;
 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 GC */
+/* This function can call lisp */
 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);
 The value is the name of the file to which it is linked.
 Otherwise returns nil.
 */
 (filename))
 {
-/* This function can GC */
+/* This function can call lisp */
 #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 GC */
+/* This function can call lisp */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
 if the directory so specified exists and really is a readable and
 searchable directory.
 */
 (filename))
 {
-/* This function can GC */
+/* This function can call lisp */
 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);
-/* #### dmoore - this gcpro on filename should be unneccesary since
-the caller should ahve already protected it. */
-GCPRO1 (filename);
 if (NILP (Ffile_directory_p (filename)))
-{
-UNGCPRO;
 return (Qnil);
-}
+else
-handler = Ffile_executable_p (filename);
+return 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 */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
 Return mode bits of FILE, as an integer.
 */
 (filename))
 {
-/* This function can GC */
+/* This function can call lisp */
 Lisp_Object abspath;
 struct stat st;
 Lisp_Object handler;
 struct gcpro gcpro1;
 Set mode bits of FILE to MODE (an integer).
 Only the 12 low bits of MODE are used.
 */
 (filename, mode))
 {
-/* This function can GC */
+/* This function can call lisp */
 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);
-UNGCPRO;
 /* 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 GC */
+/* This function can call lisp */
 Lisp_Object abspath1, abspath2;
 struct stat st;
 int mtime1;
 Lisp_Object handler;
 struct gcpro gcpro1, gcpro2, gcpro3;
 Currently BEG and END refer to byte positions (as opposed to character
 positions), even in Mule. (Fixing this is very difficult.)
 */
 (filename, visit, beg, end, replace, codesys, used_codesys))
 {
-/* 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;
 If support for Mule exists in this Emacs, the file is encoded according
 to the value of CODESYS.  If this is nil, no code conversion occurs.
 */
 (start, end, filename, append, visit, lockname, codesys))
 {
-/* This function can GC */
+/* This function can call lisp */
 int desc;
 int failure;
 int save_errno = 0;
 struct stat st;
 Lisp_Object fn;
 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 GC */
+/* This function can call lisp */
 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 GC */
+/* This function can call lisp */
 if (!NILP (time_list))
 {
 time_t the_time;
 lisp_to_time (time_list, &the_time);
 current_buffer->modtime = (int) the_time;
 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 GC */
+/* This function can call lisp */
 unsigned long time_to_use = 0;
 int set_time_to_use = 0;
 struct stat st;
 CHECK_BUFFER (buf);
 static Lisp_Object
 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
 {
-/* This function can GC */
+/* This function can call lisp */
 if (gc_in_progress)
 return Qnil;
 /* Don't try printing an error message after everything is gone! */
 if (preparing_for_armageddon)
 return Qnil;
 }
 static Lisp_Object
 auto_save_1 (Lisp_Object ignored)
 {
-/* This function can GC */
+/* This function can call lisp */
+/* #### 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))
 			    Qnil
 #endif
 			    );
 }
+static Lisp_Object
+auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
+{
+/* #### this function should spew an error message about not being
+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)
 {
 close (XINT (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 GC */
+/* This function can call lisp */
 struct buffer *b;
 Lisp_Object tail, buf;
 int auto_saved = 0;
 int do_handled_files;
 Lisp_Object oquit = Qnil;
 no_message = Qt;
 run_hook (Qauto_save_hook);
 if (GC_STRINGP (Vauto_save_list_file_name))
-listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
+listfile = condition_case_1 (Qt,
+				 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;

Mercurial > hg > xemacs-beta

comparison src/fileio.c @ 116:9f59509498e1 r20-1b10