[Emacs-diffs] master 0cd250e: Fix recently extended delete-indentation behavior

[Basil L. Contovounesios]

branch: master
commit 0cd250e9583deb1e1f4d8dae2ec44c4f7c13efa6
Author: Basil L. Contovounesios <address@hidden>
Commit: Basil L. Contovounesios <address@hidden>

    Fix recently extended delete-indentation behavior
    
    * doc/lispref/text.texi (User-Level Deletion): Document new optional
    arguments of delete-indentation.
    
    * lisp/simple.el (delete-indentation): Do not barf if called
    interactively when region is inactive. (bug#35021)
    Do not skip blank lines. (bug#35036)
    Consistently deactivate mark even when no text was changed.
    Handle active region spanning a single line.
    
    * test/lisp/simple-tests.el (simple-test--buffer-substrings):
    New convenience function.
    (simple-test--dummy-buffer, simple-test--transpositions): Use it.
    (simple-delete-indentation-no-region)
    (simple-delete-indentation-inactive-region): Update commentary.
    Call delete-indentation interactively when testing for behavior with
    inactive region and region is not explicitly defined.
    (simple-delete-indentation-blank-line)
    (simple-delete-indentation-boundaries)
    (simple-delete-indentation-region)
    (simple-delete-indentation-prefix): New tests.
---
 doc/lispref/text.texi     |  10 ++-
 lisp/simple.el            |  54 ++++++++------
 test/lisp/simple-tests.el | 176 +++++++++++++++++++++++++++++++++++++---------
 3 files changed, 181 insertions(+), 59 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 21c5a73..b430adf 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -723,12 +723,18 @@ You thought
 @end example
 @end deffn
 
address@hidden Command delete-indentation &optional join-following-p
address@hidden Command delete-indentation &optional join-following-p beg end
 This function joins the line point is on to the previous line, deleting
 any whitespace at the join and in some cases replacing it with one
 space.  If @var{join-following-p} is address@hidden,
 @code{delete-indentation} joins this line to the following line
-instead.  The function returns @code{nil}.
+instead.  Otherwise, if @var{beg} and @var{end} are address@hidden,
+this function joins all lines in the region they define.
+
+In an interactive call, @var{join-following-p} is the prefix argument,
+and @var{beg} and @var{end} are, respectively, the start and end of
+the region if it is active, else @code{nil}.  The function returns
address@hidden
 
 If there is a fill prefix, and the second of the lines being joined
 starts with the prefix, then @code{delete-indentation} deletes the
diff --git a/lisp/simple.el b/lisp/simple.el
index f76f31a..306df96 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -598,30 +598,38 @@ When called from Lisp code, ARG may be a prefix string to 
copy."
 If there is a fill prefix, delete it from the beginning of this
 line.
 With prefix ARG, join the current line to the following line.
-If the region is active, join all the lines in the region.  (The
-region is ignored if prefix argument is given.)"
-  (interactive "*P\nr")
-  (if arg (forward-line 1)
-    (if (use-region-p)
-       (goto-char end)))
-  (beginning-of-line)
-  (while (eq (preceding-char) ?\n)
-    (progn
-      (delete-region (point) (1- (point)))
-      ;; If the second line started with the fill prefix,
+When BEG and END are non-nil, join all lines in the region they
+define.  Interactively, BEG and END are, respectively, the start
+and end of the region if it is active, else nil.  (The region is
+ignored if prefix ARG is given.)"
+  (interactive
+   (progn (barf-if-buffer-read-only)
+          (cons current-prefix-arg
+                (and (use-region-p)
+                     (list (region-beginning) (region-end))))))
+  ;; Consistently deactivate mark even when no text is changed.
+  (setq deactivate-mark t)
+  (if (and beg (not arg))
+      ;; Region is active.  Go to END, but only if region spans
+      ;; multiple lines.
+      (and (goto-char beg)
+           (> end (line-end-position))
+           (goto-char end))
+    ;; Region is inactive.  Set a loop sentinel
+    ;; (subtracting 1 in order to compare less than BOB).
+    (setq beg (1- (line-beginning-position (and arg 2))))
+    (when arg (forward-line)))
+  (let ((prefix (and (> (length fill-prefix) 0)
+                     (regexp-quote fill-prefix))))
+    (while (and (> (line-beginning-position) beg)
+                (forward-line 0)
+                (= (preceding-char) ?\n))
+      (delete-char -1)
+      ;; If the appended line started with the fill prefix,
       ;; delete the prefix.
-      (if (and fill-prefix
-              (<= (+ (point) (length fill-prefix)) (point-max))
-              (string= fill-prefix
-                       (buffer-substring (point)
-                                         (+ (point) (length fill-prefix)))))
-         (delete-region (point) (+ (point) (length fill-prefix))))
-      (fixup-whitespace)
-      (if (and (use-region-p)
-               beg
-               (not arg)
-              (< beg (point-at-bol)))
-         (beginning-of-line)))))
+      (if (and prefix (looking-at prefix))
+          (replace-match "" t t))
+      (fixup-whitespace))))
 
 (defalias 'join-line #'delete-indentation) ; easier to find
 
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index d9f059c..cc2feeb 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -22,6 +22,11 @@
 (require 'ert)
 (eval-when-compile (require 'cl-lib))
 
+(defun simple-test--buffer-substrings ()
+  "Return cons of buffer substrings before and after point."
+  (cons (buffer-substring (point-min) (point))
+        (buffer-substring (point) (point-max))))
+
 (defmacro simple-test--dummy-buffer (&rest body)
   (declare (indent 0)
            (debug t))
@@ -31,10 +36,7 @@
      (insert "(a b")
      (save-excursion (insert " c d)"))
      ,@body
-     (with-no-warnings
-       (cons (buffer-substring (point-min) (point))
-             (buffer-substring (point) (point-max))))))
-
+     (with-no-warnings (simple-test--buffer-substrings))))
 
 
 ;;; `transpose-sexps'
@@ -46,8 +48,7 @@
      (insert "(s1) (s2) (s3) (s4) (s5)")
      (backward-sexp 1)
      ,@body
-     (cons (buffer-substring (point-min) (point))
-           (buffer-substring (point) (point-max)))))
+     (simple-test--buffer-substrings)))
 
 ;;; Transposition with negative args (bug#20698, bug#21885)
 (ert-deftest simple-transpose-subr ()
@@ -215,37 +216,144 @@
 
 
 ;;; `delete-indentation'
+
 (ert-deftest simple-delete-indentation-no-region ()
-  "delete-indentation works when no mark is set."
-  ;; interactive \r returns nil for BEG END args
-  (unwind-protect
-      (with-temp-buffer
-        (insert (concat "zero line \n"
-                        "first line \n"
-                        "second line"))
-        (delete-indentation)
-        (should (string-equal
-                 (buffer-string)
-                 (concat "zero line \n"
-                         "first line second line")))
-        )))
+  "Test `delete-indentation' when no mark is set; see bug#35021."
+  (with-temp-buffer
+    (insert " first \n second \n third \n fourth ")
+    (should-not (mark t))
+    ;; Without prefix argument.
+    (should-not (call-interactively #'delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first \n second \n third" . " fourth ")))
+    (should-not (call-interactively #'delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first \n second" . " third fourth ")))
+    ;; With prefix argument.
+    (goto-char (point-min))
+    (let ((current-prefix-arg '(4)))
+      (should-not (call-interactively #'delete-indentation)))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first" . " second third fourth ")))))
 
 (ert-deftest simple-delete-indentation-inactive-region ()
-  "delete-indentation ignores inactive region."
-  ;; interactive \r returns non-nil for BEG END args
-  (unwind-protect
-      (with-temp-buffer
-        (insert (concat "zero line \n"
-                        "first line \n"
-                        "second line"))
-        (push-mark (point-min) t t)
-        (deactivate-mark)
-        (delete-indentation)
-        (should (string-equal
-                 (buffer-string)
-                 (concat "zero line \n"
-                         "first line second line")))
-        )))
+  "Test `delete-indentation'  with an inactive region."
+  (with-temp-buffer
+    (insert " first \n second \n third ")
+    (set-marker (mark-marker) (point-min))
+    (should (mark t))
+    (should-not (call-interactively #'delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first \n second" . " third ")))))
+
+(ert-deftest simple-delete-indentation-blank-line ()
+  "Test `delete-indentation' does not skip blank lines.
+See bug#35036."
+  (with-temp-buffer
+    (insert "\n\n third \n \n \n sixth \n\n")
+    ;; Without prefix argument.
+    (should-not (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("\n\n third \n \n \n sixth \n" . "")))
+    (should-not (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("\n\n third \n \n \n sixth" . "")))
+    (should-not (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("\n\n third \n \n" . "sixth")))
+    ;; With prefix argument.
+    (goto-char (point-min))
+    (should-not (delete-indentation t))
+    (should (equal (simple-test--buffer-substrings)
+                   '("" . "\n third \n \nsixth")))
+    (should-not (delete-indentation t))
+    (should (equal (simple-test--buffer-substrings)
+                   '("" . "third \n \nsixth")))
+    (should-not (delete-indentation t))
+    (should (equal (simple-test--buffer-substrings)
+                   '("third" . "\nsixth")))
+    (should-not (delete-indentation t))
+    (should (equal (simple-test--buffer-substrings)
+                   '("third" . " sixth")))))
+
+(ert-deftest simple-delete-indentation-boundaries ()
+  "Test `delete-indentation' motion at buffer boundaries."
+  (with-temp-buffer
+    (insert " first \n second \n third ")
+    ;; Stay at EOB.
+    (should-not (delete-indentation t))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first \n second \n third " . "")))
+    ;; Stay at BOB.
+    (forward-line -1)
+    (save-restriction
+      (narrow-to-region (point) (line-end-position))
+      (should-not (delete-indentation))
+      (should (equal (simple-test--buffer-substrings)
+                     '("" . " second ")))
+      ;; Go to EOB.
+      (should-not (delete-indentation t))
+      (should (equal (simple-test--buffer-substrings)
+                     '(" second " . ""))))
+    ;; Go to BOB.
+    (end-of-line 0)
+    (should-not (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("" . " first \n second \n third ")))))
+
+(ert-deftest simple-delete-indentation-region ()
+  "Test `delete-indentation' with an active region."
+  (with-temp-buffer
+    ;; Empty region.
+    (insert " first ")
+    (should-not (delete-indentation nil (point) (point)))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first " . "")))
+    ;; Single line.
+    (should-not (delete-indentation
+                 nil (line-beginning-position) (1- (point))))
+    (should (equal (simple-test--buffer-substrings)
+                   '("" . " first ")))
+    (should-not (delete-indentation nil (1+ (point)) (line-end-position)))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" " . "first ")))
+    (should-not (delete-indentation
+                 nil (line-beginning-position) (line-end-position)))
+    (should (equal (simple-test--buffer-substrings)
+                   '("" . " first ")))
+    ;; Multiple lines.
+    (goto-char (point-max))
+    (insert "\n second \n third \n fourth ")
+    (goto-char (point-min))
+    (should-not (delete-indentation
+                 nil (line-end-position) (line-beginning-position 2)))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first" . " second \n third \n fourth ")))
+    (should-not (delete-indentation
+                 nil (point) (1+ (line-beginning-position 2))))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first second" . " third \n fourth ")))
+    ;; Prefix argument overrides region.
+    (should-not (delete-indentation t (point-min) (point)))
+    (should (equal (simple-test--buffer-substrings)
+                   '(" first second third" . " fourth ")))))
+
+(ert-deftest simple-delete-indentation-prefix ()
+  "Test `delete-indentation' with a fill prefix."
+  (with-temp-buffer
+    (insert "> first \n> second \n> third \n> fourth ")
+    (let ((fill-prefix ""))
+      (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("> first \n> second \n> third" . " > fourth ")))
+    (let ((fill-prefix "<"))
+      (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("> first \n> second" . " > third > fourth ")))
+    (let ((fill-prefix ">"))
+      (delete-indentation))
+    (should (equal (simple-test--buffer-substrings)
+                   '("> first" . " second > third > fourth ")))))
 
 
 ;;; `delete-trailing-whitespace'