Subject: Re: bug#25355: 26.0.50; Provide function to non-destructively replace buffer contents

From: Philipp Stephani <[email-masked]>
Date: Mon, 12 Jun 2017 21:17:38 +0000

Philipp Stephani <[email-masked]> schrieb am So., 7. Mai 2017 um
20:21 Uhr:

>
>
>> P.S. Doesn't GNU Diff have code to do this?
>
>
> Sure, but it's not a library. libmba was the only library that I've found
> so far with a usable interface (i.e. that doesn't assume that the input
> sequences are byte arrays).
>
>

Apparently I didn't look closely enough: Diffutils uses an implementation
of the Myers algorithm from Gnulib, which is customizable enough to fit our
needs. I've attached a patch that uses Gnulib.
From 0933c45c9ae9db2e7a686f76747ed033849244be Mon Sep 17 00:00:00 2001
From: Philipp Stephani <[email-masked]>
Date: Sun, 7 May 2017 21:01:53 +0200
Subject: [PATCH] Add command to replace buffer contents

Add a new command 'replace-buffer-contents' that uses the Myers diff
algorithm to non-destructively replace the accessible portion of the
current buffer.  The Myers algorithm is implemented in Gnulib.

* src/editfns.c (Freplace_buffer_contents): New command.
(buffer_chars_equal): New helper function.
(syms_of_editfns): Define new command.

* test/src/editfns-tests.el (replace-buffer-contents-1)
(replace-buffer-contents-2): New unit tests.
---
 etc/NEWS                  |   5 +
 lib/diffseq.h             | 525 ++++++++++++++++++++++++++++++++++++++++++++++
 lib/minmax.h              |  60 ++++++
 src/editfns.c             | 179 ++++++++++++++++
 test/src/editfns-tests.el |  31 +++
 5 files changed, 800 insertions(+)
 create mode 100644 lib/diffseq.h
 create mode 100644 lib/minmax.h

diff --git a/etc/NEWS b/etc/NEWS
index feed62c1ca..838ffb8ddc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -462,6 +462,11 @@ Negative prefix arg flips the direction of selection.  Also,
 defun are selected unless they are separated from the defun by a blank
 line.
 
+** New command 'replace-buffer-contents'.  This command replaces the
+contents of theaccessible portion of the current buffer with the
+contents of the accessible portion of a different buffer while keeping
+point, mark, markers, and text properties as intact as possible.
+
 
 * Changes in Specialized Modes and Packages in Emacs 26.1
 
diff --git a/lib/diffseq.h b/lib/diffseq.h
new file mode 100644
index 0000000000..d7a374357c
--- /dev/null
+++ b/lib/diffseq.h
@@ -0,0 +1,525 @@
+/* Analyze differences between two vectors.
+
+   Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2017 Free Software
+   Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+
+/* The basic idea is to consider two vectors as similar if, when
+   transforming the first vector into the second vector through a
+   sequence of edits (inserts and deletes of one element each),
+   this sequence is short - or equivalently, if the ordered list
+   of elements that are untouched by these edits is long.  For a
+   good introduction to the subject, read about the "Levenshtein
+   distance" in Wikipedia.
+
+   The basic algorithm is described in:
+   "An O(ND) Difference Algorithm and its Variations", Eugene W. Myers,
+   Algorithmica Vol. 1, 1986, pp. 251-266,
+   <http://dx.doi.org/10.1007/BF01840446>.
+   See especially section 4.2, which describes the variation used below.
+
+   The basic algorithm was independently discovered as described in:
+   "Algorithms for Approximate String Matching", Esko Ukkonen,
+   Information and Control Vol. 64, 1985, pp. 100-118,
+   <http://dx.doi.org/10.1016/S0019-9958(85)80046-2>.
+
+   Unless the 'find_minimal' flag is set, this code uses the TOO_EXPENSIVE
+   heuristic, by Paul Eggert, to limit the cost to O(N**1.5 log N)
+   at the price of producing suboptimal output for large inputs with
+   many differences.  */
+
+/* Before including this file, you need to define:
+     ELEMENT                 The element type of the vectors being compared.
+     EQUAL                   A two-argument macro that tests two elements for
+                             equality.
+     OFFSET                  A signed integer type sufficient to hold the
+                             difference between two indices.  Usually
+                             something like ptrdiff_t.
+     EXTRA_CONTEXT_FIELDS    Declarations of fields for 'struct context'.
+     NOTE_DELETE(ctxt, xoff) Record the removal of the object xvec[xoff].
+     NOTE_INSERT(ctxt, yoff) Record the insertion of the object yvec[yoff].
+     EARLY_ABORT(ctxt)       (Optional) A boolean expression that triggers an
+                             early abort of the computation.
+     USE_HEURISTIC           (Optional) Define if you want to support the
+                             heuristic for large vectors.
+   It is also possible to use this file with abstract arrays.  In this case,
+   xvec and yvec are not represented in memory.  They only exist conceptually.
+   In this case, the list of defines above is amended as follows:
+     ELEMENT                 Undefined.
+     EQUAL                   Undefined.
+     XVECREF_YVECREF_EQUAL(ctxt, xoff, yoff)
+                             A three-argument macro: References xvec[xoff] and
+                             yvec[yoff] and tests these elements for equality.
+   Before including this file, you also need to include:
+     #include <limits.h>
+     #include <stdbool.h>
+     #include "minmax.h"
+ */
+
+/* Maximum value of type OFFSET.  */
+#define OFFSET_MAX \
+  ((((OFFSET)1 << (sizeof (OFFSET) * CHAR_BIT - 2)) - 1) * 2 + 1)
+
+/* Default to no early abort.  */
+#ifndef EARLY_ABORT
+# define EARLY_ABORT(ctxt) false
+#endif
+
+/* Use this to suppress gcc's "...may be used before initialized" warnings.
+   Beware: The Code argument must not contain commas.  */
+#ifndef IF_LINT
+# if defined GCC_LINT || defined lint
+#  define IF_LINT(Code) Code
+# else
+#  define IF_LINT(Code) /* empty */
+# endif
+#endif
+
+/* As above, but when Code must contain one comma. */
+#ifndef IF_LINT2
+# if defined GCC_LINT || defined lint
+#  define IF_LINT2(Code1, Code2) Code1, Code2
+# else
+#  define IF_LINT2(Code1, Code2) /* empty */
+# endif
+#endif
+
+/*
+ * Context of comparison operation.
+ */
+struct context
+{
+  #ifdef ELEMENT
+  /* Vectors being compared.  */
+  ELEMENT const *xvec;
+  ELEMENT const *yvec;
+  #endif
+
+  /* Extra fields.  */
+  EXTRA_CONTEXT_FIELDS
+
+  /* Vector, indexed by diagonal, containing 1 + the X coordinate of the point
+     furthest along the given diagonal in the forward search of the edit
+     matrix.  */
+  OFFSET *fdiag;
+
+  /* Vector, indexed by diagonal, containing the X coordinate of the point
+     furthest along the given diagonal in the backward search of the edit
+     matrix.  */
+  OFFSET *bdiag;
+
+  #ifdef USE_HEURISTIC
+  /* This corresponds to the diff --speed-large-files flag.  With this
+     heuristic, for vectors with a constant small density of changes,
+     the algorithm is linear in the vector size.  */
+  bool heuristic;
+  #endif
+
+  /* Edit scripts longer than this are too expensive to compute.  */
+  OFFSET too_expensive;
+
+  /* Snakes bigger than this are considered "big".  */
+  #define SNAKE_LIMIT 20
+};
+
+struct partition
+{
+  /* Midpoints of this partition.  */
+  OFFSET xmid;
+  OFFSET ymid;
+
+  /* True if low half will be analyzed minimally.  */
+  bool lo_minimal;
+
+  /* Likewise for high half.  */
+  bool hi_minimal;
+};
+
+
+/* Find the midpoint of the shortest edit script for a specified portion
+   of the two vectors.
+
+   Scan from the beginnings of the vectors, and simultaneously from the ends,
+   doing a breadth-first search through the space of edit-sequence.
+   When the two searches meet, we have found the midpoint of the shortest
+   edit sequence.
+
+   If FIND_MINIMAL is true, find the minimal edit script regardless of
+   expense.  Otherwise, if the search is too expensive, use heuristics to
+   stop the search and report a suboptimal answer.
+
+   Set PART->(xmid,ymid) to the midpoint (XMID,YMID).  The diagonal number
+   XMID - YMID equals the number of inserted elements minus the number
+   of deleted elements (counting only elements before the midpoint).
+
+   Set PART->lo_minimal to true iff the minimal edit script for the
+   left half of the partition is known; similarly for PART->hi_minimal.
+
+   This function assumes that the first elements of the specified portions
+   of the two vectors do not match, and likewise that the last elements do not
+   match.  The caller must trim matching elements from the beginning and end
+   of the portions it is going to specify.
+
+   If we return the "wrong" partitions, the worst this can do is cause
+   suboptimal diff output.  It cannot cause incorrect diff output.  */
+
+static void
+diag (OFFSET xoff, OFFSET xlim, OFFSET yoff, OFFSET ylim, bool find_minimal,
+      struct partition *part, struct context *ctxt)
+{
+  OFFSET *const fd = ctxt->fdiag;       /* Give the compiler a chance. */
+  OFFSET *const bd = ctxt->bdiag;       /* Additional help for the compiler. */
+#ifdef ELEMENT
+  ELEMENT const *const xv = ctxt->xvec; /* Still more help for the compiler. */
+  ELEMENT const *const yv = ctxt->yvec; /* And more and more . . . */
+  #define XREF_YREF_EQUAL(x,y)  EQUAL (xv[x], yv[y])
+#else
+  #define XREF_YREF_EQUAL(x,y)  XVECREF_YVECREF_EQUAL (ctxt, x, y)
+#endif
+  const OFFSET dmin = xoff - ylim;      /* Minimum valid diagonal. */
+  const OFFSET dmax = xlim - yoff;      /* Maximum valid diagonal. */
+  const OFFSET fmid = xoff - yoff;      /* Center diagonal of top-down search. */
+  const OFFSET bmid = xlim - ylim;      /* Center diagonal of bottom-up search. */
+  OFFSET fmin = fmid;
+  OFFSET fmax = fmid;           /* Limits of top-down search. */
+  OFFSET bmin = bmid;
+  OFFSET bmax = bmid;           /* Limits of bottom-up search. */
+  OFFSET c;                     /* Cost. */
+  bool odd = (fmid - bmid) & 1; /* True if southeast corner is on an odd
+                                   diagonal with respect to the northwest. */
+
+  fd[fmid] = xoff;
+  bd[bmid] = xlim;
+
+  for (c = 1;; ++c)
+    {
+      OFFSET d;                 /* Active diagonal. */
+      bool big_snake = false;
+
+      /* Extend the top-down search by an edit step in each diagonal. */
+      if (fmin > dmin)
+        fd[--fmin - 1] = -1;
+      else
+        ++fmin;
+      if (fmax < dmax)
+        fd[++fmax + 1] = -1;
+      else
+        --fmax;
+      for (d = fmax; d >= fmin; d -= 2)
+        {
+          OFFSET x;
+          OFFSET y;
+          OFFSET tlo = fd[d - 1];
+          OFFSET thi = fd[d + 1];
+          OFFSET x0 = tlo < thi ? thi : tlo + 1;
+
+          for (x = x0, y = x0 - d;
+               x < xlim && y < ylim && XREF_YREF_EQUAL (x, y);
+               x++, y++)
+            continue;
+          if (x - x0 > SNAKE_LIMIT)
+            big_snake = true;
+          fd[d] = x;
+          if (odd && bmin <= d && d <= bmax && bd[d] <= x)
+            {
+              part->xmid = x;
+              part->ymid = y;
+              part->lo_minimal = part->hi_minimal = true;
+              return;
+            }
+        }
+
+      /* Similarly extend the bottom-up search.  */
+      if (bmin > dmin)
+        bd[--bmin - 1] = OFFSET_MAX;
+      else
+        ++bmin;
+      if (bmax < dmax)
+        bd[++bmax + 1] = OFFSET_MAX;
+      else
+        --bmax;
+      for (d = bmax; d >= bmin; d -= 2)
+        {
+          OFFSET x;
+          OFFSET y;
+          OFFSET tlo = bd[d - 1];
+          OFFSET thi = bd[d + 1];
+          OFFSET x0 = tlo < thi ? tlo : thi - 1;
+
+          for (x = x0, y = x0 - d;
+               xoff < x && yoff < y && XREF_YREF_EQUAL (x - 1, y - 1);
+               x--, y--)
+            continue;
+          if (x0 - x > SNAKE_LIMIT)
+            big_snake = true;
+          bd[d] = x;
+          if (!odd && fmin <= d && d <= fmax && x <= fd[d])
+            {
+              part->xmid = x;
+              part->ymid = y;
+              part->lo_minimal = part->hi_minimal = true;
+              return;
+            }
+        }
+
+      if (find_minimal)
+        continue;
+
+#ifdef USE_HEURISTIC
+      /* Heuristic: check occasionally for a diagonal that has made lots
+         of progress compared with the edit distance.  If we have any
+         such, find the one that has made the most progress and return it
+         as if it had succeeded.
+
+         With this heuristic, for vectors with a constant small density
+         of changes, the algorithm is linear in the vector size.  */
+
+      if (200 < c && big_snake && ctxt->heuristic)
+        {
+          {
+            OFFSET best = 0;
+
+            for (d = fmax; d >= fmin; d -= 2)
+              {
+                OFFSET dd = d - fmid;
+                OFFSET x = fd[d];
+                OFFSET y = x - d;
+                OFFSET v = (x - xoff) * 2 - dd;
+
+                if (v > 12 * (c + (dd < 0 ? -dd : dd)))
+                  {
+                    if (v > best
+                        && xoff + SNAKE_LIMIT <= x && x < xlim
+                        && yoff + SNAKE_LIMIT <= y && y < ylim)
+                      {
+                        /* We have a good enough best diagonal; now insist
+                           that it end with a significant snake.  */
+                        int k;
+
+                        for (k = 1; XREF_YREF_EQUAL (x - k, y - k); k++)
+                          if (k == SNAKE_LIMIT)
+                            {
+                              best = v;
+                              part->xmid = x;
+                              part->ymid = y;
+                              break;
+                            }
+                      }
+                  }
+              }
+            if (best > 0)
+              {
+                part->lo_minimal = true;
+                part->hi_minimal = false;
+                return;
+              }
+          }
+
+          {
+            OFFSET best = 0;
+
+            for (d = bmax; d >= bmin; d -= 2)
+              {
+                OFFSET dd = d - bmid;
+                OFFSET x = bd[d];
+                OFFSET y = x - d;
+                OFFSET v = (xlim - x) * 2 + dd;
+
+                if (v > 12 * (c + (dd < 0 ? -dd : dd)))
+                  {
+                    if (v > best
+                        && xoff < x && x <= xlim - SNAKE_LIMIT
+                        && yoff < y && y <= ylim - SNAKE_LIMIT)
+                      {
+                        /* We have a good enough best diagonal; now insist
+                           that it end with a significant snake.  */
+                        int k;
+
+                        for (k = 0; XREF_YREF_EQUAL (x + k, y + k); k++)
+                          if (k == SNAKE_LIMIT - 1)
+                            {
+                              best = v;
+                              part->xmid = x;
+                              part->ymid = y;
+                              break;
+                            }
+                      }
+                  }
+              }
+            if (best > 0)
+              {
+                part->lo_minimal = false;
+                part->hi_minimal = true;
+                return;
+              }
+          }
+        }
+#endif /* USE_HEURISTIC */
+
+      /* Heuristic: if we've gone well beyond the call of duty, give up
+         and report halfway between our best results so far.  */
+      if (c >= ctxt->too_expensive)
+        {
+          OFFSET fxybest;
+          OFFSET fxbest IF_LINT (= 0);
+          OFFSET bxybest;
+          OFFSET bxbest IF_LINT (= 0);
+
+          /* Find forward diagonal that maximizes X + Y.  */
+          fxybest = -1;
+          for (d = fmax; d >= fmin; d -= 2)
+            {
+              OFFSET x = MIN (fd[d], xlim);
+              OFFSET y = x - d;
+              if (ylim < y)
+                {
+                  x = ylim + d;
+                  y = ylim;
+                }
+              if (fxybest < x + y)
+                {
+                  fxybest = x + y;
+                  fxbest = x;
+                }
+            }
+
+          /* Find backward diagonal that minimizes X + Y.  */
+          bxybest = OFFSET_MAX;
+          for (d = bmax; d >= bmin; d -= 2)
+            {
+              OFFSET x = MAX (xoff, bd[d]);
+              OFFSET y = x - d;
+              if (y < yoff)
+                {
+                  x = yoff + d;
+                  y = yoff;
+                }
+              if (x + y < bxybest)
+                {
+                  bxybest = x + y;
+                  bxbest = x;
+                }
+            }
+
+          /* Use the better of the two diagonals.  */
+          if ((xlim + ylim) - bxybest < fxybest - (xoff + yoff))
+            {
+              part->xmid = fxbest;
+              part->ymid = fxybest - fxbest;
+              part->lo_minimal = true;
+              part->hi_minimal = false;
+            }
+          else
+            {
+              part->xmid = bxbest;
+              part->ymid = bxybest - bxbest;
+              part->lo_minimal = false;
+              part->hi_minimal = true;
+            }
+          return;
+        }
+    }
+  #undef XREF_YREF_EQUAL
+}
+
+
+/* Compare in detail contiguous subsequences of the two vectors
+   which are known, as a whole, to match each other.
+
+   The subsequence of vector 0 is [XOFF, XLIM) and likewise for vector 1.
+
+   Note that XLIM, YLIM are exclusive bounds.  All indices into the vectors
+   are origin-0.
+
+   If FIND_MINIMAL, find a minimal difference no matter how
+   expensive it is.
+
+   The results are recorded by invoking NOTE_DELETE and NOTE_INSERT.
+
+   Return false if terminated normally, or true if terminated through early
+   abort.  */
+
+static bool
+compareseq (OFFSET xoff, OFFSET xlim, OFFSET yoff, OFFSET ylim,
+            bool find_minimal, struct context *ctxt)
+{
+#ifdef ELEMENT
+  ELEMENT const *xv = ctxt->xvec; /* Help the compiler.  */
+  ELEMENT const *yv = ctxt->yvec;
+  #define XREF_YREF_EQUAL(x,y)  EQUAL (xv[x], yv[y])
+#else
+  #define XREF_YREF_EQUAL(x,y)  XVECREF_YVECREF_EQUAL (ctxt, x, y)
+#endif
+
+  /* Slide down the bottom initial diagonal.  */
+  while (xoff < xlim && yoff < ylim && XREF_YREF_EQUAL (xoff, yoff))
+    {
+      xoff++;
+      yoff++;
+    }
+
+  /* Slide up the top initial diagonal. */
+  while (xoff < xlim && yoff < ylim && XREF_YREF_EQUAL (xlim - 1, ylim - 1))
+    {
+      xlim--;
+      ylim--;
+    }
+
+  /* Handle simple cases. */
+  if (xoff == xlim)
+    while (yoff < ylim)
+      {
+        NOTE_INSERT (ctxt, yoff);
+        if (EARLY_ABORT (ctxt))
+          return true;
+        yoff++;
+      }
+  else if (yoff == ylim)
+    while (xoff < xlim)
+      {
+        NOTE_DELETE (ctxt, xoff);
+        if (EARLY_ABORT (ctxt))
+          return true;
+        xoff++;
+      }
+  else
+    {
+      struct partition part IF_LINT2 (= { .xmid = 0, .ymid = 0 });
+
+      /* Find a point of correspondence in the middle of the vectors.  */
+      diag (xoff, xlim, yoff, ylim, find_minimal, &part, ctxt);
+
+      /* Use the partitions to split this problem into subproblems.  */
+      if (compareseq (xoff, part.xmid, yoff, part.ymid, part.lo_minimal, ctxt))
+        return true;
+      if (compareseq (part.xmid, xlim, part.ymid, ylim, part.hi_minimal, ctxt))
+        return true;
+    }
+
+  return false;
+  #undef XREF_YREF_EQUAL
+}
+
+#undef ELEMENT
+#undef EQUAL
+#undef OFFSET
+#undef EXTRA_CONTEXT_FIELDS
+#undef NOTE_DELETE
+#undef NOTE_INSERT
+#undef EARLY_ABORT
+#undef USE_HEURISTIC
+#undef XVECREF_YVECREF_EQUAL
+#undef OFFSET_MAX
diff --git a/lib/minmax.h b/lib/minmax.h
new file mode 100644
index 0000000000..929184a5eb
--- /dev/null
+++ b/lib/minmax.h
@@ -0,0 +1,60 @@
+/* MIN, MAX macros.
+   Copyright (C) 1995, 1998, 2001, 2003, 2005, 2009-2017 Free Software
+   Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _MINMAX_H
+#define _MINMAX_H
+
+/* Note: MIN, MAX are also defined in <sys/param.h> on some systems
+   (glibc, IRIX, HP-UX, OSF/1).  Therefore you might get warnings about
+   MIN, MAX macro redefinitions on some systems; the workaround is to
+   #include this file as the last one among the #include list.  */
+
+/* Before we define the following symbols we get the <limits.h> file
+   since otherwise we get redefinitions on some systems if <limits.h> is
+   included after this file.  Likewise for <sys/param.h>.
+   If more than one of these system headers define MIN and MAX, pick just
+   one of the headers (because the definitions most likely are the same).  */
+#if HAVE_MINMAX_IN_LIMITS_H
+# include <limits.h>
+#elif HAVE_MINMAX_IN_SYS_PARAM_H
+# include <sys/param.h>
+#endif
+
+/* Note: MIN and MAX should be used with two arguments of the
+   same type.  They might not return the minimum and maximum of their two
+   arguments, if the arguments have different types or have unusual
+   floating-point values.  For example, on a typical host with 32-bit 'int',
+   64-bit 'long long', and 64-bit IEEE 754 'double' types:
+
+     MAX (-1, 2147483648) returns 4294967295.
+     MAX (9007199254740992.0, 9007199254740993) returns 9007199254740992.0.
+     MAX (NaN, 0.0) returns 0.0.
+     MAX (+0.0, -0.0) returns -0.0.
+
+   and in each case the answer is in some sense bogus.  */
+
+/* MAX(a,b) returns the maximum of A and B.  */
+#ifndef MAX
+# define MAX(a,b) ((a) > (b) ? (a) : (b))
+#endif
+
+/* MIN(a,b) returns the minimum of A and B.  */
+#ifndef MIN
+# define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
+#endif /* _MINMAX_H */
diff --git a/src/editfns.c b/src/editfns.c
index 43b17f9f11..f4e923ce89 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3105,6 +3105,184 @@ determines whether case is significant or ignored.  */)
   /* Same length too => they are equal.  */
   return make_number (0);
 }
+
+
+/* Set up necessary definitions for diffseq.h; see comments in
+   diffseq.h for explanation.  */
+
+#undef ELEMENT
+#undef EQUAL
+
+#define XVECREF_YVECREF_EQUAL(ctx, xoff, yoff)  \
+  buffer_chars_equal ((ctx), (xoff), (yoff))
+
+#define OFFSET ptrdiff_t
+
+#define EXTRA_CONTEXT_FIELDS                    \
+  /* Buffers to compare.  */                    \
+  struct buffer *buffer_a;                      \
+  struct buffer *buffer_b;                      \
+  /* Boolean vectors recording for each character whether it was
+     deleted or inserted.  */                   \
+  Lisp_Object deletions;                        \
+  Lisp_Object insertions;
+
+#define NOTE_DELETE(ctx, xoff) bool_vector_set ((ctx)->deletions, (xoff), true)
+#define NOTE_INSERT(ctx, yoff) bool_vector_set ((ctx)->insertions, (yoff), true)
+
+struct context;
+static bool buffer_chars_equal (struct context *, ptrdiff_t, ptrdiff_t);
+
+#include "minmax.h"
+#include "diffseq.h"
+
+DEFUN ("replace-buffer-contents", Freplace_buffer_contents,
+       Sreplace_buffer_contents, 1, 1, "bSource buffer: ",
+       doc: /* Replace accessible portion of the current buffer with accessible portion of SOURCE.
+As far as possible the replacement is non-destructive, i.e. existing
+buffer contents, markers, properties, and overlays in the current
+buffer stay intact.  */)
+  (Lisp_Object source)
+{
+  struct buffer *a = current_buffer;
+  Lisp_Object source_buffer = Fget_buffer (source);
+  if (NILP (source_buffer))
+    nsberror (source);
+  struct buffer *b = XBUFFER (source_buffer);
+  if (! BUFFER_LIVE_P (b))
+    error ("Selecting deleted buffer");
+  if (a == b)
+    error ("Cannot replace a buffer with itself");
+
+  ptrdiff_t min_a = BEGV;
+  ptrdiff_t min_b = BUF_BEGV (b);
+  ptrdiff_t size_a = ZV - min_a;
+  ptrdiff_t size_b = BUF_ZV (b) - min_b;
+  bool a_empty = size_a == 0;
+  bool b_empty = size_b == 0;
+
+  /* Handle trivial cases where at least one accessible portion is
+     empty.  */
+
+  if (a_empty && b_empty)
+    return Qnil;
+
+  if (a_empty)
+    return Finsert_buffer_substring (source, Qnil, Qnil);
+
+  if (b_empty)
+    {
+      del_range_both (BEGV, BEGV_BYTE, ZV, ZV_BYTE, true);
+      return Qnil;
+    }
+
+  /* FIXME: It is not documented how to initialize the contents of the
+     context structure.  This code cargo-cults from the existing
+     caller in src/analyze.c of GNU Diffutils, which appears to
+     work.  */
+
+  ptrdiff_t diags = size_a + size_b + 3;
+  ptrdiff_t *buffer;
+  USE_SAFE_ALLOCA;
+  SAFE_NALLOCA (buffer, 2, diags);
+  struct context ctx = {
+    .buffer_a = a,
+    .buffer_b = b,
+    .insertions = bool_vector_fill (make_uninit_bool_vector (size_b), Qnil),
+    .deletions = bool_vector_fill (make_uninit_bool_vector (size_a), Qnil),
+    .fdiag = buffer + size_b + 1,
+    .bdiag = buffer + diags + size_b + 1,
+    /* FIXME: Find a good number for .too_expensive.  */
+    .too_expensive = 1000000,
+  };
+  /* compareseq requires indices to be zero-based.  We add BEGV back
+     later.  */
+  bool early_abort = compareseq (0, size_a, 0, size_b, false, &ctx);
+  /* Since we didn’t define EARLY_ABORT, we should never abort
+     early.  */
+  eassert (! early_abort);
+  SAFE_FREE ();
+
+  Fundo_boundary ();
+  ptrdiff_t count = SPECPDL_INDEX ();
+  record_unwind_protect (save_excursion_restore, save_excursion_save ());
+
+  SET_PT_BOTH (BEGV, BEGV_BYTE);
+  ptrdiff_t i = size_a;
+  ptrdiff_t j = size_b;
+  /* Walk backwards through the lists of changes.  This was also
+     cargo-culted from src/analyze.c in GNU Diffutils.  Because we
+     walk backwards, we don’t have to keep the positions in sync.  */
+  while (i >= 0 || j >= 0)
+    {
+      /* Check whether there is a change (insertion or deletion)
+         before the current position.  */
+      if ((i > 0 && bool_vector_bitref (ctx.deletions, i - 1)) ||
+          (j > 0 && bool_vector_bitref (ctx.insertions, j - 1)))
+	{
+          ptrdiff_t end_a = min_a + i;
+          ptrdiff_t end_b = min_b + j;
+          /* Find the beginning of the current change run.  */
+	  while (i > 0 && bool_vector_bitref (ctx.deletions, i - 1))
+            --i;
+	  while (j > 0 && bool_vector_bitref (ctx.insertions, j - 1))
+            --j;
+          ptrdiff_t beg_a = min_a + i;
+          ptrdiff_t beg_b = min_b + j;
+          eassert (beg_a >= BEGV);
+          eassert (beg_b >= BUF_BEGV (b));
+          eassert (beg_a <= end_a);
+          eassert (beg_b <= end_b);
+          eassert (end_a <= ZV);
+          eassert (end_b <= BUF_ZV (b));
+          eassert (beg_a < end_a || beg_b < end_b);
+          if (beg_a < end_a)
+            del_range (beg_a, end_a);
+          if (beg_b < end_b)
+            {
+              SET_PT (beg_a);
+              Finsert_buffer_substring (source, make_natnum (beg_b),
+                                        make_natnum (end_b));
+            }
+	}
+      --i;
+      --j;
+    }
+
+  return unbind_to (count, Qnil);
+}
+
+/* Return true if the characters at position POS_A of buffer
+   CTX->buffer_a and at position POS_B of buffer CTX->buffer_b are
+   equal including properties.  POS_A and POS_B are zero-based.  */
+
+static bool
+buffer_chars_equal (struct context *ctx,
+                    ptrdiff_t pos_a, ptrdiff_t pos_b)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+  record_unwind_current_buffer ();
+
+  /* We can’t use ‘compare-buffer-substrings’ because that doesn’t
+     take properties into account.  */
+
+  set_buffer_internal (ctx->buffer_a);
+  pos_a += BEGV;
+  eassert (pos_a >= BEGV);
+  eassert (pos_a < ZV);
+  Lisp_Object char_a = make_buffer_string (pos_a, pos_a + 1, true);
+
+  set_buffer_internal (ctx->buffer_b);
+  pos_b += BEGV;
+  eassert (pos_b >= BEGV);
+  eassert (pos_b < ZV);
+  Lisp_Object char_b = make_buffer_string (pos_b, pos_b + 1, true);
+
+  bool result = EQ (Fequal_including_properties (char_a, char_b), Qt);
+  unbind_to (count, Qnil);
+  return result;
+}
+
 
 static void
 subst_char_in_region_unwind (Lisp_Object arg)
@@ -5315,6 +5493,7 @@ functions if all the text being accessed has this property.  */);
 
   defsubr (&Sinsert_buffer_substring);
   defsubr (&Scompare_buffer_substrings);
+  defsubr (&Sreplace_buffer_contents);
   defsubr (&Ssubst_char_in_region);
   defsubr (&Stranslate_region_internal);
   defsubr (&Sdelete_region);
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 3073e37193..a3ea8ab60b 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -208,4 +208,35 @@ transpose-test-get-byte-positions
                  '(error "Invalid format operation %$")))
   (should (equal (format "%1$c %1$s" ?±) "± 177")))
 
+(ert-deftest replace-buffer-contents-1 ()
+  (with-temp-buffer
+    (insert #("source" 2 4 (prop 7)))
+    (let ((source (current-buffer)))
+      (with-temp-buffer
+        (insert "before dest after")
+        (let ((marker (set-marker (make-marker) 14)))
+          (save-restriction
+            (narrow-to-region 8 12)
+            (replace-buffer-contents source))
+          (should (equal (marker-buffer marker) (current-buffer)))
+          (should (equal (marker-position marker) 16)))
+        (should (equal-including-properties
+                 (buffer-string)
+                 #("before source after" 9 11 (prop 7))))
+        (should (equal (point) 9))))
+    (should (equal-including-properties
+             (buffer-string)
+             #("source" 2 4 (prop 7))))))
+
+(ert-deftest replace-buffer-contents-2 ()
+  (with-temp-buffer
+    (insert "foo bar baz qux")
+    (let ((source (current-buffer)))
+      (with-temp-buffer
+        (insert "foo BAR baz qux")
+        (replace-buffer-contents source)
+        (should (equal-including-properties
+                 (buffer-string)
+                 "foo bar baz qux"))))))
+
 ;;; editfns-tests.el ends here
-- 
2.13.1