aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/lispref/text.texi10
-rw-r--r--lisp/simple.el54
-rw-r--r--test/lisp/simple-tests.el176
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
727This function joins the line point is on to the previous line, deleting 727This function joins the line point is on to the previous line, deleting
728any whitespace at the join and in some cases replacing it with one 728any whitespace at the join and in some cases replacing it with one
729space. If @var{join-following-p} is non-@code{nil}, 729space. 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
731instead. The function returns @code{nil}. 731instead. Otherwise, if @var{beg} and @var{end} are non-@code{nil},
732this function joins all lines in the region they define.
733
734In an interactive call, @var{join-following-p} is the prefix argument,
735and @var{beg} and @var{end} are, respectively, the start and end of
736the region if it is active, else @code{nil}. The function returns
737@code{nil}.
732 738
733If there is a fill prefix, and the second of the lines being joined 739If there is a fill prefix, and the second of the lines being joined
734starts with the prefix, then @code{delete-indentation} deletes the 740starts 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."
598If there is a fill prefix, delete it from the beginning of this 598If there is a fill prefix, delete it from the beginning of this
599line. 599line.
600With prefix ARG, join the current line to the following line. 600With prefix ARG, join the current line to the following line.
601If the region is active, join all the lines in the region. (The 601When BEG and END are non-nil, join all lines in the region they
602region is ignored if prefix argument is given.)" 602define. Interactively, BEG and END are, respectively, the start
603 (interactive "*P\nr") 603and end of the region if it is active, else nil. (The region is
604 (if arg (forward-line 1) 604ignored 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) 251See 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'