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