From 53967e09ad89f11531c7fee0240c2eac1f63922c Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Mon, 3 May 2010 11:01:21 -0400 Subject: [PATCH] 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). --- etc/NEWS | 8 ++++++++ lisp/ChangeLog | 26 ++++++++++++------------ lisp/diff.el | 5 ++--- lisp/epg.el | 15 +++++--------- lisp/jka-compr.el | 12 ++++------- lisp/server.el | 3 +-- src/ChangeLog | 16 +++++++++++++++ src/buffer.c | 2 +- src/callproc.c | 2 +- src/eval.c | 51 ++++++++++++++++++++++++++++++++++++++++++++++- src/fileio.c | 25 ++++++++++++++--------- src/lisp.h | 5 +++-- src/xdisp.c | 2 +- 13 files changed, 121 insertions(+), 51 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6fa940143bb..899c09a3cc5 100644 --- 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'. + * Changes in Specialized Modes and Packages in Emacs 24.1 @@ -181,6 +186,9 @@ Secret Service API requires D-Bus for communication. * 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 ed61cb38389..1cc1bddaca2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2010-05-03 Chong Yidong + + * 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 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 - - * 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 * bindings.el (mode-line-abbrev-mode, mode-line-auto-fill-mode): diff --git a/lisp/diff.el b/lisp/diff.el index 37e52baaaac..d7fc993ec33 100644 --- 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 668043ebeb7..7791c1865a7 100644 --- 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 6df57d710e1..e4311e13f28 100644 --- 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 56819112639..6b5f2486332 100644 --- 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 e14f7de13a6..3a9a9ca2264 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,19 @@ +2010-05-03 Chong Yidong + + * 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 * 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); -- 2.39.2