[Emacs-diffs] scratch/replace-region-contents 69f15b4: Improve replace-buffer-contents & replace-region-contents

[Tassilo Horn]

branch: scratch/replace-region-contents
commit 69f15b463f354de6d9347e751cc354023567500c
Author: Tassilo Horn <address@hidden>
Commit: Tassilo Horn <address@hidden>

    Improve replace-buffer-contents & replace-region-contents
    
    * src/editfns.c (Freplace_buffer_contents): New optional argument
      max_costs.
    * lisp/subr.el (replace-region-contents): Ditto.  Pass it though to
      replace-buffer-contents.
    * lisp/json.el (json-pretty-print): Call replace-region-contents with
      new max-costs argument.
---
 lisp/json.el  |  5 ++++-
 lisp/subr.el  |  9 +++++----
 src/editfns.c | 21 ++++++++++++---------
 3 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/lisp/json.el b/lisp/json.el
index 3271c37..cd8fe9a 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -749,7 +749,10 @@ With prefix argument MINIMIZE, minimize it instead."
         (json-object-type 'alist))
     (replace-region-contents
      begin end
-     (lambda () (json-encode (json-read))))))
+     (lambda () (json-encode (json-read)))
+     ;; FIXME: What's a good value here?  Can we use something better,
+     ;; e.g., by deriving a value from the size of the region?
+     64)))
 
 (defun json-pretty-print-buffer-ordered (&optional minimize)
   "Pretty-print current buffer with object keys ordered.
diff --git a/lisp/subr.el b/lisp/subr.el
index 44a1c60..af00344 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5476,12 +5476,13 @@ returned list are in the same order as in TREE.
 ;; for discoverability:
 (defalias 'flatten-list 'flatten-tree)
 
-(defun replace-region-contents (beg end replace-fn)
+(defun replace-region-contents (beg end replace-fn &optional max-costs)
   "Replace the region between BEG and END using REPLACE-FN.
 REPLACE-FN runs on the current buffer narrowed to the region.  It
 should return either a string or a buffer replacing the region.
 
-The replacement is performed using `replace-buffer-contents'.
+The replacement is performed using `replace-buffer-contents'
+which also describes the MAX-COSTS argument.
 
 Note: If the replacement is a string, it'll be placed in a
 temporary buffer so that `replace-buffer-contents' can operate on
@@ -5494,12 +5495,12 @@ it makes no sense to convert it to a string using
       (goto-char (point-min))
       (let ((repl (funcall replace-fn)))
        (if (bufferp repl)
-           (replace-buffer-contents repl)
+           (replace-buffer-contents repl max-costs)
          (let ((source-buffer (current-buffer)))
            (with-temp-buffer
              (insert repl)
              (let ((tmp-buffer (current-buffer)))
                (set-buffer source-buffer)
-               (replace-buffer-contents tmp-buffer)))))))))
+               (replace-buffer-contents tmp-buffer max-costs)))))))))
 
 ;;; subr.el ends here
diff --git a/src/editfns.c b/src/editfns.c
index 7a600ba..30c22ed 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1912,10 +1912,6 @@ determines whether case is significant or ignored.  */)
 #undef EQUAL
 #define USE_HEURISTIC
 
-#ifdef USE_HEURISTIC
-#define DIFFSEQ_HEURISTIC
-#endif
-
 /* Counter used to rarely_quit in replace-buffer-contents.  */
 static unsigned short rbc_quitcounter;
 
@@ -1951,16 +1947,19 @@ static bool buffer_chars_equal (struct context *, 
OFFSET, OFFSET);
 #include "diffseq.h"
 
 DEFUN ("replace-buffer-contents", Freplace_buffer_contents,
-       Sreplace_buffer_contents, 1, 1, "bSource buffer: ",
+       Sreplace_buffer_contents, 1, 2, "bSource buffer: ",
        doc: /* Replace accessible portion of current buffer with that of 
SOURCE.
 SOURCE can be a buffer or a string that names a buffer.
 Interactively, prompt for SOURCE.
+The optional argument MAX-COSTS defines the maximum costs of the
+difference computation.  If the costs are too high, heuristics are
+used to provide a much faster but suboptimal solution.
 As far as possible the replacement is non-destructive, i.e. existing
 buffer contents, markers, properties, and overlays in the current
 buffer stay intact.
 Warning: this function can be slow if there's a large number of small
 differences between the two buffers.  */)
-  (Lisp_Object source)
+  (Lisp_Object source, Lisp_Object max_costs)
 {
   struct buffer *a = current_buffer;
   Lisp_Object source_buffer = Fget_buffer (source);
@@ -2007,6 +2006,12 @@ differences between the two buffers.  */)
   ptrdiff_t *buffer;
   USE_SAFE_ALLOCA;
   SAFE_NALLOCA (buffer, 2, diags);
+
+  if (NILP (max_costs))
+    XSETFASTINT (max_costs, 1000000);
+  else
+    CHECK_FIXNUM (max_costs);
+
   /* Micro-optimization: Casting to size_t generates much better
      code.  */
   ptrdiff_t del_bytes = (size_t) size_a / CHAR_BIT + 1;
@@ -2022,11 +2027,9 @@ differences between the two buffers.  */)
     .insertions = SAFE_ALLOCA (ins_bytes),
     .fdiag = buffer + size_b + 1,
     .bdiag = buffer + diags + size_b + 1,
-#ifdef DIFFSEQ_HEURISTIC
     .heuristic = true,
-#endif
     /* FIXME: Find a good number for .too_expensive.  */
-    .too_expensive = 64,
+    .too_expensive = XFIXNUM (max_costs)
   };
   memclear (ctx.deletions, del_bytes);
   memclear (ctx.insertions, ins_bytes);