[Emacs-diffs] fix/bug-21072 22fc917 2/5: Fix Bug#21072 and rework `mark-defun'

[Marcin Borkowski]

branch: fix/bug-21072
commit 22fc91704be4737865b3715e5278dc78029791bd
Author: Marcin Borkowski <address@hidden>
Commit: Marcin Borkowski <address@hidden>

    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 (beginning-of-defun--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.
---
 doc/emacs/programs.texi            |  14 ++-
 etc/NEWS                           |   9 ++
 lisp/emacs-lisp/lisp.el            | 132 ++++++++++++++------
 test/lisp/emacs-lisp/lisp-tests.el | 247 +++++++++++++++++++++++++++++++++++++
 4 files changed, 359 insertions(+), 43 deletions(-)

diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 1533c7e..222d1c2 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -248,11 +248,15 @@ the same as @kbd{C-M-a} with a positive argument.
 (@code{mark-defun}), which sets the mark at the end of the current
 defun and puts point at its beginning.  @xref{Marking Objects}.  This
 is the easiest way to get ready to kill the defun in order to move it
-to a different place in the file.  If you use the command while point
-is between defuns, it uses the following defun.  If you use the
-command while the mark is already active, it sets the mark but does
-not move point; furthermore, each successive use of @kbd{C-M-h}
-extends the end of the region to include one more defun.
+to a different place in the file.  If the defun is directly preceded
+by comments (with no intervening blank lines), they are marked, too.
+If you use the command while point is between defuns, it uses the
+following defun.  If you use the command while the mark is already
+active, it extends the end of the region to include one more defun.
+With a prefix argument, it marks that many defuns or extends the
+region by the appropriate number of defuns.  With negative prefix
+argument it marks defuns in the opposite direction and also changes
+the direction of selecting for subsequent uses of @code{mark-defun}.
 
   In C mode, @kbd{C-M-h} runs the function @code{c-mark-function},
 which is almost the same as @code{mark-defun}; the difference is that
diff --git a/etc/NEWS b/etc/NEWS
index 7281827..8e628aa 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -383,6 +383,15 @@ Strings such as ΌΣΟΣ are now correctly converted to Όσος 
when
 capitalized instead of incorrect Όσοσ (compare lowercase sigma at the
 end of the word).
 
++++
+** New behavior of 'mark-defun' implemented
+Prefix argument selects that many (or that many more) defuns.
+Negative prefix arg flips the direction of selection.  Also,
+'mark-defun' between defuns correctly selects N following defuns (or
+-N previous for negative arguments).  Finally, comments preceding the
+defun are selected unless they are separated from the defun by a blank
+line.
+
 
 * Changes in Specialized Modes and Packages in Emacs 26.1
 
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 0172e3a..e74e247 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -398,6 +398,34 @@ is called as a function to find the defun's beginning."
             (goto-char (if arg-+ve floor ceiling))
             nil))))))))
 
+(defun beginning-of-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-*$"))
+                  (beginning-of-defun--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 @@ is called as a function to find the defun's end."
         (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/emacs-lisp/lisp-tests.el 
b/test/lisp/emacs-lisp/lisp-tests.el
index f6039f7..2119758 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -342,5 +342,252 @@ a marker."
        `(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."
+  (transient-mark-mode 1)
+  (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."
+  (transient-mark-mode 1)
+  (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 'lisp-tests)
 ;;; lisp-tests.el ends here