bug#21072: Brave new mark-defun (and a testing tool)

[Marcin Borkowski <mbork@mbork.pl>]

[-- Attachment #1: Type: text/plain, Size: 539 bytes --]


On 2017-02-13, at 20:00, John Wiegley <jwiegley@gmail.com> wrote:

>>>>>> Dmitry Gutov <dgutov@yandex.ru> writes:
>
>> I'd rather interpret John as being entirely serious. :) Tests are good.
>
> Dmitry is quite right; any patch that comes with a battery of new tests is
> already a huge plus in my book.

Thanks - as I said, I was a bit unsure;-).

Here's my proposed contribution, formatted as two patches.  The first
one introduces the testing machinery; the second one introduces
mark-defun and its tests.

WDYT?

-- 
Marcin Borkowski

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-elisp-tests-with-temp-buffer-a-new-testing-macro.patch --]
[-- Type: text/x-diff, Size: 2634 bytes --]

From 0723e6a7c51bf3924e393e713f3509160d1782a6 Mon Sep 17 00:00:00 2001
From: Marcin Borkowski <mbork@mbork.pl>
Date: Tue, 14 Feb 2017 11:30:36 +0100
Subject: [PATCH] Add elisp-tests-with-temp-buffer, a new testing macro

* test/lisp/progmodes/elisp-mode-tests.el
(elisp-test-point-marker-regex) New variable.
(elisp-tests-with-temp-buffer): New macro to help test functions
moving the point and/or mark.
---
 test/lisp/progmodes/elisp-mode-tests.el | 39 +++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index 93c428b2d2..a00f6b1b43 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -2,6 +2,7 @@
 
 ;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
 
+;; Author: Marcin Borkowski <mbork@mbork.pl>
 ;; Author: Dmitry Gutov <dgutov@yandex.ru>
 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
 
@@ -672,5 +673,43 @@ xref-elisp-overloadable-separate-default
     (insert "?\\N{HEAVY CHECK MARK}")
     (should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK}))))
 
+;;; Helpers
+
+(defvar elisp-test-point-marker-regex "=!\\([a-zA-Z0-9-]+\\)="
+  "A regexp matching placeholders for point position for
+`elisp-tests-with-temp-buffer'.")
+
+;; Copied and heavily modified from `python-tests-with-temp-buffer'
+(defmacro elisp-tests-with-temp-buffer (contents &rest body)
+  "Create an `emacs-lisp-mode' enabled temp buffer with CONTENTS.
+BODY is the code to be executed within the temp buffer.  Point is
+always located at the beginning of buffer.  Special markers of
+the form =!NAME= in CONTENTS are removed, and a for each one
+a variable called NAME is bound to the position of such
+a marker."
+  (declare (indent 1) (debug t))
+  `(with-temp-buffer
+     (emacs-lisp-mode)
+     (insert ,contents)
+     (goto-char (point-min))
+     (while (re-search-forward elisp-test-point-marker-regex nil t)
+       (delete-region (match-beginning 0)
+		      (match-end 0)))
+     (goto-char (point-min))
+     ,(let (marker-list)
+	(with-temp-buffer
+	  (insert (cond ((symbolp contents)
+                         (symbol-value contents))
+                        (t contents)))
+	  (goto-char (point-min))
+	  (while (re-search-forward elisp-test-point-marker-regex nil t)
+	    (push (list (intern (match-string-no-properties 1))
+			(match-beginning 0))
+		  marker-list)
+	    (delete-region (match-beginning 0)
+			   (match-end 0))))
+	`(let ,marker-list
+	   ,@body))))
+
 (provide 'elisp-mode-tests)
 ;;; elisp-mode-tests.el ends here
-- 
2.11.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Fix-bug-21072-and-rework-mark-defun.patch --]
[-- Type: text/x-diff, Size: 13840 bytes --]

From 962f0c653891a4faf2e8db638defbc8096f9d3f1 Mon Sep 17 00:00:00 2001
From: Marcin Borkowski <mbork@mbork.pl>
Date: Tue, 14 Feb 2017 11:37:08 +0100
Subject: [PATCH] Fix bug#21072 and rework `mark-defun'

* test/lisp/progmodes/elisp-mode-tests.el (mark-defun-test-buffer):
  New variable
(mark-defun-no-arg-region-inactive)
(mark-defun-no-arg-region-active)
(mark-defun-arg-region-active)
(mark-defun-pos-arg-region-inactive)
(mark-defun-neg-arg-region-inactive, mark-defun-bob): Add tests for
the new `mark-defun'

* lisp/emacs-lisp/lisp.el (in-comment-line-p): New function
(beginning-of-defun-comments): New function
(mark-defun): Fix bug#21072, also rewrite large parts of `mark-defun'
to accept a numerical prefix argument
---
 lisp/emacs-lisp/lisp.el                 | 130 ++++++++++++-----
 test/lisp/progmodes/elisp-mode-tests.el | 245 ++++++++++++++++++++++++++++++++
 2 files changed, 337 insertions(+), 38 deletions(-)

diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 0172e3af26..664691e629 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -398,6 +398,32 @@ beginning-of-defun-raw
 	     (goto-char (if arg-+ve floor ceiling))
 	     nil))))))))
 
+(defun in-comment-line-p ()
+  "Return non-nil if the point is in a comment line."
+;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html
+  (save-excursion
+    (forward-line 0)
+    (unless (looking-at "^\\s-*$")
+      (< (line-end-position)
+         (let ((ppss (syntax-ppss)))
+           (when (nth 4 ppss)
+             (goto-char (nth 8 ppss)))
+           (forward-comment (point-max))
+           (point))))))
+
+(defun beginning-of-defun-comments (&optional arg)
+  "Move to the beginning of ARGth defun, including comments."
+  (interactive "^p")
+  (unless arg (setq arg 1))
+  (beginning-of-defun arg)
+  (let (nbobp)
+    (while (progn
+             (setq nbobp (zerop (forward-line -1)))
+             (and (in-comment-line-p)
+                  nbobp)))
+    (when nbobp
+      (forward-line 1))))
+
 (defvar end-of-defun-function
   (lambda () (forward-sexp 1))
   "Function for `end-of-defun' to call.
@@ -478,48 +504,76 @@ end-of-defun
         (funcall end-of-defun-function)
 	(funcall skip)))))
 
-(defun mark-defun (&optional allow-extend)
+(defun mark-defun (&optional arg)
   "Put mark at end of this defun, point at beginning.
 The defun marked is the one that contains point or follows point.
+With positive ARG, mark this and that many next defuns; with negative
+ARG, change the direction of marking.
 
-Interactively, if this command is repeated
-or (in Transient Mark mode) if the mark is active,
-it marks the next defun after the ones already marked."
+If the mark is active, it marks the next or previous defun(s) after
+the one(s) already marked."
   (interactive "p")
-  (cond ((and allow-extend
-	      (or (and (eq last-command this-command) (mark t))
-		  (and transient-mark-mode mark-active)))
-	 (set-mark
-	  (save-excursion
-	    (goto-char (mark))
-	    (end-of-defun)
-	    (point))))
-	(t
-	 (let ((opoint (point))
-	       beg end)
-	   (push-mark opoint)
-	   ;; Try first in this order for the sake of languages with nested
-	   ;; functions where several can end at the same place as with
-	   ;; the offside rule, e.g. Python.
-	   (beginning-of-defun)
-	   (setq beg (point))
-	   (end-of-defun)
-	   (setq end (point))
-	   (while (looking-at "^\n")
-	     (forward-line 1))
-	   (if (> (point) opoint)
-	       (progn
-		 ;; We got the right defun.
-		 (push-mark beg nil t)
-		 (goto-char end)
-		 (exchange-point-and-mark))
-	     ;; beginning-of-defun moved back one defun
-	     ;; so we got the wrong one.
-	     (goto-char opoint)
-	     (end-of-defun)
-	     (push-mark (point) nil t)
-	     (beginning-of-defun))
-	   (re-search-backward "^\n" (- (point) 1) t)))))
+  (setq arg (or arg 1))
+  ;; There is no `mark-defun-back' function - see
+  ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-11/msg00079.html
+  ;; for explanation
+  (when (eq last-command 'mark-defun-back)
+    (setq arg (- arg)))
+  (when (< arg 0)
+    (setq this-command 'mark-defun-back))
+  (cond ((use-region-p)
+         (if (>= arg 0)
+             (set-mark
+              (save-excursion
+                (goto-char (mark))
+                ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
+                (dotimes (_ignore arg)
+                  (end-of-defun))
+                (point)))
+           (beginning-of-defun-comments (- arg))))
+        (t
+         (let ((opoint (point))
+               beg end)
+           (push-mark opoint)
+           ;; Try first in this order for the sake of languages with nested
+           ;; functions where several can end at the same place as with the
+           ;; offside rule, e.g. Python.
+           (beginning-of-defun-comments)
+           (setq beg (point))
+           (end-of-defun)
+           (setq end (point))
+           (when (or (and (<= (point) opoint)
+                          (> arg 0))
+                     (= beg (point-min))) ; we were before the first defun!
+             ;; beginning-of-defun moved back one defun so we got the wrong
+             ;; one.  If ARG < 0, however, we actually want to go back.
+             (goto-char opoint)
+             (end-of-defun)
+             (setq end (point))
+             (beginning-of-defun-comments)
+             (setq beg (point)))
+           (goto-char beg)
+           (cond ((> arg 0)
+                  ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
+                  (dotimes (_ignore arg)
+                    (end-of-defun))
+                  (setq end (point))
+                  (push-mark end nil t)
+                  (goto-char beg))
+                 (t
+                  (goto-char beg)
+                  (unless (= arg -1)    ; beginning-of-defun behaves
+                                        ; strange with zero arg - see
+                                        ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html
+                    (beginning-of-defun (1- (- arg))))
+                  (push-mark end nil t))))))
+  (let (nbobp)
+    (while (progn
+             (setq nbobp (zerop (forward-line -1)))
+             (and (looking-at "^\\s-*$")
+                  nbobp)))
+    (when nbobp
+      (forward-line 1))))
 
 (defvar narrow-to-defun-include-comments nil
   "If non-nil, `narrow-to-defun' will also show comments preceding the defun.")
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index a00f6b1b43..2366e337df 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -711,5 +711,250 @@ elisp-tests-with-temp-buffer
 	`(let ,marker-list
 	   ,@body))))
 
+;;; mark-defun
+
+(defvar mark-defun-test-buffer
+  ";; Comment header
+=!before-1=
+\(defun func-1 (arg)
+  =!inside-1=\"docstring\"
+  body)
+=!after-1==!before-2=
+;; Comment before a defun
+\(d=!inside-2=efun func-2 (arg)
+  \"docstring\"
+  body)
+=!after-2==!before-3=
+\(defun func-3 (arg)
+  \"docstring\"=!inside-3=
+  body)
+=!after-3==!before-4=(defun func-4 (arg)
+  \"docstring\"=!inside-4=
+  body)
+=!after-4=
+;; end
+"
+  "Test buffer for `mark-defun'.")
+
+(ert-deftest mark-defun-no-arg-region-inactive ()
+  "Test `mark-defun' with no prefix argument and inactive
+region."
+  (setq last-command nil)
+  (elisp-tests-with-temp-buffer
+      mark-defun-test-buffer
+    ;; mark-defun inside a defun, with comments and an empty line
+    ;; before
+    (goto-char inside-1)
+    (mark-defun)
+    (should (= (point) before-1))
+    (should (= (mark) after-1))
+    ;; mark-defun inside a defun with comments before
+    (deactivate-mark)
+    (goto-char inside-2)
+    (mark-defun)
+    (should (= (point) before-2))
+    (should (= (mark) after-2))
+    ;; mark-defun inside a defun with empty line before
+    (deactivate-mark)
+    (goto-char inside-3)
+    (mark-defun)
+    (should (= (point) before-3))
+    (should (= (mark) after-3))
+    ;; mark-defun inside a defun with another one right before
+    (deactivate-mark)
+    (goto-char inside-4)
+    (mark-defun)
+    (should (= (point) before-4))
+    (should (= (mark) after-4))
+    ;; mark-defun between a comment and a defun
+    (deactivate-mark)
+    (goto-char before-1)
+    (mark-defun)
+    (should (= (point) before-1))
+    (should (= (mark) after-1))
+    ;; mark-defun between defuns
+    (deactivate-mark)
+    (goto-char before-3)
+    (mark-defun)
+    (should (= (point) before-3))
+    (should (= (mark) after-3))
+    ;; mark-defun in comment right before the defun
+    (deactivate-mark)
+    (goto-char before-2)
+    (mark-defun)
+    (should (= (point) before-2))
+    (should (= (mark) after-2))))
+
+(ert-deftest mark-defun-no-arg-region-active ()
+  "Test `mark-defun' with no prefix argument and active
+region."
+  (setq last-command nil)
+  (elisp-tests-with-temp-buffer
+      mark-defun-test-buffer
+    ;; mark-defun when a defun is marked
+    (goto-char before-1)
+    (set-mark after-1)
+    (mark-defun)
+    (should (= (point) before-1))
+    (should (= (mark) after-2))
+    ;; mark-defun when two defuns are marked
+    (deactivate-mark)
+    (goto-char before-1)
+    (set-mark after-2)
+    (mark-defun)
+    (should (= (point) before-1))
+    (should (= (mark) after-3))))
+
+(ert-deftest mark-defun-arg-region-active ()
+  "Test `mark-defun' with a prefix arg and active region."
+  (setq last-command nil)
+  (elisp-tests-with-temp-buffer
+      mark-defun-test-buffer
+    ;; mark-defun with positive arg when a defun is marked
+    (goto-char before-1)
+    (set-mark after-1)
+    (mark-defun 2)
+    (should (= (point) before-1))
+    (should (= (mark) after-3))
+    ;; mark-defun with arg=-1 when a defun is marked
+    (goto-char before-2)
+    (set-mark after-2)
+    (mark-defun -1)
+    (should (= (point) before-1))
+    (should (= (mark) after-2))
+    ;; mark-defun with arg=-2 when a defun is marked
+    (goto-char before-3)
+    (set-mark after-3)
+    (mark-defun -2)
+    (should (= (point) before-1))
+    (should (= (mark) after-3))))
+
+(ert-deftest mark-defun-pos-arg-region-inactive ()
+  "Test `mark-defun' with positive argument and inactive
+  region."
+  (setq last-command nil)
+  (elisp-tests-with-temp-buffer
+      mark-defun-test-buffer
+    ;; mark-defun with positive arg inside a defun
+    (goto-char inside-1)
+    (mark-defun 2)
+    (should (= (point) before-1))
+    (should (= (mark) after-2))
+    ;; mark-defun with positive arg between defuns
+    (deactivate-mark)
+    (goto-char before-3)
+    (mark-defun 2)
+    (should (= (point) before-3))
+    (should (= (mark) after-4))
+    ;; mark-defun with positive arg in a comment
+    (deactivate-mark)
+    (goto-char before-2)
+    (mark-defun 2)
+    (should (= (point) before-2))
+    (should (= (mark) after-3))))
+
+(ert-deftest mark-defun-neg-arg-region-inactive ()
+  "Test `mark-defun' with negative argument and inactive
+  region."
+  (setq last-command nil)
+  (elisp-tests-with-temp-buffer
+      mark-defun-test-buffer
+    ;; mark-defun with arg=-1 inside a defun
+    (goto-char inside-1)
+    (mark-defun -1)
+    (should (= (point) before-1))
+    (should (= (mark) after-1))
+    ;; mark-defun with arg=-1 between defuns
+    (deactivate-mark)
+    (goto-char after-2)
+    (mark-defun -1)
+    (should (= (point) before-2))
+    (should (= (mark) after-2))
+    ;; mark-defun with arg=-1 in a comment
+    ;; (this is probably not an optimal behavior...)
+    (deactivate-mark)
+    (goto-char before-2)
+    (mark-defun -1)
+    (should (= (point) before-1))
+    (should (= (mark) after-1))
+    ;; mark-defun with arg=-2 inside a defun
+    (deactivate-mark)
+    (goto-char inside-4)
+    (mark-defun -2)
+    (should (= (point) before-3))
+    (should (= (mark) after-4))
+    ;; mark-defun with arg=-2 between defuns
+    (deactivate-mark)
+    (goto-char before-3)
+    (mark-defun -2)
+    (should (= (point) before-1))
+    (should (= (mark) after-2)))
+  (elisp-tests-with-temp-buffer         ; test case submitted by Drew Adams
+      "(defun a ()
+  nil)
+=!before-b=(defun b ()
+=!in-b=  nil)
+=!after-b=;;;;
+\(defun c ()
+  nil)
+"
+    (setq last-command nil)
+    (goto-char in-b)
+    (mark-defun -1)
+    (should (= (point) before-b))
+    (should (= (mark) after-b))))
+
+(ert-deftest mark-defun-bob ()
+  "Test `mark-defun' at the beginning of buffer."
+  ;; Bob, comment, newline, defun
+  (setq last-command nil)
+  (elisp-tests-with-temp-buffer
+      ";; Comment at the bob
+=!before=
+\(defun func (arg)=!inside=
+  \"docstring\"
+  body)
+=!after="
+    (goto-char inside)
+    (mark-defun)
+    (should (= (point) before))
+    (should (= (mark) after)))
+  ;; Bob, newline, comment, defun
+  (elisp-tests-with-temp-buffer
+      "=!before=
+;; Comment before the defun
+\(defun func (arg)=!inside=
+  \"docstring\"
+  body)
+=!after="
+    (goto-char inside)
+    (mark-defun)
+    (should (= (point) before))
+    (should (= (mark) after)))
+  ;; Bob, comment, defun
+  (elisp-tests-with-temp-buffer
+      "=!before=;; Comment at the bob before the defun
+\(defun func (arg)=!inside=
+  \"docstring\"
+  body)
+=!after="
+    (goto-char inside)
+    (mark-defun)
+    (should (= (point) before))
+    (should (= (mark) after)))
+  ;; Bob, newline, comment, newline, defun
+  (elisp-tests-with-temp-buffer
+      "
+;; Comment before the defun
+=!before=
+\(defun func (arg)=!inside=
+  \"docstring\"
+  body)
+=!after="
+    (goto-char inside)
+    (mark-defun)
+    (should (= (point) before))
+    (should (= (mark) after))))
+
 (provide 'elisp-mode-tests)
 ;;; elisp-mode-tests.el ends here
-- 
2.11.0