[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 9a5e864: Merge branch 'fix/bug-21072'
|
From: |
Marcin Borkowski |
|
Subject: |
[Emacs-diffs] master 9a5e864: Merge branch 'fix/bug-21072' |
|
Date: |
Sun, 14 May 2017 01:09:13 -0400 (EDT) |
branch: master
commit 9a5e864de731e113badbe300b1e4174f103547fa
Merge: 91ccb26 aa779b0
Author: Marcin Borkowski <address@hidden>
Commit: Marcin Borkowski <address@hidden>
Merge branch 'fix/bug-21072'
---
doc/emacs/programs.texi | 14 +-
etc/NEWS | 9 ++
lisp/emacs-lisp/lisp.el | 136 +++++++++++++-----
test/lisp/emacs-lisp/lisp-tests.el | 286 +++++++++++++++++++++++++++++++++++++
4 files changed, 402 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 b7dbb14..6667a44 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -403,6 +403,15 @@ manner via the new mode 'auto-save-visited-mode'. Unlike
procedure and therefore obeys saving hooks.
'auto-save-visited-file-name' is now obsolete.
++++
+** 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..0c1fe42 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -398,6 +398,42 @@ 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 (first-line-p)
+ (while (let ((ppss (progn (setq first-line-p (= (forward-line -1) -1))
+ (syntax-ppss (line-end-position)))))
+ (while (and (nth 4 ppss) ; If eol is in a line-spanning comment,
+ (< (nth 8 ppss) (line-beginning-position)))
+ (goto-char (nth 8 ppss)) ; skip to comment start.
+ (setq ppss (syntax-ppss (line-end-position))))
+ (and (not first-line-p)
+ (progn (skip-syntax-backward
+ "-" (line-beginning-position))
+ (not (bolp))) ; Check for blank line.
+ (progn (parse-partial-sexp
+ (line-beginning-position) (line-end-position)
+ nil t (syntax-ppss (line-beginning-position)))
+ (eolp))))) ; Check for non-comment text.
+ (forward-line (if first-line-p 0 1))))
+
(defvar end-of-defun-function
(lambda () (forward-sexp 1))
"Function for `end-of-defun' to call.
@@ -478,48 +514,72 @@ 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))))))
+ (skip-chars-backward "[:space:]\n")
+ (unless (bobp)
+ (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 8cba7fc..ddbf378 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -5,6 +5,7 @@
;; Author: Aaron S. Hawley <address@hidden>
;; Author: Stefan Monnier <address@hidden>
;; Author: Daniel Colascione <address@hidden>
+;; Author: Marcin Borkowski <address@hidden>
;; Keywords: internal
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -303,5 +304,290 @@
;; abcdefghijklmnopqrstuv
i f a scan-error)
+;;; Helpers
+
+(eval-and-compile
+ (defvar elisp-test-point-position-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. CONTENTS is an
+expression that must evaluate to a string at compile time. Words
+of the form =!NAME= in CONTENTS are removed, and a for each one a
+variable called NAME is bound to the position of the word's
+start."
+ (declare (indent 1) (debug (def-form body)))
+ (let* ((var-pos nil)
+ (text (with-temp-buffer
+ (insert (eval contents))
+ (goto-char (point-min))
+ (while (re-search-forward elisp-test-point-position-regex nil
t)
+ (push (list (intern (match-string-no-properties 1))
+ (match-beginning 0))
+ var-pos)
+ (delete-region (match-beginning 0)
+ (match-end 0)))
+ (buffer-string))))
+ `(with-temp-buffer
+ (emacs-lisp-mode)
+ (insert ,text)
+ (goto-char (point-min))
+ (let ,var-pos
+ ;; Let the =!POSITION= variables be ignorable.
+ ,@(mapcar (lambda (v-p) `(ignore ,(car v-p))) var-pos)
+ ,@body))))
+
+;;; mark-defun
+
+(eval-and-compile
+ (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