Brave new mark-defun (and a testing tool)

[Marcin Borkowski]

Hi all,

after several months of on-and-off work on bug#21072, I have implemented
two (hopefully) nice features.  One is an (almost) completely new
version of mark-defun, which I hope works much better than the previous
one:

--8<---------------cut here---------------start------------->8---
(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))))

(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.

If the mark is active, it marks the next or previous defun(s) after
the one(s) already marked."
  (interactive "p")
  (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))))
--8<---------------cut here---------------end--------------->8---

Aside from that, I spent a considerable time writing ERT tests for that
function, and to that end I developed the macro below.  It's main goal
is to be able to specify contents of a test buffer together with a set
of named positions in that buffer, so that we can test commands that
move the point and/or mark around easily.

--8<---------------cut here---------------start------------->8---
(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))))
--8<---------------cut here---------------end--------------->8---

Here's how you can use it:

--8<---------------cut here---------------start------------->8---
(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))))
--8<---------------cut here---------------end--------------->8---

WDYT?

--
Marcin Borkowski