Add optional arg to delete-file to force deletion (Bug#6070).

* eval.c (internal_condition_case_n): Rename from
internal_condition_case_2.
(internal_condition_case_2): New function.

* xdisp.c (safe_call): Use internal_condition_case_n.

* fileio.c (Fdelete_file, internal_delete_file): New arg FORCE.
(internal_delete_file, Frename_file): Callers changed.

* buffer.c (Fkill_buffer):
* callproc.c (delete_temp_file): Callers changed (Bug#6070).

* lisp.h: Update prototypes.

* diff.el (diff-sentinel):

* epg.el (epg--make-temp-file, epg-decrypt-string)
(epg-verify-string, epg-sign-string, epg-encrypt-string):

* jka-compr.el (jka-compr-partial-uncompress)
(jka-compr-call-process, jka-compr-write-region, jka-compr-load):

* server.el (server-sentinel): Use delete-file's new FORCE arg
(Bug#6070).

7 files changed, 88 insertions, 15 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index e14f7de13a6..3a9a9ca2264 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,19 @@
+2010-05-03  Chong Yidong  <cyd@stupidchicken.com>
+
+        * eval.c (internal_condition_case_n): Rename from
+        internal_condition_case_2.
+        (internal_condition_case_2): New function.
+
+        * xdisp.c (safe_call): Use internal_condition_case_n.
+
+        * fileio.c (Fdelete_file, internal_delete_file): New arg FORCE.
+        (internal_delete_file, Frename_file): Callers changed.
+
+        * buffer.c (Fkill_buffer):
+        * callproc.c (delete_temp_file): Callers changed (Bug#6070).
+
+        * lisp.h: Update prototypes.
+
 2010-05-03  Glenn Morris  <rgm@gnu.org>
 
         * Makefile.in (LIBX_EXTRA, LIBX_BASE): New variables.
diff --git a/src/buffer.c b/src/buffer.c
index b19286c6ea9..339bc99dcb1 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1547,7 +1547,7 @@ with SIGHUP.  */)
       Lisp_Object tem;
       tem = Fsymbol_value (intern ("delete-auto-save-files"));
       if (! NILP (tem))
-        internal_delete_file (b->auto_save_file_name);
+        internal_delete_file (b->auto_save_file_name, Qt);
     }
 
   if (b->base_buffer)
diff --git a/src/callproc.c b/src/callproc.c
index 378c647f385..317636d9cc8 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -856,7 +856,7 @@ delete_temp_file (name)
   /* Suppress jka-compr handling, etc.  */
   int count = SPECPDL_INDEX ();
   specbind (intern ("file-name-handler-alist"), Qnil);
-  internal_delete_file (name);
+  internal_delete_file (name, Qt);
   unbind_to (count, Qnil);
   return Qnil;
 }
diff --git a/src/eval.c b/src/eval.c
index 120365f5f57..e1fb815719e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1563,12 +1563,61 @@ internal_condition_case_1 (bfun, arg, handlers, hfun)
   return val;
 }
 
+/* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
+   its arguments.  */
+
+Lisp_Object
+internal_condition_case_2 (bfun, arg1, arg2, handlers, hfun)
+     Lisp_Object (*bfun) ();
+     Lisp_Object arg1;
+     Lisp_Object arg2;
+     Lisp_Object handlers;
+     Lisp_Object (*hfun) ();
+{
+  Lisp_Object val;
+  struct catchtag c;
+  struct handler h;
+
+  /* Since Fsignal will close off all calls to x_catch_errors,
+     we will get the wrong results if some are not closed now.  */
+#if HAVE_X_WINDOWS
+  if (x_catching_errors ())
+    abort ();
+#endif
+
+  c.tag = Qnil;
+  c.val = Qnil;
+  c.backlist = backtrace_list;
+  c.handlerlist = handlerlist;
+  c.lisp_eval_depth = lisp_eval_depth;
+  c.pdlcount = SPECPDL_INDEX ();
+  c.poll_suppress_count = poll_suppress_count;
+  c.interrupt_input_blocked = interrupt_input_blocked;
+  c.gcpro = gcprolist;
+  c.byte_stack = byte_stack_list;
+  if (_setjmp (c.jmp))
+    {
+      return (*hfun) (c.val);
+    }
+  c.next = catchlist;
+  catchlist = &c;
+  h.handler = handlers;
+  h.var = Qnil;
+  h.next = handlerlist;
+  h.tag = &c;
+  handlerlist = &h;
+
+  val = (*bfun) (arg1, arg2);
+  catchlist = c.next;
+  handlerlist = h.next;
+  return val;
+}
 
 /* Like internal_condition_case but call BFUN with NARGS as first,
    and ARGS as second argument.  */
 
 Lisp_Object
-internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
+internal_condition_case_n (bfun, nargs, args, handlers, hfun)
      Lisp_Object (*bfun) ();
      int nargs;
      Lisp_Object *args;
diff --git a/src/fileio.c b/src/fileio.c
index 13825a54212..6e9ab6f2a1e 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2194,11 +2194,17 @@ DEFUN ("delete-directory-internal", Fdelete_directory_internal,
   return Qnil;
 }
 
-DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
+DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2, "fDelete file: \nP",
        doc: /* Delete file named FILENAME.  If it is a symlink, remove the symlink.
-If file has multiple names, it continues to exist with the other names.  */)
-     (filename)
+If file has multiple names, it continues to exist with the other names.
+
+If optional arg FORCE is non-nil, really delete the file regardless of
+`delete-by-moving-to-trash'.  Otherwise, \"deleting\" actually moves
+it to the system's trash can if `delete-by-moving-to-trash' is non-nil.
+Interactively, FORCE is non-nil if called with a prefix arg.  */)
+     (filename, force)
      Lisp_Object filename;
+     Lisp_Object force;
 {
   Lisp_Object handler;
   Lisp_Object encoded_file;
@@ -2217,7 +2223,7 @@ If file has multiple names, it continues to exist with the other names.  */)
   if (!NILP (handler))
     return call2 (handler, Qdelete_file, filename);
 
-  if (delete_by_moving_to_trash)
+  if (delete_by_moving_to_trash && NILP (force))
     return call1 (Qmove_file_to_trash, filename);
 
   encoded_file = ENCODE_FILE (filename);
@@ -2234,14 +2240,15 @@ internal_delete_file_1 (ignore)
   return Qt;
 }
 
-/* Delete file FILENAME, returning 1 if successful and 0 if failed.  */
+/* Delete file FILENAME, returning 1 if successful and 0 if failed.
+   FORCE means to ignore `delete-by-moving-to-trash'.  */
 
 int
-internal_delete_file (filename)
-     Lisp_Object filename;
+internal_delete_file (Lisp_Object filename, Lisp_Object force)
 {
   Lisp_Object tem;
-  tem = internal_condition_case_1 (Fdelete_file, filename,
+
+  tem = internal_condition_case_2 (Fdelete_file, filename, force,
                                    Qt, internal_delete_file_1);
   return NILP (tem);
 }
@@ -2335,7 +2342,7 @@ This is what happens in interactive use with M-x.  */)
               )
             call2 (Qdelete_directory, file, Qt);
           else
-            Fdelete_file (file);
+            Fdelete_file (file, Qt);
           unbind_to (count, Qnil);
         }
       else
diff --git a/src/lisp.h b/src/lisp.h
index 16953e20a04..d9d15c9245d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2901,7 +2901,8 @@ extern Lisp_Object internal_catch P_ ((Lisp_Object, Lisp_Object (*) (Lisp_Object
 extern Lisp_Object internal_lisp_condition_case P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 extern Lisp_Object internal_condition_case P_ ((Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)));
 extern Lisp_Object internal_condition_case_1 P_ ((Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)));
-extern Lisp_Object internal_condition_case_2 P_ ((Lisp_Object (*) (int, Lisp_Object *), int, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object)));
+extern Lisp_Object internal_condition_case_2 P_ ((Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)));
+extern Lisp_Object internal_condition_case_n P_ ((Lisp_Object (*) (int, Lisp_Object *), int, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object)));
 extern void specbind P_ ((Lisp_Object, Lisp_Object));
 extern void record_unwind_protect P_ ((Lisp_Object (*) (Lisp_Object), Lisp_Object));
 extern Lisp_Object unbind_to P_ ((int, Lisp_Object));
@@ -3059,7 +3060,7 @@ EXFUN (Ffile_executable_p, 1);
 EXFUN (Fread_file_name, 6);
 extern Lisp_Object close_file_unwind P_ ((Lisp_Object));
 extern void report_file_error P_ ((const char *, Lisp_Object)) NO_RETURN;
-extern int internal_delete_file P_ ((Lisp_Object));
+extern int internal_delete_file P_ ((Lisp_Object, Lisp_Object));
 extern void syms_of_fileio P_ ((void));
 extern Lisp_Object make_temp_name P_ ((Lisp_Object, int));
 EXFUN (Fmake_symbolic_link, 3);
diff --git a/src/xdisp.c b/src/xdisp.c
index 6d906825d1e..1e16180f7c9 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2451,7 +2451,7 @@ safe_call (nargs, args)
       specbind (Qinhibit_redisplay, Qt);
       /* Use Qt to ensure debugger does not run,
          so there is no possibility of wanting to redisplay.  */
-      val = internal_condition_case_2 (Ffuncall, nargs, args, Qt,
+      val = internal_condition_case_n (Ffuncall, nargs, args, Qt,
                                        safe_eval_handler);
       UNGCPRO;
       val = unbind_to (count, val);