From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Marcin Borkowski Newsgroups: gmane.emacs.bugs,gmane.emacs.devel Subject: bug#21072: Brave new mark-defun (and a testing tool) Date: Tue, 14 Feb 2017 11:45:29 +0100 Message-ID: <87wpctgieu.fsf@mbork.pl> References: <87o9ydrzkr.fsf@mbork.pl> <87mvdriuss.fsf@mbork.pl> <87bmu6icea.fsf@mbork.pl> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1487069972 15082 195.159.176.226 (14 Feb 2017 10:59:32 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 14 Feb 2017 10:59:32 +0000 (UTC) User-Agent: mu4e 0.9.19; emacs 26.0.50.3 Cc: Dmitry Gutov , 21072@debbugs.gnu.org, Emacs developers To: John Wiegley Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Feb 14 11:59:25 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cdapO-0003Ov-FB for geb-bug-gnu-emacs@m.gmane.org; Tue, 14 Feb 2017 11:59:22 +0100 Original-Received: from localhost ([::1]:33892 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cdapU-0002fq-2k for geb-bug-gnu-emacs@m.gmane.org; Tue, 14 Feb 2017 05:59:28 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:47379) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cdabd-000777-Lj for bug-gnu-emacs@gnu.org; Tue, 14 Feb 2017 05:45:12 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cdabW-0004zG-Gd for bug-gnu-emacs@gnu.org; Tue, 14 Feb 2017 05:45:09 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:41092) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cdabW-0004z4-CQ for bug-gnu-emacs@gnu.org; Tue, 14 Feb 2017 05:45:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cdabW-0005mL-5U for bug-gnu-emacs@gnu.org; Tue, 14 Feb 2017 05:45:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Marcin Borkowski Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 14 Feb 2017 10:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 21072 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 21072-submit@debbugs.gnu.org id=B21072.148706909822188 (code B ref 21072); Tue, 14 Feb 2017 10:45:02 +0000 Original-Received: (at 21072) by debbugs.gnu.org; 14 Feb 2017 10:44:58 +0000 Original-Received: from localhost ([127.0.0.1]:39291 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cdabR-0005lo-96 for submit@debbugs.gnu.org; Tue, 14 Feb 2017 05:44:57 -0500 Original-Received: from mail.mojserwer.eu ([195.110.48.8]:59761) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cdabP-0005lf-8C for 21072@debbugs.gnu.org; Tue, 14 Feb 2017 05:44:56 -0500 Original-Received: from localhost (localhost [127.0.0.1]) by mail.mojserwer.eu (Postfix) with ESMTP id A6D9CE6A58; Tue, 14 Feb 2017 11:44:53 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mail.mojserwer.eu Original-Received: from mail.mojserwer.eu ([127.0.0.1]) by localhost (mail.mojserwer.eu [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id hIgelsw3K_mA; Tue, 14 Feb 2017 11:44:49 +0100 (CET) Original-Received: from localhost (unknown [62.3.163.135]) by mail.mojserwer.eu (Postfix) with ESMTPSA id 010E6E6A43; Tue, 14 Feb 2017 11:44:48 +0100 (CET) In-reply-to: X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:129344 gmane.emacs.devel:212365 Archived-At: --=-=-= Content-Type: text/plain On 2017-02-13, at 20:00, John Wiegley wrote: >>>>>> Dmitry Gutov 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Add-elisp-tests-with-temp-buffer-a-new-testing-macro.patch >From 0723e6a7c51bf3924e393e713f3509160d1782a6 Mon Sep 17 00:00:00 2001 From: Marcin Borkowski 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 ;; Author: Dmitry Gutov ;; Author: Stephen Leake @@ -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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Fix-bug-21072-and-rework-mark-defun.patch >From 962f0c653891a4faf2e8db638defbc8096f9d3f1 Mon Sep 17 00:00:00 2001 From: Marcin Borkowski 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 --=-=-=--