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.

1 files changed, 94 insertions, 38 deletions

diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 0172e3af261..e74e2474ee9 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.")