commit 6f037f427a25160168e842bff0d12b816d69067d (HEAD, refs/remotes/origin/master) Author: Noam Postavsky Date: Fri May 11 13:44:46 2018 -0400 Honor print-charset-text-property value of nil (Bug#31376) * src/print.c (print_check_string_charset_prop): Move check for nil Vprint_charset_text_property from here... (print_prune_string_charset): ... to here. (syms_of_print) : Clarify that any non-boolean values are treated the same as `default'. * doc/lispref/streams.texi (Output Variables): Add print-prune-string-charset. * test/src/print-tests.el (print-charset-text-property-nil) (print-charset-text-property-default) (print-charset-text-property-t): New tests. (print-tests--prints-with-charset-p): New helper function. diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index ebd806601e..032669cb10 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -809,6 +809,21 @@ when the output stream is a unibyte buffer or a marker pointing into one. @end defvar +@defvar print-charset-text-property +This variable controls printing of `charset' text property on printing +a string. The value should be @code{nil}, @code{t}, or +@code{default}. + +If the value is @code{nil}, @code{charset} text properties are never +printed. If @code{t}, they are always printed. + +If the value is @code{default}, only print @code{charset} text +properties if there is an ``unexpected'' @code{charset} property. For +ascii characters, all charsets are considered ``expected''. +Otherwise, the expected @code{charset} property of a character is +given by @code{char-charset}. +@end defvar + @defvar print-length @cindex printing limits The value of this variable is the maximum number of elements to print in diff --git a/src/print.c b/src/print.c index 7c6856af48..8394375220 100644 --- a/src/print.c +++ b/src/print.c @@ -1317,8 +1317,7 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) || CONSP (XCDR (XCDR (val)))) print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND; } - if (NILP (Vprint_charset_text_property) - || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) + if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { int i, c; ptrdiff_t charpos = interval->position; @@ -1348,7 +1347,8 @@ print_prune_string_charset (Lisp_Object string) print_check_string_result = 0; traverse_intervals (string_intervals (string), 0, print_check_string_charset_prop, string); - if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) + if (NILP (Vprint_charset_text_property) + || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { string = Fcopy_sequence (string); if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND) @@ -2423,7 +2423,7 @@ that need to be recorded in the table. */); DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property, doc: /* A flag to control printing of `charset' text property on printing a string. -The value must be nil, t, or `default'. +The value should be nil, t, or `default'. If the value is nil, don't print the text property `charset'. @@ -2431,7 +2431,8 @@ If the value is t, always print the text property `charset'. If the value is `default', print the text property `charset' only when the value is different from what is guessed in the current charset -priorities. */); +priorities. Values other than nil or t are also treated as +`default'. */); Vprint_charset_text_property = Qdefault; /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 01e65028bc..c96cb5d2b6 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -27,6 +27,42 @@ (prin1-to-string "\u00A2\ff")) "\"\\x00a2\\ff\""))) +(defun print-tests--prints-with-charset-p (ch odd-charset) + "Return t if `prin1-to-string' prints CH with the `charset' property. +CH is propertized with a `charset' value according to +ODD-CHARSET: if nil, then use the one returned by `char-charset', +otherwise, use a different charset." + (integerp + (string-match + "charset" + (prin1-to-string + (propertize (string ch) + 'charset + (if odd-charset + (cl-find (char-charset ch) charset-list :test-not #'eq) + (char-charset ch))))))) + +(ert-deftest print-charset-text-property-nil () + (let ((print-charset-text-property nil)) + (should-not (print-tests--prints-with-charset-p ?\xf6 t)) ; Bug#31376. + (should-not (print-tests--prints-with-charset-p ?a t)) + (should-not (print-tests--prints-with-charset-p ?\xf6 nil)) + (should-not (print-tests--prints-with-charset-p ?a nil)))) + +(ert-deftest print-charset-text-property-default () + (let ((print-charset-text-property 'default)) + (should (print-tests--prints-with-charset-p ?\xf6 t)) + (should-not (print-tests--prints-with-charset-p ?a t)) + (should-not (print-tests--prints-with-charset-p ?\xf6 nil)) + (should-not (print-tests--prints-with-charset-p ?a nil)))) + +(ert-deftest print-charset-text-property-t () + (let ((print-charset-text-property t)) + (should (print-tests--prints-with-charset-p ?\xf6 t)) + (should (print-tests--prints-with-charset-p ?a t)) + (should (print-tests--prints-with-charset-p ?\xf6 nil)) + (should (print-tests--prints-with-charset-p ?a nil)))) + (ert-deftest terpri () (should (string= (with-output-to-string (princ 'abc) commit 0d224e82411d9471f03fc339890d6a2952b5e239 Author: Michael Welsh Duggan Date: Sun Nov 23 18:34:28 2014 -0500 Avoid messing up buffer list when starting gud (Bug#22374) * lisp/progmodes/gud.el (gud-common-init): Use `display-buffer' instead of `switch-to-buffer'. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index de398350bd..6826674a94 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2605,7 +2605,12 @@ comint mode, which see." file-subst))) (filepart (and file-word (concat "-" (file-name-nondirectory file)))) (existing-buffer (get-buffer (concat "*gud" filepart "*")))) - (switch-to-buffer (concat "*gud" filepart "*")) + (select-window + (display-buffer + (get-buffer-create (concat "*gud" filepart "*")) + '(display-buffer-reuse-window + display-buffer-in-previous-window + display-buffer-same-window display-buffer-pop-up-window))) (when (and existing-buffer (get-buffer-process existing-buffer)) (error "This program is already being debugged")) ;; Set the dir, in case the buffer already existed with a different dir. commit 302e500087fd4cc1c5f37ec87c98e828b22aaa05 Author: Noam Postavsky Date: Sun Apr 29 10:32:03 2018 -0400 Move epa-pinentry-mode to epg-config (Bug#26298) * lisp/epa.el (epa-pinentry-mode): Make into obsolete alias for... * lisp/epg-config.el (epg-pinentry-mode): ...this new user option. * lisp/epg.el (epg-context): Use it as the default value for pinentry-mode. * etc/NEWS: Announce name change. * lisp/epa-file.el (epa-file-insert-file-contents) (epa-file-write-region): * lisp/epa.el (epa-decrypt-file, epa-sign-file) (epa-encrypt-file, epa-decrypt-region) (epa-sign-region, epa-encrypt-region): Don't change epg-context-pinentry-mode from the default. diff --git a/etc/NEWS b/etc/NEWS index 4cb31ef4d4..0f4c90be75 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -453,6 +453,9 @@ are formatted as MIME digests. *** 'message-forward-included-headers' has changed its default to exclude most headers when forwarding. +** 'epa-pinentry-mode' is renamed to 'epg-pinentry-mode'. +It now applies to epg functions as well as epa functions. + * New Modes and Packages in Emacs 27.1 +++ diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 1de2f9ba2d..866a4ae03a 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -147,7 +147,6 @@ encryption is used." context (cons #'epa-progress-callback-function (format "Decrypting %s" file))) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (unwind-protect (progn (if replace @@ -236,7 +235,6 @@ encryption is used." (cons #'epa-progress-callback-function (format "Encrypting %s" file))) (setf (epg-context-armor context) epa-armor) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (condition-case error (setq string (epg-encrypt-string diff --git a/lisp/epa.el b/lisp/epa.el index a375cd6170..16621659a6 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -56,27 +56,8 @@ If neither t nor nil, ask user for confirmation." :type 'integer :group 'epa) -;; In the doc string below, we say "symbol `error'" to avoid producing -;; a hyperlink for `error' the function. -(defcustom epa-pinentry-mode nil - "The pinentry mode. - -GnuPG 2.1 or later has an option to control the behavior of -Pinentry invocation. The value should be the symbol `error', -`ask', `cancel', or `loopback'. See the GnuPG manual for the -meanings. - -In epa commands, a particularly useful mode is `loopback', which -redirects all Pinentry queries to the caller, so Emacs can query -passphrase through the minibuffer, instead of external Pinentry -program." - :type '(choice (const nil) - (const ask) - (const cancel) - (const error) - (const loopback)) - :group 'epa - :version "25.1") +(define-obsolete-variable-alias + 'epa-pinentry-mode 'epg-pinentry-mode "27.1") (defgroup epa-faces nil "Faces for epa-mode." @@ -695,7 +676,6 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." #'epa-progress-callback-function (format "Decrypting %s..." (file-name-nondirectory decrypt-file)))) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Decrypting %s..." (file-name-nondirectory decrypt-file)) (condition-case error (epg-decrypt-file context decrypt-file plain-file) @@ -791,7 +771,6 @@ If no one is selected, default secret key is used. " #'epa-progress-callback-function (format "Signing %s..." (file-name-nondirectory file)))) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Signing %s..." (file-name-nondirectory file)) (condition-case error (epg-sign-file context file signature mode) @@ -822,7 +801,6 @@ If no one is selected, symmetric encryption will be performed. "))) #'epa-progress-callback-function (format "Encrypting %s..." (file-name-nondirectory file)))) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Encrypting %s..." (file-name-nondirectory file)) (condition-case error (epg-encrypt-file context file recipients cipher) @@ -865,7 +843,6 @@ For example: (cons #'epa-progress-callback-function "Decrypting...")) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Decrypting...") (condition-case error (setq plain (epg-decrypt-string context (buffer-substring start end))) @@ -1070,7 +1047,6 @@ If no one is selected, default secret key is used. " (cons #'epa-progress-callback-function "Signing...")) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Signing...") (condition-case error (setq signature (epg-sign-string context @@ -1159,7 +1135,6 @@ If no one is selected, symmetric encryption will be performed. ") (cons #'epa-progress-callback-function "Encrypting...")) - (setf (epg-context-pinentry-mode context) epa-pinentry-mode) (message "Encrypting...") (condition-case error (setq cipher (epg-encrypt-string context @@ -1328,7 +1303,6 @@ If no one is selected, default public key is exported. "))) ;; (cons ;; #'epa-progress-callback-function ;; "Signing keys...")) -;; (setf (epg-context-pinentry-mode context) epa-pinentry-mode) ;; (message "Signing keys...") ;; (epg-sign-keys context keys local) ;; (message "Signing keys...done"))) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index bf9360cdb4..9d9bd7101e 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -69,6 +69,27 @@ instead use \\[customize] (see the info node `Easy Customization')." "Coding system to use with messages from `epg-gpg-program'." :type 'symbol) + +;; In the doc string below, we say "symbol `error'" to avoid producing +;; a hyperlink for `error' the function. +(defcustom epg-pinentry-mode nil + "The pinentry mode. + +GnuPG 2.1 or later has an option to control the behavior of +Pinentry invocation. The value should be the symbol `error', +`ask', `cancel', or `loopback'. See the GnuPG manual for the +meanings. + +A particularly useful mode is `loopback', which redirects all +Pinentry queries to the caller, so Emacs can query passphrase +through the minibuffer, instead of external Pinentry program." + :type '(choice (const nil) + (const ask) + (const cancel) + (const error) + (const loopback)) + :version "27.1") + (defcustom epg-debug nil "If non-nil, debug output goes to the \" *epg-debug*\" buffer. Note that the buffer name starts with a space." diff --git a/lisp/epg.el b/lisp/epg.el index e6b4af2b36..f79f2046de 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -207,7 +207,7 @@ output-file result operation - pinentry-mode + (pinentry-mode epg-pinentry-mode) (error-output "") error-buffer) commit 21ab346a07eff8ba43cb2738dc6752f012b77670 Author: Noam Postavsky Date: Mon Apr 30 08:49:11 2018 -0400 Drop some epg/epa backwards compat code for ancient Emacs versions * lisp/epa.el (epa--select-safe-coding-system): Remove, `select-safe-coding-system' has been present since Emacs 20.3. (epa--encode-coding-string, epa--decode-coding-string): * lisp/epg.el (epg--decode-coding-string, epg--encode-coding-string) (epg--clear-string): Remove, the corresponding Emacs functions are so old they don't show up in NEWS. Furthermore, the fallback for the *-coding-string functions was `identity' which wouldn't have worked anyway, since it only takes a single argument. (epg--make-temp-file): Remove, `make-temp-file' has been present since Emacs 21.1. * lisp/epg-config.el (epg-gpg-program, epg-gpgsm-program) (epg-gpgconf-program, epg-gpg-home-directory) (epg-passphrase-coding-system, epg-debug): Remove unneeded :group parameter. diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index c819f6734c..7f4c28e967 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -95,7 +95,7 @@ The buffer is expected to contain a mail message." (forward-line)) (setq epa-last-coding-system-specified (or coding-system-for-write - (epa--select-safe-coding-system (point) (point-max)))) + (select-safe-coding-system (point) (point-max)))) (let ((verbose current-prefix-arg)) (list (point) (point-max) (if verbose @@ -222,7 +222,7 @@ If no one is selected, symmetric encryption will be performed. " (setq epa-last-coding-system-specified (or coding-system-for-write - (epa--select-safe-coding-system (point) (point-max))))) + (select-safe-coding-system (point) (point-max))))) ;; Don't let some read-only text stop us from encrypting. (let ((inhibit-read-only t)) diff --git a/lisp/epa.el b/lisp/epa.el index 70f27e272f..a375cd6170 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -307,12 +307,6 @@ You should bind this variable with `let', but do not set it globally.") (epg-sub-key-id (car (epg-key-sub-key-list (widget-get widget :value)))))) -(defalias 'epa--encode-coding-string - (if (fboundp 'encode-coding-string) #'encode-coding-string #'identity)) - -(defalias 'epa--decode-coding-string - (if (fboundp 'decode-coding-string) #'decode-coding-string #'identity)) - (define-derived-mode epa-key-list-mode special-mode "Keys" "Major mode for `epa-list-keys'." (buffer-disable-undo) @@ -879,7 +873,7 @@ For example: (epa-display-error context) (signal (car error) (cdr error)))) (message "Decrypting...done") - (setq plain (epa--decode-coding-string + (setq plain (decode-coding-string plain (or coding-system-for-read (get-text-property start 'epa-coding-system-used) @@ -973,7 +967,7 @@ For example: (condition-case error (setq plain (epg-verify-string context - (epa--encode-coding-string + (encode-coding-string (buffer-substring start end) (or coding-system-for-write (get-text-property start 'epa-coding-system-used))))) @@ -981,7 +975,7 @@ For example: (epa-display-error context) (signal (car error) (cdr error)))) (message "Verifying...done") - (setq plain (epa--decode-coding-string + (setq plain (decode-coding-string plain (or coding-system-for-read (get-text-property start 'epa-coding-system-used) @@ -1029,12 +1023,6 @@ See the reason described in the `epa-verify-region' documentation." (error "No cleartext tail")) (epa-verify-region cleartext-start cleartext-end)))))) -(defalias 'epa--select-safe-coding-system - (if (fboundp 'select-safe-coding-system) - #'select-safe-coding-system - (lambda (_from _to) - buffer-file-coding-system))) - ;;;###autoload (defun epa-sign-region (start end signers mode) "Sign the current region between START and END by SIGNERS keys selected. @@ -1057,7 +1045,7 @@ For example: (let ((verbose current-prefix-arg)) (setq epa-last-coding-system-specified (or coding-system-for-write - (epa--select-safe-coding-system + (select-safe-coding-system (region-beginning) (region-end)))) (list (region-beginning) (region-end) (if verbose @@ -1086,7 +1074,7 @@ If no one is selected, default secret key is used. " (message "Signing...") (condition-case error (setq signature (epg-sign-string context - (epa--encode-coding-string + (encode-coding-string (buffer-substring start end) epa-last-coding-system-specified) mode)) @@ -1098,7 +1086,7 @@ If no one is selected, default secret key is used. " (goto-char start) (add-text-properties (point) (progn - (insert (epa--decode-coding-string + (insert (decode-coding-string signature (or coding-system-for-read epa-last-coding-system-specified))) @@ -1146,7 +1134,7 @@ For example: sign) (setq epa-last-coding-system-specified (or coding-system-for-write - (epa--select-safe-coding-system + (select-safe-coding-system (region-beginning) (region-end)))) (list (region-beginning) (region-end) (epa-select-keys context @@ -1175,7 +1163,7 @@ If no one is selected, symmetric encryption will be performed. ") (message "Encrypting...") (condition-case error (setq cipher (epg-encrypt-string context - (epa--encode-coding-string + (encode-coding-string (buffer-substring start end) epa-last-coding-system-specified) recipients diff --git a/lisp/epg-config.el b/lisp/epg-config.el index d30ebea2d6..bf9360cdb4 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -48,36 +48,30 @@ Setting this variable directly does not take effect; instead use \\[customize] (see the info node `Easy Customization')." :version "25.1" - :group 'epg :type 'string) (defcustom epg-gpgsm-program "gpgsm" "The `gpgsm' executable. Setting this variable directly does not take effect; instead use \\[customize] (see the info node `Easy Customization')." - :group 'epg :type 'string) (defcustom epg-gpgconf-program "gpgconf" "The `gpgconf' executable." :version "25.1" - :group 'epg :type 'string) (defcustom epg-gpg-home-directory nil "The directory which contains the configuration files of `epg-gpg-program'." - :group 'epg :type '(choice (const :tag "Default" nil) directory)) (defcustom epg-passphrase-coding-system nil "Coding system to use with messages from `epg-gpg-program'." - :group 'epg :type 'symbol) (defcustom epg-debug nil "If non-nil, debug output goes to the \" *epg-debug*\" buffer. Note that the buffer name starts with a space." - :group 'epg :type 'boolean) (defconst epg-gpg-minimum-version "1.4.3") diff --git a/lisp/epg.el b/lisp/epg.el index 091021936a..e6b4af2b36 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -760,18 +760,13 @@ callback data (if any)." (file-exists-p (epg-context-output-file context))) (delete-file (epg-context-output-file context)))) -(eval-and-compile - (if (fboundp 'decode-coding-string) - (defalias 'epg--decode-coding-string 'decode-coding-string) - (defalias 'epg--decode-coding-string 'identity))) - (defun epg--status-USERID_HINT (_context string) (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string) (let* ((key-id (match-string 1 string)) (user-id (match-string 2 string)) (entry (assoc key-id epg-user-id-alist))) (condition-case nil - (setq user-id (epg--decode-coding-string + (setq user-id (decode-coding-string (epg--decode-percent-escape user-id) 'utf-8)) (error)) @@ -790,17 +785,6 @@ callback data (if any)." (defun epg--status-NEED_PASSPHRASE_PIN (_context _string) (setq epg-key-id 'PIN)) -(eval-and-compile - (if (fboundp 'clear-string) - (defalias 'epg--clear-string 'clear-string) - (defun epg--clear-string (string) - (fillarray string 0)))) - -(eval-and-compile - (if (fboundp 'encode-coding-string) - (defalias 'epg--encode-coding-string 'encode-coding-string) - (defalias 'epg--encode-coding-string 'identity))) - (defun epg--status-GET_HIDDEN (context string) (when (and epg-key-id (string-match "\\`passphrase\\." string)) @@ -821,16 +805,16 @@ callback data (if any)." (cdr (epg-context-passphrase-callback context)))) (when passphrase (setq passphrase-with-new-line (concat passphrase "\n")) - (epg--clear-string passphrase) + (clear-string passphrase) (setq passphrase nil) (if epg-passphrase-coding-system (progn (setq encoded-passphrase-with-new-line - (epg--encode-coding-string + (encode-coding-string passphrase-with-new-line (coding-system-change-eol-conversion epg-passphrase-coding-system 'unix))) - (epg--clear-string passphrase-with-new-line) + (clear-string passphrase-with-new-line) (setq passphrase-with-new-line nil)) (setq encoded-passphrase-with-new-line passphrase-with-new-line @@ -844,11 +828,11 @@ callback data (if any)." (epg-context-result-for context 'error))) (delete-process (epg-context-process context)))) (if passphrase - (epg--clear-string passphrase)) + (clear-string passphrase)) (if passphrase-with-new-line - (epg--clear-string passphrase-with-new-line)) + (clear-string passphrase-with-new-line)) (if encoded-passphrase-with-new-line - (epg--clear-string encoded-passphrase-with-new-line)))))) + (clear-string encoded-passphrase-with-new-line)))))) (defun epg--prompt-GET_BOOL (_context string) (let ((entry (assoc string epg-prompt-alist))) @@ -911,7 +895,7 @@ callback data (if any)." (condition-case nil (if (eq (epg-context-protocol context) 'CMS) (setq user-id (epg-dn-from-string user-id)) - (setq user-id (epg--decode-coding-string + (setq user-id (decode-coding-string (epg--decode-percent-escape user-id) 'utf-8))) (error)) @@ -1192,7 +1176,7 @@ callback data (if any)." (user-id (match-string 2 string)) (entry (assoc key-id epg-user-id-alist))) (condition-case nil - (setq user-id (epg--decode-coding-string + (setq user-id (decode-coding-string (epg--decode-percent-escape user-id) 'utf-8)) (error)) @@ -1349,7 +1333,7 @@ NAME is either a string or a list of strings." (setq string (replace-match "\\\"" t t string) index (1+ (match-end 0)))) (condition-case nil - (setq string (epg--decode-coding-string + (setq string (decode-coding-string (car (read-from-string (concat "\"" string "\""))) 'utf-8)) (error @@ -1394,62 +1378,6 @@ NAME is either a string or a list of strings." (setq pointer (cdr pointer))) keys)) -(eval-and-compile - (if (fboundp 'make-temp-file) - (defalias 'epg--make-temp-file 'make-temp-file) - (defvar temporary-file-directory) - ;; stolen from poe.el. - (defun epg--make-temp-file (prefix) - "Create a temporary file. -The returned file name (created by appending some random characters at the end -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file." - (let ((orig-modes (default-file-modes)) - tempdir tempfile) - (setq prefix (expand-file-name prefix - (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory))) - (unwind-protect - (let (file) - ;; First, create a temporary directory. - (set-default-file-modes #o700) - (while (condition-case () - (progn - (setq tempdir (make-temp-name - (concat - (file-name-directory prefix) - "DIR"))) - ;; return nil or signal an error. - (make-directory tempdir)) - ;; let's try again. - (file-already-exists t))) - ;; Second, create a temporary file in the tempdir. - ;; There *is* a race condition between `make-temp-name' - ;; and `write-region', but we don't care it since we are - ;; in a private directory now. - (setq tempfile (make-temp-name (concat tempdir "/EMU"))) - (write-region "" nil tempfile nil 'silent) - ;; Finally, make a hard-link from the tempfile. - (while (condition-case () - (progn - (setq file (make-temp-name prefix)) - ;; return nil or signal an error. - (add-name-to-file tempfile file)) - ;; let's try again. - (file-already-exists t))) - file) - (set-default-file-modes orig-modes) - ;; Cleanup the tempfile. - (and tempfile - (file-exists-p tempfile) - (delete-file tempfile)) - ;; Cleanup the tempdir. - (and tempdir - (file-directory-p tempdir) - (delete-directory tempdir))))))) - (defun epg--args-from-sig-notations (notations) (apply #'nconc (mapcar @@ -1513,7 +1441,7 @@ If PLAIN is nil, it returns the result as a string." (unwind-protect (progn (setf (epg-context-output-file context) - (or plain (epg--make-temp-file "epg-output"))) + (or plain (make-temp-file "epg-output"))) (epg-start-decrypt context (epg-make-data-from-file cipher)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) @@ -1525,13 +1453,13 @@ If PLAIN is nil, it returns the result as a string." (defun epg-decrypt-string (context cipher) "Decrypt a string CIPHER and return the plain text." - (let ((input-file (epg--make-temp-file "epg-input")) + (let ((input-file (make-temp-file "epg-input")) (coding-system-for-write 'binary)) (unwind-protect (progn (write-region cipher nil input-file nil 'quiet) (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) + (make-temp-file "epg-output")) (epg-start-decrypt context (epg-make-data-from-file input-file)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) @@ -1602,7 +1530,7 @@ which will return a list of `epg-signature' object." (unwind-protect (progn (setf (epg-context-output-file context) - (or plain (epg--make-temp-file "epg-output"))) + (or plain (make-temp-file "epg-output"))) (if signed-text (epg-start-verify context (epg-make-data-from-file signature) @@ -1639,10 +1567,10 @@ which will return a list of `epg-signature' object." (unwind-protect (progn (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) + (make-temp-file "epg-output")) (if signed-text (progn - (setq input-file (epg--make-temp-file "epg-signature")) + (setq input-file (make-temp-file "epg-signature")) (write-region signature nil input-file nil 'quiet) (epg-start-verify context (epg-make-data-from-file input-file) @@ -1710,7 +1638,7 @@ Otherwise, it makes a cleartext signature." (unwind-protect (progn (setf (epg-context-output-file context) - (or signature (epg--make-temp-file "epg-output"))) + (or signature (make-temp-file "epg-output"))) (epg-start-sign context (epg-make-data-from-file plain) mode) (epg-wait-for-completion context) (unless (epg-context-result-for context 'sign) @@ -1730,12 +1658,12 @@ If it is nil or `normal', it makes a normal signature. Otherwise, it makes a cleartext signature." (let ((input-file (unless (eq (epg-context-protocol context) 'CMS) - (epg--make-temp-file "epg-input"))) + (make-temp-file "epg-input"))) (coding-system-for-write 'binary)) (unwind-protect (progn (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) + (make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-sign context @@ -1812,7 +1740,7 @@ If RECIPIENTS is nil, it performs symmetric encryption." (unwind-protect (progn (setf (epg-context-output-file context) - (or cipher (epg--make-temp-file "epg-output"))) + (or cipher (make-temp-file "epg-output"))) (epg-start-encrypt context (epg-make-data-from-file plain) recipients sign always-trust) (epg-wait-for-completion context) @@ -1837,12 +1765,12 @@ If RECIPIENTS is nil, it performs symmetric encryption." (let ((input-file (unless (or (not sign) (eq (epg-context-protocol context) 'CMS)) - (epg--make-temp-file "epg-input"))) + (make-temp-file "epg-input"))) (coding-system-for-write 'binary)) (unwind-protect (progn (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) + (make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-encrypt context @@ -1887,7 +1815,7 @@ If you are unsure, use synchronous version of this function (unwind-protect (progn (setf (epg-context-output-file context) - (or file (epg--make-temp-file "epg-output"))) + (or file (make-temp-file "epg-output"))) (epg-start-export-keys context keys) (epg-wait-for-completion context) (let ((errors (epg-context-result-for context 'error))) commit bab73230d1be1fe394b7269c1365ef6fb1a5d9b3 Author: Tino Calancha Date: Wed May 23 18:20:36 2018 +0900 Fix corner case in query-replace-regexp undo This commit fixes Bug#31492. * lisp/replace.el (replace-match-maybe-edit): Preserve match data. * test/lisp/replace-tests.el (query-replace-undo-bug31492): Add test. diff --git a/lisp/replace.el b/lisp/replace.el index 3503b656d9..a17dd19b0d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2214,6 +2214,10 @@ passed in. If LITERAL is set, no checking is done, anyway." noedit nil))) (set-match-data match-data) (replace-match newtext fixedcase literal) + ;; `query-replace' undo feature needs the beginning of the match position, + ;; but `replace-match' may change it, for instance, with a regexp like "^". + ;; Ensure that this function preserves the match data (Bug#31492). + (set-match-data match-data) ;; `replace-match' leaves point at the end of the replacement text, ;; so move point to the beginning when replacing backward. (when backward (goto-char (nth 0 match-data))) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 40a1a31cf7..40ee838e67 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -399,5 +399,25 @@ Each element has the format: ;; After undo text must be the same. (should (string= text (buffer-string)))))) +(ert-deftest query-replace-undo-bug31492 () + "Test for https://debbugs.gnu.org/31492 ." + (let ((text "a\nb\nc\n") + (count 0) + (inhibit-message t)) + (with-temp-buffer + (insert text) + (goto-char 1) + (cl-letf (((symbol-function 'read-event) + (lambda (&rest args) + (cl-incf count) + (let ((val (pcase count + ((or 1 2) ?\s) ; replace current and go next + (3 ?U) ; undo-all + (_ ?q)))) ; exit + val)))) + (perform-replace "^\\|\b\\|$" "foo" t t nil)) + ;; After undo text must be the same. + (should (string= text (buffer-string)))))) + ;;; replace-tests.el ends here