diff options
| -rw-r--r-- | doc/lispref/text.texi | 10 | ||||
| -rw-r--r-- | lisp/simple.el | 54 | ||||
| -rw-r--r-- | test/lisp/simple-tests.el | 176 |
3 files changed, 181 insertions, 59 deletions
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 21c5a73f887..b430adf5976 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi | |||
| @@ -723,12 +723,18 @@ You thought | |||
| 723 | @end example | 723 | @end example |
| 724 | @end deffn | 724 | @end deffn |
| 725 | 725 | ||
| 726 | @deffn Command delete-indentation &optional join-following-p | 726 | @deffn Command delete-indentation &optional join-following-p beg end |
| 727 | This function joins the line point is on to the previous line, deleting | 727 | This function joins the line point is on to the previous line, deleting |
| 728 | any whitespace at the join and in some cases replacing it with one | 728 | any whitespace at the join and in some cases replacing it with one |
| 729 | space. If @var{join-following-p} is non-@code{nil}, | 729 | space. If @var{join-following-p} is non-@code{nil}, |
| 730 | @code{delete-indentation} joins this line to the following line | 730 | @code{delete-indentation} joins this line to the following line |
| 731 | instead. The function returns @code{nil}. | 731 | instead. Otherwise, if @var{beg} and @var{end} are non-@code{nil}, |
| 732 | this function joins all lines in the region they define. | ||
| 733 | |||
| 734 | In an interactive call, @var{join-following-p} is the prefix argument, | ||
| 735 | and @var{beg} and @var{end} are, respectively, the start and end of | ||
| 736 | the region if it is active, else @code{nil}. The function returns | ||
| 737 | @code{nil}. | ||
| 732 | 738 | ||
| 733 | If there is a fill prefix, and the second of the lines being joined | 739 | If there is a fill prefix, and the second of the lines being joined |
| 734 | starts with the prefix, then @code{delete-indentation} deletes the | 740 | starts with the prefix, then @code{delete-indentation} deletes the |
diff --git a/lisp/simple.el b/lisp/simple.el index f76f31ad146..306df967661 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -598,30 +598,38 @@ When called from Lisp code, ARG may be a prefix string to copy." | |||
| 598 | If there is a fill prefix, delete it from the beginning of this | 598 | If there is a fill prefix, delete it from the beginning of this |
| 599 | line. | 599 | line. |
| 600 | With prefix ARG, join the current line to the following line. | 600 | With prefix ARG, join the current line to the following line. |
| 601 | If the region is active, join all the lines in the region. (The | 601 | When BEG and END are non-nil, join all lines in the region they |
| 602 | region is ignored if prefix argument is given.)" | 602 | define. Interactively, BEG and END are, respectively, the start |
| 603 | (interactive "*P\nr") | 603 | and end of the region if it is active, else nil. (The region is |
| 604 | (if arg (forward-line 1) | 604 | ignored if prefix ARG is given.)" |
| 605 | (if (use-region-p) | 605 | (interactive |
| 606 | (goto-char end))) | 606 | (progn (barf-if-buffer-read-only) |
| 607 | (beginning-of-line) | 607 | (cons current-prefix-arg |
| 608 | (while (eq (preceding-char) ?\n) | 608 | (and (use-region-p) |
| 609 | (progn | 609 | (list (region-beginning) (region-end)))))) |
| 610 | (delete-region (point) (1- (point))) | 610 | ;; Consistently deactivate mark even when no text is changed. |
| 611 | ;; If the second line started with the fill prefix, | 611 | (setq deactivate-mark t) |
| 612 | (if (and beg (not arg)) | ||
| 613 | ;; Region is active. Go to END, but only if region spans | ||
| 614 | ;; multiple lines. | ||
| 615 | (and (goto-char beg) | ||
| 616 | (> end (line-end-position)) | ||
| 617 | (goto-char end)) | ||
| 618 | ;; Region is inactive. Set a loop sentinel | ||
| 619 | ;; (subtracting 1 in order to compare less than BOB). | ||
| 620 | (setq beg (1- (line-beginning-position (and arg 2)))) | ||
| 621 | (when arg (forward-line))) | ||
| 622 | (let ((prefix (and (> (length fill-prefix) 0) | ||
| 623 | (regexp-quote fill-prefix)))) | ||
| 624 | (while (and (> (line-beginning-position) beg) | ||
| 625 | (forward-line 0) | ||
| 626 | (= (preceding-char) ?\n)) | ||
| 627 | (delete-char -1) | ||
| 628 | ;; If the appended line started with the fill prefix, | ||
| 612 | ;; delete the prefix. | 629 | ;; delete the prefix. |
| 613 | (if (and fill-prefix | 630 | (if (and prefix (looking-at prefix)) |
| 614 | (<= (+ (point) (length fill-prefix)) (point-max)) | 631 | (replace-match "" t t)) |
| 615 | (string= fill-prefix | 632 | (fixup-whitespace)))) |
| 616 | (buffer-substring (point) | ||
| 617 | (+ (point) (length fill-prefix))))) | ||
| 618 | (delete-region (point) (+ (point) (length fill-prefix)))) | ||
| 619 | (fixup-whitespace) | ||
| 620 | (if (and (use-region-p) | ||
| 621 | beg | ||
| 622 | (not arg) | ||
| 623 | (< beg (point-at-bol))) | ||
| 624 | (beginning-of-line))))) | ||
| 625 | 633 | ||
| 626 | (defalias 'join-line #'delete-indentation) ; easier to find | 634 | (defalias 'join-line #'delete-indentation) ; easier to find |
| 627 | 635 | ||
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index d9f059c8fc2..cc2feebbefa 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el | |||
| @@ -22,6 +22,11 @@ | |||
| 22 | (require 'ert) | 22 | (require 'ert) |
| 23 | (eval-when-compile (require 'cl-lib)) | 23 | (eval-when-compile (require 'cl-lib)) |
| 24 | 24 | ||
| 25 | (defun simple-test--buffer-substrings () | ||
| 26 | "Return cons of buffer substrings before and after point." | ||
| 27 | (cons (buffer-substring (point-min) (point)) | ||
| 28 | (buffer-substring (point) (point-max)))) | ||
| 29 | |||
| 25 | (defmacro simple-test--dummy-buffer (&rest body) | 30 | (defmacro simple-test--dummy-buffer (&rest body) |
| 26 | (declare (indent 0) | 31 | (declare (indent 0) |
| 27 | (debug t)) | 32 | (debug t)) |
| @@ -31,10 +36,7 @@ | |||
| 31 | (insert "(a b") | 36 | (insert "(a b") |
| 32 | (save-excursion (insert " c d)")) | 37 | (save-excursion (insert " c d)")) |
| 33 | ,@body | 38 | ,@body |
| 34 | (with-no-warnings | 39 | (with-no-warnings (simple-test--buffer-substrings)))) |
| 35 | (cons (buffer-substring (point-min) (point)) | ||
| 36 | (buffer-substring (point) (point-max)))))) | ||
| 37 | |||
| 38 | 40 | ||
| 39 | 41 | ||
| 40 | ;;; `transpose-sexps' | 42 | ;;; `transpose-sexps' |
| @@ -46,8 +48,7 @@ | |||
| 46 | (insert "(s1) (s2) (s3) (s4) (s5)") | 48 | (insert "(s1) (s2) (s3) (s4) (s5)") |
| 47 | (backward-sexp 1) | 49 | (backward-sexp 1) |
| 48 | ,@body | 50 | ,@body |
| 49 | (cons (buffer-substring (point-min) (point)) | 51 | (simple-test--buffer-substrings))) |
| 50 | (buffer-substring (point) (point-max))))) | ||
| 51 | 52 | ||
| 52 | ;;; Transposition with negative args (bug#20698, bug#21885) | 53 | ;;; Transposition with negative args (bug#20698, bug#21885) |
| 53 | (ert-deftest simple-transpose-subr () | 54 | (ert-deftest simple-transpose-subr () |
| @@ -215,37 +216,144 @@ | |||
| 215 | 216 | ||
| 216 | 217 | ||
| 217 | ;;; `delete-indentation' | 218 | ;;; `delete-indentation' |
| 219 | |||
| 218 | (ert-deftest simple-delete-indentation-no-region () | 220 | (ert-deftest simple-delete-indentation-no-region () |
| 219 | "delete-indentation works when no mark is set." | 221 | "Test `delete-indentation' when no mark is set; see bug#35021." |
| 220 | ;; interactive \r returns nil for BEG END args | 222 | (with-temp-buffer |
| 221 | (unwind-protect | 223 | (insert " first \n second \n third \n fourth ") |
| 222 | (with-temp-buffer | 224 | (should-not (mark t)) |
| 223 | (insert (concat "zero line \n" | 225 | ;; Without prefix argument. |
| 224 | "first line \n" | 226 | (should-not (call-interactively #'delete-indentation)) |
| 225 | "second line")) | 227 | (should (equal (simple-test--buffer-substrings) |
| 226 | (delete-indentation) | 228 | '(" first \n second \n third" . " fourth "))) |
| 227 | (should (string-equal | 229 | (should-not (call-interactively #'delete-indentation)) |
| 228 | (buffer-string) | 230 | (should (equal (simple-test--buffer-substrings) |
| 229 | (concat "zero line \n" | 231 | '(" first \n second" . " third fourth "))) |
| 230 | "first line second line"))) | 232 | ;; With prefix argument. |
| 231 | ))) | 233 | (goto-char (point-min)) |
| 234 | (let ((current-prefix-arg '(4))) | ||
| 235 | (should-not (call-interactively #'delete-indentation))) | ||
| 236 | (should (equal (simple-test--buffer-substrings) | ||
| 237 | '(" first" . " second third fourth "))))) | ||
| 232 | 238 | ||
| 233 | (ert-deftest simple-delete-indentation-inactive-region () | 239 | (ert-deftest simple-delete-indentation-inactive-region () |
| 234 | "delete-indentation ignores inactive region." | 240 | "Test `delete-indentation' with an inactive region." |
| 235 | ;; interactive \r returns non-nil for BEG END args | 241 | (with-temp-buffer |
| 236 | (unwind-protect | 242 | (insert " first \n second \n third ") |
| 237 | (with-temp-buffer | 243 | (set-marker (mark-marker) (point-min)) |
| 238 | (insert (concat "zero line \n" | 244 | (should (mark t)) |
| 239 | "first line \n" | 245 | (should-not (call-interactively #'delete-indentation)) |
| 240 | "second line")) | 246 | (should (equal (simple-test--buffer-substrings) |
| 241 | (push-mark (point-min) t t) | 247 | '(" first \n second" . " third "))))) |
| 242 | (deactivate-mark) | 248 | |
| 243 | (delete-indentation) | 249 | (ert-deftest simple-delete-indentation-blank-line () |
| 244 | (should (string-equal | 250 | "Test `delete-indentation' does not skip blank lines. |
| 245 | (buffer-string) | 251 | See bug#35036." |
| 246 | (concat "zero line \n" | 252 | (with-temp-buffer |
| 247 | "first line second line"))) | 253 | (insert "\n\n third \n \n \n sixth \n\n") |
| 248 | ))) | 254 | ;; Without prefix argument. |
| 255 | (should-not (delete-indentation)) | ||
| 256 | (should (equal (simple-test--buffer-substrings) | ||
| 257 | '("\n\n third \n \n \n sixth \n" . ""))) | ||
| 258 | (should-not (delete-indentation)) | ||
| 259 | (should (equal (simple-test--buffer-substrings) | ||
| 260 | '("\n\n third \n \n \n sixth" . ""))) | ||
| 261 | (should-not (delete-indentation)) | ||
| 262 | (should (equal (simple-test--buffer-substrings) | ||
| 263 | '("\n\n third \n \n" . "sixth"))) | ||
| 264 | ;; With prefix argument. | ||
| 265 | (goto-char (point-min)) | ||
| 266 | (should-not (delete-indentation t)) | ||
| 267 | (should (equal (simple-test--buffer-substrings) | ||
| 268 | '("" . "\n third \n \nsixth"))) | ||
| 269 | (should-not (delete-indentation t)) | ||
| 270 | (should (equal (simple-test--buffer-substrings) | ||
| 271 | '("" . "third \n \nsixth"))) | ||
| 272 | (should-not (delete-indentation t)) | ||
| 273 | (should (equal (simple-test--buffer-substrings) | ||
| 274 | '("third" . "\nsixth"))) | ||
| 275 | (should-not (delete-indentation t)) | ||
| 276 | (should (equal (simple-test--buffer-substrings) | ||
| 277 | '("third" . " sixth"))))) | ||
| 278 | |||
| 279 | (ert-deftest simple-delete-indentation-boundaries () | ||
| 280 | "Test `delete-indentation' motion at buffer boundaries." | ||
| 281 | (with-temp-buffer | ||
| 282 | (insert " first \n second \n third ") | ||
| 283 | ;; Stay at EOB. | ||
| 284 | (should-not (delete-indentation t)) | ||
| 285 | (should (equal (simple-test--buffer-substrings) | ||
| 286 | '(" first \n second \n third " . ""))) | ||
| 287 | ;; Stay at BOB. | ||
| 288 | (forward-line -1) | ||
| 289 | (save-restriction | ||
| 290 | (narrow-to-region (point) (line-end-position)) | ||
| 291 | (should-not (delete-indentation)) | ||
| 292 | (should (equal (simple-test--buffer-substrings) | ||
| 293 | '("" . " second "))) | ||
| 294 | ;; Go to EOB. | ||
| 295 | (should-not (delete-indentation t)) | ||
| 296 | (should (equal (simple-test--buffer-substrings) | ||
| 297 | '(" second " . "")))) | ||
| 298 | ;; Go to BOB. | ||
| 299 | (end-of-line 0) | ||
| 300 | (should-not (delete-indentation)) | ||
| 301 | (should (equal (simple-test--buffer-substrings) | ||
| 302 | '("" . " first \n second \n third "))))) | ||
| 303 | |||
| 304 | (ert-deftest simple-delete-indentation-region () | ||
| 305 | "Test `delete-indentation' with an active region." | ||
| 306 | (with-temp-buffer | ||
| 307 | ;; Empty region. | ||
| 308 | (insert " first ") | ||
| 309 | (should-not (delete-indentation nil (point) (point))) | ||
| 310 | (should (equal (simple-test--buffer-substrings) | ||
| 311 | '(" first " . ""))) | ||
| 312 | ;; Single line. | ||
| 313 | (should-not (delete-indentation | ||
| 314 | nil (line-beginning-position) (1- (point)))) | ||
| 315 | (should (equal (simple-test--buffer-substrings) | ||
| 316 | '("" . " first "))) | ||
| 317 | (should-not (delete-indentation nil (1+ (point)) (line-end-position))) | ||
| 318 | (should (equal (simple-test--buffer-substrings) | ||
| 319 | '(" " . "first "))) | ||
| 320 | (should-not (delete-indentation | ||
| 321 | nil (line-beginning-position) (line-end-position))) | ||
| 322 | (should (equal (simple-test--buffer-substrings) | ||
| 323 | '("" . " first "))) | ||
| 324 | ;; Multiple lines. | ||
| 325 | (goto-char (point-max)) | ||
| 326 | (insert "\n second \n third \n fourth ") | ||
| 327 | (goto-char (point-min)) | ||
| 328 | (should-not (delete-indentation | ||
| 329 | nil (line-end-position) (line-beginning-position 2))) | ||
| 330 | (should (equal (simple-test--buffer-substrings) | ||
| 331 | '(" first" . " second \n third \n fourth "))) | ||
| 332 | (should-not (delete-indentation | ||
| 333 | nil (point) (1+ (line-beginning-position 2)))) | ||
| 334 | (should (equal (simple-test--buffer-substrings) | ||
| 335 | '(" first second" . " third \n fourth "))) | ||
| 336 | ;; Prefix argument overrides region. | ||
| 337 | (should-not (delete-indentation t (point-min) (point))) | ||
| 338 | (should (equal (simple-test--buffer-substrings) | ||
| 339 | '(" first second third" . " fourth "))))) | ||
| 340 | |||
| 341 | (ert-deftest simple-delete-indentation-prefix () | ||
| 342 | "Test `delete-indentation' with a fill prefix." | ||
| 343 | (with-temp-buffer | ||
| 344 | (insert "> first \n> second \n> third \n> fourth ") | ||
| 345 | (let ((fill-prefix "")) | ||
| 346 | (delete-indentation)) | ||
| 347 | (should (equal (simple-test--buffer-substrings) | ||
| 348 | '("> first \n> second \n> third" . " > fourth "))) | ||
| 349 | (let ((fill-prefix "<")) | ||
| 350 | (delete-indentation)) | ||
| 351 | (should (equal (simple-test--buffer-substrings) | ||
| 352 | '("> first \n> second" . " > third > fourth "))) | ||
| 353 | (let ((fill-prefix ">")) | ||
| 354 | (delete-indentation)) | ||
| 355 | (should (equal (simple-test--buffer-substrings) | ||
| 356 | '("> first" . " second > third > fourth "))))) | ||
| 249 | 357 | ||
| 250 | 358 | ||
| 251 | ;;; `delete-trailing-whitespace' | 359 | ;;; `delete-trailing-whitespace' |