Mercurial > emacs

changeset 108223:261591829d04

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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).
author Chong Yidong <cyd@stupidchicken.com>
date Mon, 03 May 2010 11:01:21 -0400
parents ca0eca33fb40
children 8251ba69ff20
files etc/NEWS lisp/ChangeLog lisp/diff.el lisp/epg.el lisp/jka-compr.el lisp/server.el src/ChangeLog src/buffer.c src/callproc.c src/eval.c src/fileio.c src/lisp.h src/xdisp.c
diffstat 13 files changed, 121 insertions(+), 51 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Mon May 03 14:46:56 2010 +0200
+++ b/etc/NEWS	Mon May 03 11:01:21 2010 -0400
@@ -109,6 +109,11 @@
 
 ** 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'.
+
 
 * Changes in Specialized Modes and Packages in Emacs 24.1
 
@@ -181,6 +186,9 @@
 
 * 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'.
--- a/lisp/ChangeLog	Mon May 03 14:46:56 2010 +0200
+++ b/lisp/ChangeLog	Mon May 03 11:01:21 2010 -0400
@@ -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):
--- a/lisp/diff.el	Mon May 03 14:46:56 2010 +0200
+++ b/lisp/diff.el	Mon May 03 11:01:21 2010 -0400
@@ -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))
--- a/lisp/epg.el	Mon May 03 14:46:56 2010 +0200
+++ b/lisp/epg.el	Mon May 03 11:01:21 2010 -0400
@@ -1898,8 +1898,7 @@
 	  ;; 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 @@
 	  (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 @@
       (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 @@
 	  (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 @@
 	  (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)
--- a/lisp/jka-compr.el	Mon May 03 14:46:56 2010 +0200
+++ b/lisp/jka-compr.el	Mon May 03 11:01:21 2010 -0400
@@ -181,8 +181,7 @@
 			  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 @@
 					   "")))
 		   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 @@
 						(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 @@
 	      (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))
 
--- a/lisp/server.el	Mon May 03 14:46:56 2010 +0200
+++ b/lisp/server.el	Mon May 03 11:01:21 2010 -0400
@@ -345,8 +345,7 @@
   (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))
 
--- a/src/ChangeLog	Mon May 03 14:46:56 2010 +0200
+++ b/src/ChangeLog	Mon May 03 11:01:21 2010 -0400
@@ -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.
--- a/src/buffer.c	Mon May 03 14:46:56 2010 +0200
+++ b/src/buffer.c	Mon May 03 11:01:21 2010 -0400
@@ -1547,7 +1547,7 @@
       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)
--- a/src/callproc.c	Mon May 03 14:46:56 2010 +0200
+++ b/src/callproc.c	Mon May 03 11:01:21 2010 -0400
@@ -856,7 +856,7 @@
   /* 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;
 }
--- a/src/eval.c	Mon May 03 14:46:56 2010 +0200
+++ b/src/eval.c	Mon May 03 11:01:21 2010 -0400
@@ -1563,12 +1563,61 @@
   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;
--- a/src/fileio.c	Mon May 03 14:46:56 2010 +0200
+++ b/src/fileio.c	Mon May 03 11:01:21 2010 -0400
@@ -2194,11 +2194,17 @@
   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 (!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 @@
   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 @@
 	      )
 	    call2 (Qdelete_directory, file, Qt);
 	  else
-	    Fdelete_file (file);
+	    Fdelete_file (file, Qt);
 	  unbind_to (count, Qnil);
 	}
       else
--- a/src/lisp.h	Mon May 03 14:46:56 2010 +0200
+++ b/src/lisp.h	Mon May 03 11:01:21 2010 -0400
@@ -2901,7 +2901,8 @@
 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 (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);
--- a/src/xdisp.c	Mon May 03 14:46:56 2010 +0200
+++ b/src/xdisp.c	Mon May 03 11:01:21 2010 -0400
@@ -2451,7 +2451,7 @@
       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);