X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/743fa5cbdd42a820c4320599a14aab925dcdbc8b..0877d0dc24ee792b9b14592869ea1aa0934aee58:/lisp/simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 78b7657958..19140cba49 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,6 +1,6 @@
 ;;; simple.el --- basic editing commands for Emacs
 
-;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -2804,7 +2804,7 @@ value passed."
                      (or lc infile)
                      (if stderr-file (list (car buffer) stderr-file) buffer)
                      display args)
-            (when stderr-file (copy-file stderr-file (cadr buffer)))))
+            (when stderr-file (copy-file stderr-file (cadr buffer) t))))
       (when stderr-file (delete-file stderr-file))
       (when lc (delete-file lc)))))
 
@@ -3370,6 +3370,7 @@ to make one entry in the kill ring."
 	    (kill-new string nil yank-handler)))
 	(when (or string (eq last-command 'kill-region))
 	  (setq this-command 'kill-region))
+	(setq deactivate-mark t)
 	nil)
     ((buffer-read-only text-read-only)
      ;; The code above failed because the buffer, or some of the characters
@@ -5299,14 +5300,21 @@ current object."
       (setq pos1 pos2 pos2 swap)))
   (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
   (atomic-change-group
-   (let (word2)
-     ;; FIXME: We first delete the two pieces of text, so markers that
-     ;; used to point to after the text end up pointing to before it :-(
-     (setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
-     (goto-char (car pos2))
-     (insert (delete-and-extract-region (car pos1) (cdr pos1)))
-     (goto-char (car pos1))
-     (insert word2))))
+    ;; This sequence of insertions attempts to preserve marker
+    ;; positions at the start and end of the transposed objects.
+    (let* ((word (buffer-substring (car pos2) (cdr pos2)))
+	   (len1 (- (cdr pos1) (car pos1)))
+	   (len2 (length word))
+	   (boundary (make-marker)))
+      (set-marker boundary (car pos2))
+      (goto-char (cdr pos1))
+      (insert-before-markers word)
+      (setq word (delete-and-extract-region (car pos1) (+ (car pos1) len1)))
+      (goto-char boundary)
+      (insert word)
+      (goto-char (+ boundary len1))
+      (delete-region (point) (+ (point) len2))
+      (set-marker boundary nil))))
 
 (defun backward-word (&optional arg)
   "Move backward until encountering the beginning of a word.