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

[Marcin Borkowski <mbork@mbork.pl>]

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


On 2017-02-16, at 14:22, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

>> Understood.  Do you have then any better idea for the name of this
>> function?  beginning-of-defun--incomment-line-p seems to specific,
>> in-comment-line-p _may_ be indeed too general.
>
> I'll let someone else decide if it deserves a "non-prefixed" name, but
> as for the name after the potential prefix, I think focusing on
> "comment" is the wrong idea.  Maybe `insignificant-line-p`?  Or `emptyish-line-p`?

OK, so I have renamed it and expanded the docstring.  I attach
a corrected patch (the second one, the first one is the same as before).

Is there anything else I can do before we may apply this patch and
consider bug#21072 fixed?

(Notice that three places could be still corrected: two when bug#24427
is fixed and possibly another one when the strange behavior of
(beginning-of-defun 0) is fixed - I will officially file a bug about it
later.  But these apparently will have to wait.)

Best,

--
Marcin Borkowski

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

From 618217607d0bfc7ed8d4090afabea040088a0951 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-emptyish-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                 | 132 ++++++++++++-----
 test/lisp/progmodes/elisp-mode-tests.el | 245 ++++++++++++++++++++++++++++++++
 2 files changed, 339 insertions(+), 38 deletions(-)

diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 0172e3af26..28b136eba4 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -398,6 +398,34 @@ beginning-of-defun-raw
 	     (goto-char (if arg-+ve floor ceiling))
 	     nil))))))))
 
+(defun in-emptyish-line-p ()
+  "Return non-nil if the point is in an \"emptyish\" line.
+This means a line that consists entirely of comments and/or
+whitespace."
+;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html
+  (save-excursion
+    (forward-line 0)
+    (< (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 (not (looking-at "^\\s-*$"))
+                  (in-emptyish-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 +506,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.1