Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/src/fileio.c Mon Aug 13 09:21:56 2007 +0200 +++ b/src/fileio.c Mon Aug 13 09:23:06 2007 +0200 @@ -342,6 +342,7 @@ */ (filename, operation)) { + /* This function does not GC */ /* This function must not munge the match data. */ Lisp_Object chain, inhibited_handlers; @@ -376,7 +377,7 @@ 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); @@ -385,7 +386,7 @@ 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); @@ -396,7 +397,7 @@ 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); @@ -412,7 +413,7 @@ */ (file)) { - /* This function can GC */ + /* This function can call lisp */ Bufbyte *beg; Bufbyte *p; Lisp_Object handler; @@ -480,7 +481,7 @@ */ (file)) { - /* This function can GC */ + /* This function can call lisp */ Bufbyte *beg, *p, *end; Lisp_Object handler; @@ -516,7 +517,7 @@ */ (filename)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object handler; /* If the file name has special constructs in it, @@ -616,7 +617,7 @@ */ (file)) { - /* This function can GC */ + /* This function can call lisp */ char *buf; Lisp_Object handler; @@ -802,7 +803,7 @@ */ (directory)) { - /* This function can GC */ + /* This function can call lisp */ char *buf; Lisp_Object handler; @@ -870,7 +871,7 @@ */ (name, defalt)) { - /* This function can GC */ + /* This function can call lisp */ Bufbyte *nm; Bufbyte *newdir, *p, *o; @@ -940,11 +941,11 @@ 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_DEVICE_SEP (XSTRING_BYTE (defalt, 1)))) + && (IS_DIRECTORY_SEP (XSTRING_BYTE (defalt, 0)) + || IS_DEVICE_SEP (XSTRING_BYTE (defalt, 1))))) { struct gcpro gcpro1; @@ -1400,7 +1401,7 @@ */ (filename, defalt)) { - /* This function can GC */ + /* This function can call lisp */ struct gcpro gcpro1; Lisp_Object expanded_name; Lisp_Object handler; @@ -1527,6 +1528,7 @@ */ (string)) { + /* This function can call lisp */ Bufbyte *nm; Bufbyte *s, *p, *o, *x, *endp; @@ -1737,12 +1739,12 @@ 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 = @@ -1775,6 +1777,7 @@ 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, @@ -1782,19 +1785,24 @@ if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0) { Lisp_Object tem; - struct gcpro gcpro1; - - GCPRO1 (absname); + if (interactive) - tem = call1 - (Qyes_or_no_p, - (emacs_doprnt_string_c + { + Lisp_Object prompt; + 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"), @@ -1823,7 +1831,7 @@ */ (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; @@ -1989,7 +1997,7 @@ */ (dirname)) { - /* This function can GC */ + /* This function can call lisp */ char dir [MAXPATHLEN]; Lisp_Object handler; struct gcpro gcpro1; @@ -2033,7 +2041,7 @@ */ (dirname)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object handler; struct gcpro gcpro1; @@ -2060,7 +2068,7 @@ */ (filename)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object handler; struct gcpro gcpro1; @@ -2089,6 +2097,7 @@ 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)); } @@ -2104,7 +2113,7 @@ */ (filename, newname, ok_if_already_exists)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object handler; struct gcpro gcpro1, gcpro2; @@ -2197,7 +2206,7 @@ */ (filename, newname, ok_if_already_exists)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object handler; struct gcpro gcpro1, gcpro2; @@ -2254,7 +2263,7 @@ */ (filename, linkname, ok_if_already_exists)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object handler; struct gcpro gcpro1, gcpro2; @@ -2362,6 +2371,7 @@ */ (filename)) { + /* This function does not GC */ Bufbyte *ptr; CHECK_STRING (filename); @@ -2441,16 +2451,14 @@ */ (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. */ @@ -2473,15 +2481,13 @@ (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. */ @@ -2501,7 +2507,7 @@ */ (filename)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object abspath; Lisp_Object handler; int desc; @@ -2534,16 +2540,14 @@ */ (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. */ @@ -2581,7 +2585,7 @@ */ (filename)) { - /* This function can GC */ + /* This function can call lisp */ #ifdef S_IFLNK char *buf; int bufsize; @@ -2590,14 +2594,14 @@ 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); @@ -2633,7 +2637,7 @@ */ (filename)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object abspath; struct stat st; Lisp_Object handler; @@ -2667,9 +2671,8 @@ */ (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. */ @@ -2678,17 +2681,10 @@ 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); - } - handler = Ffile_executable_p (filename); - UNGCPRO; - return (handler); + else + return Ffile_executable_p (filename); } DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* @@ -2697,6 +2693,7 @@ */ (filename)) { + /* This function can call lisp */ Lisp_Object abspath; struct stat st; Lisp_Object handler; @@ -2724,7 +2721,7 @@ */ (filename)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object abspath; struct stat st; Lisp_Object handler; @@ -2759,15 +2756,16 @@ */ (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. */ @@ -2836,7 +2834,7 @@ */ (file1, file2)) { - /* This function can GC */ + /* This function can call lisp */ Lisp_Object abspath1, abspath2; struct stat st; int mtime1; @@ -2902,7 +2900,8 @@ */ (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; @@ -3364,7 +3363,7 @@ */ (start, end, filename, append, visit, lockname, codesys)) { - /* This function can GC */ + /* This function can call lisp */ int desc; int failure; int save_errno = 0; @@ -4017,7 +4016,7 @@ */ (buf)) { - /* This function can GC */ + /* This function can call lisp */ struct buffer *b; struct stat st; Lisp_Object handler; @@ -4083,7 +4082,7 @@ */ (time_list)) { - /* This function can GC */ + /* This function can call lisp */ if (!NILP (time_list)) { time_t the_time; @@ -4122,7 +4121,7 @@ */ (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; @@ -4196,7 +4195,7 @@ 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! */ @@ -4216,7 +4215,8 @@ 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; @@ -4246,6 +4246,26 @@ ); } +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) @@ -4283,7 +4303,7 @@ */ (no_message, current_only)) { - /* This function can GC */ + /* This function can call lisp */ struct buffer *b; Lisp_Object tail, buf; int auto_saved = 0; @@ -4312,7 +4332,10 @@ 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));