From 17386be5712159aa38f894c983fc48b21a234ae1 Mon Sep 17 00:00:00 2001 From: Zachary Kanfer Date: Sun, 16 Apr 2023 22:16:39 -0400 Subject: [PATCH] Add foo-mark-forward, foo-mark-backward, for various foo. This adds methods to mark forward and backward for the given objects: * word * sexp * defun * paragraph * page --- doc/emacs/mark.texi | 17 ++ doc/emacs/programs.texi | 8 + doc/emacs/text.texi | 18 ++ etc/NEWS | 20 ++ lisp/emacs-lisp/lisp.el | 60 ++++++ lisp/simple.el | 46 +++++ lisp/textmodes/page.el | 14 ++ lisp/textmodes/paragraphs.el | 14 ++ test/lisp/emacs-lisp/lisp-tests.el | 262 ++++++++++++++++++++++++ test/lisp/simple-tests.el | 14 ++ test/lisp/textmodes/page-tests.el | 11 + test/lisp/textmodes/paragraphs-tests.el | 34 +++ 12 files changed, 518 insertions(+) diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 3f1c76c1591..6aa12b78181 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -216,6 +216,15 @@ Marking Objects to advance the mark by @var{n} words. A negative argument @minus{}@var{n} moves the mark back by @var{n} words. +@findex mark-word-forward + @code{mark-word-forward} is similar to @code{mark-word}, but only + moves forward. + +@findex mark-word-backward + @code{mark-word-backward} is similar to @code{mark-word}, but only + moves backward. + + @kindex C-M-@@ @findex mark-sexp Similarly, @kbd{C-M-@@} (@code{mark-sexp}) puts the mark at the end @@ -224,6 +233,14 @@ Marking Objects positive or negative numeric arguments move the mark forward or backward by the specified number of expressions. +@findex mark-sexp-forward + @code{mark-sexp-forward} is similar to @code{mark-sexp}, but only + moves forward. + +@findex mark-sexp-backward + @code{mark-sexp-backward} is similar to @code{mark-sexp}, but only + moves backward. + The other commands in the above list set both point and mark, so as to delimit an object in the buffer. @kbd{M-h} (@code{mark-paragraph}) marks paragraphs (@pxref{Paragraphs}), @kbd{C-M-h} (@code{mark-defun}) diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 62df88a731e..4cd2007e225 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -230,6 +230,14 @@ Moving by Defuns negative argument moves back to an end of a defun, which is not quite the same as @kbd{C-M-a} with a positive argument. +@findex mark-defun-forward + @code{mark-defun-forward} is similar to @code{mark-defun}, but only + moves forward. + +@findex mark-defun-backward + @code{mark-defun-backward} is similar to @code{mark-defun}, but only + moves backward. + @kindex C-M-h @r{(C mode)} @findex c-mark-function To operate on the current defun, use @kbd{C-M-h} diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 3d3f2562617..dcdcf18ad92 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -314,6 +314,15 @@ Paragraphs If you set a fill prefix, then paragraphs are delimited by all lines which don't start with the fill prefix. @xref{Filling}. +@findex mark-paragraph-forward + @code{mark-paragraph-forward} is similar to @code{mark-paragraph}, + but only moves forward. + +@findex mark-paragraph-backward + @code{mark-paragraph-backward} is similar to @code{mark-paragraph}, + but only moves backward. + + @vindex paragraph-start @vindex paragraph-separate The precise definition of a paragraph boundary is controlled by the @@ -394,6 +403,15 @@ Pages relative to the current one. Zero means the current page, one means the next page, and @minus{}1 means the previous one. +@findex mark-page-forward + @code{mark-page-forward} is similar to @code{mark-page}, but only + moves forward. + +@findex mark-page-backward + @code{mark-page-backward} is similar to @code{mark-page}, but only + moves backward. + + @kindex C-x l @findex count-lines-page The @kbd{C-x l} command (@code{count-lines-page}) is good for deciding diff --git a/etc/NEWS b/etc/NEWS index c61a9ec3c5f..74b4f056095 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -81,6 +81,26 @@ mistaken compositions, this will now work as well. This works like 'kill-matching-buffers', but without asking for confirmation. +--- +** New commands 'mark-sexp-forward', 'mark-sexp-backward'. +These work like mark-sexp, but explicitly allow sexps to be marked forward and backward. + +--- +** New commands 'mark-word-forward', 'mark-word-backward'. +These work like mark-word, but explicitly allow words to be marked forward and backward. + +--- +** New commands 'mark-defun-forward', 'mark-defun-backward'. +These work like mark-defun, but explicitly allow defuns to be marked forward and backward. + +--- +** New commands 'mark-paragraph-forward', 'mark-paragraph-backward'. +These work like mark-paragraph, but explicitly allow paragraphs to be marked forward and backward. + +--- +** New commands 'mark-page-forward', 'mark-page-backward'. +These work like mark-page, but explicitly allow pages to be marked forward and backward. + * Changes in Specialized Modes and Packages in Emacs 30.1 diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 417c218c6d7..39bfe5d3e06 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -129,6 +129,52 @@ mark-sexp (point)) nil t)))) +(defun mark--helper (move-fn number-of-things) + "Use MOVE-FN to move NUMBER-OF-THINGS things, extending region over them. + +The MOVE-FN should take a numeric argument, and move that many +items forward (negative means backward). + +NUMBER-OF-THINGS is the number of additional things to move." + (if (use-region-p) + (let* ((forward (>= number-of-things 0)) + (beginning-of-region (region-beginning)) + (end-of-region (region-end)) + (at-end-of-region (= end-of-region (point))) + (new-border-point + (save-excursion + (goto-char (if forward (region-end) (region-beginning))) + (condition-case nil + (funcall move-fn number-of-things) + (scan-error (user-error "No more in this direction!"))) + (point))) + (new-beginning-of-region (min beginning-of-region new-border-point)) + (new-end-of-region (max end-of-region new-border-point))) + (goto-char (if at-end-of-region + new-end-of-region + new-beginning-of-region)) + (set-mark (if at-end-of-region + new-beginning-of-region + new-end-of-region))) + (progn (push-mark (save-excursion + (funcall move-fn number-of-things) + (point))) + (activate-mark)))) + +(defun mark-sexp-forward (&optional number-of-expressions) + "Mark NUMBER-OF-EXPRESSIONS s-expressions forward. + + Repeated calls to this mark more s-expressions." + (interactive "p") + (mark--helper #'forward-sexp (or number-of-expressions 1))) + +(defun mark-sexp-backward (&optional number-of-expressions) + "Mark NUMBER-OF-EXPRESSIONS s-expressions backward. + + Repeated calls to this mark more s-expressions." + (interactive "p") + (mark--helper #'forward-sexp (- (or number-of-expressions 1)))) + (defun forward-list (&optional arg interactive) "Move forward across one balanced group of parentheses. This command will also work on other parentheses-like expressions @@ -604,6 +650,20 @@ end-of-defun (funcall end-of-defun-function) (funcall skip)))))) +(defun mark-defun-forward (&optional number-of-defuns) + "Mark NUMBER-OF-DEFUNS defuns forward. + + Repeated calls to this mark more defuns." + (interactive "p") + (mark--helper #'end-of-defun (or number-of-defuns 1))) + +(defun mark-defun-backward (&optional number-of-defuns) + "Mark NUMBER-OF-DEFUNS defuns backward. + + Repeated calls to this mark more defuns." + (interactive "p") + (mark--helper #'end-of-defun (- (or number-of-defuns 1)))) + (defun mark-defun (&optional arg interactive) "Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point. diff --git a/lisp/simple.el b/lisp/simple.el index b621e1603bd..46ff7559a2c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8701,6 +8701,52 @@ backward-word (interactive "^p") (forward-word (- (or arg 1)))) +(defun mark--helper (move-fn number-of-things) + "Use MOVE-FN to move NUMBER-OF-THINGS things, extending region over them. + +The MOVE-FN should take a numeric argument, and move that many +items forward (negative means backward). + +NUMBER-OF-THINGS is the number of additional things to move." + (if (use-region-p) + (let* ((forward (>= number-of-things 0)) + (beginning-of-region (region-beginning)) + (end-of-region (region-end)) + (at-end-of-region (= end-of-region (point))) + (new-border-point + (save-excursion + (goto-char (if forward (region-end) (region-beginning))) + (condition-case nil + (funcall move-fn number-of-things) + (scan-error (user-error "No more in this direction!"))) + (point))) + (new-beginning-of-region (min beginning-of-region new-border-point)) + (new-end-of-region (max end-of-region new-border-point))) + (goto-char (if at-end-of-region + new-end-of-region + new-beginning-of-region)) + (set-mark (if at-end-of-region + new-beginning-of-region + new-end-of-region))) + (progn (push-mark (save-excursion + (funcall move-fn number-of-things) + (point))) + (activate-mark)))) + +(defun mark-word-forward (&optional number-of-words) + "Mark NUMBER-OF-WORDS words forward. + + Repeated calls to this mark more words." + (interactive "p") + (mark--helper #'forward-word (or number-of-words 1))) + +(defun mark-word-backward (&optional number-of-words) + "Mark NUMBER-OF-WORDS words backward. + + Repeated calls to this mark more words." + (interactive "p") + (mark--helper #'forward-word (- (or number-of-words 1)))) + (defun mark-word (&optional arg allow-extend) "Set mark ARG words away from point. The place mark goes is the same place \\[forward-word] would diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 86a2762b0ee..afebd8fdb25 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -71,6 +71,20 @@ backward-page (or count (setq count 1)) (forward-page (- count))) +(defun mark-page-forward (&optional number-of-pages) + "Mark NUMBER-OF-PAGES pages forward. + + Repeated calls to this mark more pages." + (interactive "p") + (mark--helper #'forward-page (or number-of-pages 1))) + +(defun mark-page-backward (&optional number-of-pages) + "Mark NUMBER-OF-PAGES pages backward. + + Repeated calls to this mark more pages." + (interactive "p") + (mark--helper #'forward-page (- (or number-of-pages 1)))) + (defun mark-page (&optional arg) "Put mark at end of page, point at beginning. A numeric arg specifies to move forward or backward by that many pages, diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 6c33380b6bd..a278d485681 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -360,6 +360,20 @@ backward-paragraph (or arg (setq arg 1)) (forward-paragraph (- arg))) +(defun mark-paragraph-forward (&optional number-of-paragraphs) + "Mark NUMBER-OF-PARAGRAPHS paragraphs forward. + + Repeated calls to this mark more paragraphs." + (interactive "p") + (mark--helper #'forward-paragraph (or number-of-paragraphs 1))) + +(defun mark-paragraph-backward (&optional number-of-paragraphs) + "Mark NUMBER-OF-PARAGRAPHS paragraphs backward. + + Repeated calls to this mark more paragraphs." + (interactive "p") + (mark--helper #'forward-paragraph (- (or number-of-paragraphs 1)))) + (defun mark-paragraph (&optional arg allow-extend) "Put point at beginning of this paragraph, mark at end. The paragraph marked is the one that contains point or follows point. diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 2e5e2a740b1..3e28f7232e5 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -116,6 +116,207 @@ lisp-backward-sexp-2-bobp-and-subsequent (should (null ;; (should-error ;; No, per #13994 (forward-sexp -1))))) +(ert-deftest mark-sexp-forward-one-forward-check-point () + (should (equal 14 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward) + (point))))) + +(ert-deftest mark-sexp-forward-one-forward-pass-value-check-point () + (should (equal 14 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward 1) + (point))))) + +(ert-deftest mark-sexp-forward-one-forward-check-region () + (should (equal "(6)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line 2) + (mark-sexp-forward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-sexp-forward-one-forward-pass-value-check-region () + (should (equal "(6)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line 2) + (mark-sexp-forward 1) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-sexp-backward-one-backward-check-point () + (should (equal 14 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-backward) + (point))))) + +(ert-deftest mark-sexp-backward-one-backward-check-region () + (should (equal "(3 4 5)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-sexp-one-forward-then-one-backward-check-point () + (should (equal 7 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward) + (mark-sexp-backward) + (point))))) + +(ert-deftest mark-sexp-one-forward-then-one-backward-check-region () + (should (equal "(3 4 5) +(6)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward) + (mark-sexp-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-sexp-one-forward-then-one-backward-then-one-forward-check-point () + (should (equal 7 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward) + (mark-sexp-backward) + (mark-sexp-forward) + (point))))) + +(ert-deftest mark-sexp-one-forward-then-one-backward-then-one-forward-check-region () + (should (equal 7 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward) + (mark-sexp-backward) + (mark-sexp-forward) + (point))))) + + + +(ert-deftest mark-sexp-forward-one-forward-one-back-one-forward-check-region () + (should (equal "(3 4 5) +(6) +(7 8)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward) + (mark-sexp-backward) + (mark-sexp-forward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-sexp-forward-two-forward-check-point () + (should (equal 14 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward 2) + (point))))) + +(ert-deftest mark-sexp-forward-two-forward-check-region () + (should (equal " +(6) +(7 8)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-forward 2) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-sexp-backward-two-backward-check-point () + (should (equal 14 + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-backward 2) + (point))))) + +(ert-deftest mark-sexp-backward-two-backward-check-region () + (should (equal "(1 2) +(3 4 5)" + (with-temp-buffer (insert "(1 2) +(3 4 5) +(6) +(7 8)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-sexp-backward 2) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + (ert-deftest lisp-delete-pair-parens () "Test \\[delete-pair] with parens." (with-temp-buffer @@ -369,6 +570,67 @@ elisp-tests-with-temp-buffer " "Test buffer for `mark-defun'.")) +(ert-deftest mark-defun-forward-one-forward-check-point () + (should (equal 18 + (with-temp-buffer (insert "(defun foo () 2) + +(defun bar () 3)") + (goto-char (point-min)) + (forward-line) + (mark-defun-forward) + (point))))) + +(ert-deftest mark-defun-forward-one-forward-check-region () + (should (equal " +(defun bar () 3)" + (with-temp-buffer (insert "(defun foo () 2) + +(defun bar () 3)") + (goto-char (point-min)) + (forward-line) + (mark-defun-forward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + +(ert-deftest mark-defun-backward-one-backward-check-point () + (should (equal 18 + (with-temp-buffer (insert "(defun foo () 2) + +(defun bar () 3)") + (goto-char (point-min)) + (forward-line) + (mark-defun-backward) + (point))))) + +(ert-deftest mark-defun-backward-one-backward-check-region () + (should (equal "(defun foo () 2) +" + (with-temp-buffer (insert "(defun foo () 2) + +(defun bar () 2)") + (goto-char (point-min)) + (forward-line) + (mark-defun-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + + +(ert-deftest mark-defun-backward-two-backward-check-region () + (should (equal "(defun foo () 2) +(defun bar () 3)" + (with-temp-buffer (insert "(defun foo () 2) +(defun bar () 3) +(defun baz () 5) +(defun biff () 7)") + (goto-char (point-min)) + (forward-line) + (end-of-line) + (mark-defun-backward) + (mark-defun-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + + ;;; end-of-defun (ert-deftest end-of-defun-twice () diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 28d8120f143..ba460d3cc01 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -115,6 +115,20 @@ simple-transpose-subr (should (equal (simple-test--transpositions (transpose-sexps -2)) '("(s1) (s4)" . " (s2) (s3) (s5)")))) + +;;; `mark-word-forward', `mark-word-backward' +(ert-deftest mark-word-forward-two-backwards-check-region () + (should (equal "defg hi j" + (with-temp-buffer + (insert "abc defg hi j klmno") + (goto-char (point-min)) + (forward-char 11);;after "hi" + (mark-word-forward) + (mark-word-backward) + (mark-word-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + ;;; `newline' (ert-deftest newline () diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index 4bfa8d9941c..0f142ee505b 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -57,6 +57,17 @@ page-tests-backward-page (backward-page -2) (should (= (point) (point-max))))) +(ert-deftest mark-page-forward-twice-backward-oncecheck-region () + (should (equal "\nbar\n \nbaz\n \nbiff\n " + (with-temp-buffer (insert "foo\n \nbar\n \nbaz\n \nbiff\n \nbang") + (goto-char (point-min)) + (forward-line 3) + (mark-page-forward) + (mark-page-forward) + (mark-page-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + (defun page-tests--region-string () "Return the contents of the region as a string." (buffer-substring (region-beginning) (region-end))) diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el index 81e88113c2a..75a09811c7d 100644 --- a/test/lisp/textmodes/paragraphs-tests.el +++ b/test/lisp/textmodes/paragraphs-tests.el @@ -54,6 +54,40 @@ paragraphs-tests-mark-paragraph (should (equal (mark) 7)))) ;;; (should-error (mark-paragraph 0))) +(ert-deftest paragraphs-tests-mark-paragraph-forward-two-backward-check-region () + (should (equal " +A second begins here, but is +way way longer, but on multiple +lines because the paragraph +is filled.. + +And a third paragraph. It's kind +of short. + +Paragraph four! It's shorter. +" + (with-temp-buffer + (insert "First paragraph here. + +A second begins here, but is +way way longer, but on multiple +lines because the paragraph +is filled.. + +And a third paragraph. It's kind +of short. + +Paragraph four! It's shorter. + +The shortest yet.") + (goto-char (point-min)) + (forward-line 9) + (mark-paragraph-forward) + (mark-paragraph-backward) + (mark-paragraph-backward) + (buffer-substring-no-properties (region-beginning) + (region-end)))))) + (ert-deftest paragraphs-tests-kill-paragraph () (with-temp-buffer (insert "AA\nAA\n\nBB\nBB\n") -- 2.38.4