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).

diff --git a/etc/NEWS b/etc/NEWS
index 6fa9401..899c09a 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -109,6 +109,11 @@ define it as a scroll command affected by `scroll-preserve-screen-position.
 
 ** completion-at-point is now an alias for complete-symbol.
 
+** mouse-region-delete-keys has been deleted.
+
+** If delete-file is called with a prefix argument, it really deletes,
+regardless of the value of `delete-by-moving-to-trash'.
+
 \f
 * Changes in Specialized Modes and Packages in Emacs 24.1
 
@@ -181,6 +186,9 @@ Secret Service API requires D-Bus for communication.
 \f
 * Lisp changes in Emacs 24.1
 
+** delete-file now accepts an optional second arg, FORCE, which says
+to always delete and ignore the value of delete-by-moving-to-trash.
+
 ** buffer-substring-filters is obsoleted by filter-buffer-substring-functions.
 
 ** New completion style `substring'.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ed61cb3..1cc1bdd 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2010-05-03  Chong Yidong  <cyd@stupidchicken.com>
+
+       * 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).
+
 2010-05-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        Use define-minor-mode where applicable.
@@ -100,19 +113,6 @@
        (tramp-handle-file-local-copy, tramp-handle-write-region)
        (tramp-method-out-of-band-p): Use `tramp-get-inline-coding'.
 
-2010-05-01  Chong Yidong  <cyd@stupidchicken.com>
-
-       * server.el (server-sentinel, server-start, server-force-delete):
-
-       * jka-compr.el (jka-compr-partial-uncompress)
-       (jka-compr-call-process, jka-compr-write-region, jka-compr-load):
-
-       * epg.el (epg--make-temp-file, epg-decrypt-string)
-       (epg-encrypt-string, epg-verify-string, epg-sign-string):
-
-       * diff.el (diff-sentinel): Bind delete-by-moving-to-trash to nil
-       before deleting (Bug#6070).
-
 2010-05-01  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * bindings.el (mode-line-abbrev-mode, mode-line-auto-fill-mode):

diff --git a/lisp/diff.el b/lisp/diff.el
index 37e52ba..d7fc993 100644 (file)
--- a/lisp/diff.el
+++ b/lisp/diff.el
@@ -64,9 +64,8 @@
   "Code run when the diff process exits.
 CODE is the exit code of the process.  It should be 0 only if no diffs
 were found."
-  (let (delete-by-moving-to-trash)
-    (if diff-old-temp-file (delete-file diff-old-temp-file))
-    (if diff-new-temp-file (delete-file diff-new-temp-file)))
+  (if diff-old-temp-file (delete-file diff-old-temp-file t))
+  (if diff-new-temp-file (delete-file diff-new-temp-file t))
   (save-excursion
     (goto-char (point-max))
     (let ((inhibit-read-only t))

diff --git a/lisp/epg.el b/lisp/epg.el
index 668043e..7791c18 100644 (file)
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1898,8 +1898,7 @@ You can then use `write-region' to write new data into the file."
          ;; Cleanup the tempfile.
          (and tempfile
               (file-exists-p tempfile)
-              (let (delete-by-moving-to-trash)
-                (delete-file tempfile)))
+              (delete-file tempfile t))
          ;; Cleanup the tempdir.
          (and tempdir
               (file-directory-p tempdir)
@@ -1999,8 +1998,7 @@ If PLAIN is nil, it returns the result as a string."
          (epg-read-output context))
       (epg-delete-output-file context)
       (if (file-exists-p input-file)
-         (let (delete-by-moving-to-trash)
-           (delete-file input-file)))
+         (delete-file input-file t))
       (epg-reset context))))
 
 (defun epg-start-verify (context signature &optional signed-text)
@@ -2097,8 +2095,7 @@ successful verification."
       (epg-delete-output-file context)
       (if (and input-file
               (file-exists-p input-file))
-         (let (delete-by-moving-to-trash)
-           (delete-file input-file)))
+         (delete-file input-file))
       (epg-reset context))))
 
 (defun epg-start-sign (context plain &optional mode)
@@ -2205,8 +2202,7 @@ Otherwise, it makes a cleartext signature."
          (epg-read-output context))
       (epg-delete-output-file context)
       (if input-file
-         (let (delete-by-moving-to-trash)
-           (delete-file input-file)))
+         (delete-file input-file t))
       (epg-reset context))))
 
 (defun epg-start-encrypt (context plain recipients
@@ -2326,8 +2322,7 @@ If RECIPIENTS is nil, it performs symmetric encryption."
          (epg-read-output context))
       (epg-delete-output-file context)
       (if input-file
-         (let (delete-by-moving-to-trash)
-           (delete-file input-file)))
+         (delete-file input-file t))
       (epg-reset context))))
 
 (defun epg-start-export-keys (context keys)

diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 6df57d7..e4311e1 100644 (file)
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -181,8 +181,7 @@ to keep: LEN chars starting BEG chars from the beginning."
                          null-device))
                        jka-compr-acceptable-retval-list)
                  (jka-compr-error prog args infile message err-file))
-           (let (delete-by-moving-to-trash)
-             (delete-file err-file))))
+           (delete-file err-file t)))
 
       ;; Run the uncompression program directly.
       ;; We get the whole file and must delete what we don't want.
@@ -224,8 +223,7 @@ to keep: LEN chars starting BEG chars from the beginning."
                                           "")))
                   jka-compr-acceptable-retval-list)
                  (jka-compr-error prog args infile message err-file))
-           (let (delete-by-moving-to-trash)
-             (delete-file err-file))))
+           (delete-file err-file t)))
       (or (eq 0
              (apply 'call-process
                     prog infile (if (stringp output) temp output)
@@ -337,8 +335,7 @@ There should be no more than seven characters after the final `/'."
                                                (and append can-append) 'dont))
              (erase-buffer)) )
 
-         (let (delete-by-moving-to-trash)
-           (delete-file temp-file))
+         (delete-file temp-file t)
 
          (and
           compress-message
@@ -604,8 +601,7 @@ There should be no more than seven characters after the final `/'."
              (setq file (file-name-sans-extension file)))
            (setcar l file)))
 
-      (let (delete-by-moving-to-trash)
-       (delete-file local-copy)))
+      (delete-file local-copy))
 
     t))
 

diff --git a/lisp/server.el b/lisp/server.el
index 5681911..6b5f248 100644 (file)
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -345,8 +345,7 @@ If CLIENT is non-nil, add a description of it to the logged message."
   (and (process-contact proc :server)
        (eq (process-status proc) 'closed)
        (ignore-errors
-       (let (delete-by-moving-to-trash)
-         (delete-file (process-get proc :server-file)))))
+       (delete-file (process-get proc :server-file) t)))
   (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
   (server-delete-client proc))
 

diff --git a/src/ChangeLog b/src/ChangeLog
index e14f7de..3a9a9ca 100644 (file)
--- 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 b19286c..339bc99 100644 (file)
--- 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 378c647..317636d 100644 (file)
--- 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 120365f..e1fb815 100644 (file)
--- 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 13825a5..6e9ab6f 100644 (file)
--- 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 16953e2..d9d15c9 100644 (file)
--- 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 6d90682..1e16180 100644 (file)
--- 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);