Add a KEEP-NEWLINES argument to string-lines

* doc/lispref/strings.texi (Creating Strings): Document it.

* lisp/subr.el (string-lines): Add a KEEP-NEWLINES argument.

3 files changed, 55 insertions, 5 deletions

diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index d31807ad2aa..6f620c9d769 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -434,9 +434,11 @@ display purposes; use @code{truncate-string-to-width} or
 (@pxref{Size of Displayed Text}).
 @end defun
 
-@defun string-lines string &optional omit-nulls
+@defun string-lines string &optional omit-nulls keep-newlines
 Split @var{string} into a list of strings on newline boundaries.  If
-@var{omit-nulls}, remove empty lines from the results.
+@var{omit-nulls}, remove empty lines from the results.  if
+@var{keep-newlines}, don't remove the trailing newlines from the
+result strings.
 @end defun
 
 @defun string-pad string length &optional padding start
diff --git a/lisp/subr.el b/lisp/subr.el
index 9623ea63b55..14cab04d429 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6646,10 +6646,36 @@ is inserted before adjusting the number of empty lines."
      ((< (- (point) start) lines)
       (insert (make-string (- lines (- (point) start)) ?\n))))))
 
-(defun string-lines (string &optional omit-nulls)
+(defun string-lines (string &optional omit-nulls keep-newlines)
   "Split STRING into a list of lines.
-If OMIT-NULLS, empty lines will be removed from the results."
-  (split-string string "\n" omit-nulls))
+If OMIT-NULLS, empty lines will be removed from the results.
+If KEEP-NEWLINES, don't strip trailing newlines from the result
+lines."
+  (let ((lines nil)
+        (start 0))
+    (while (< start (length string))
+      (if-let ((newline (string-search "\n" string start)))
+          (progn
+            (when (or (not omit-nulls)
+                      (not (= start newline)))
+              (let ((line (substring string start
+                                     (if keep-newlines
+                                         (1+ newline)
+                                       newline))))
+                (when (not (and keep-newlines omit-nulls
+                                (equal line "\n")))
+                  (push line lines))))
+            (setq start (1+ newline))
+            ;; Include the final newline.
+            (when (and (= start (length string))
+                       (not omit-nulls)
+                       (not keep-newlines))
+              (push "" lines)))
+        (if (zerop start)
+            (push string lines)
+          (push (substring string start) lines))
+        (setq start (length string))))
+    (nreverse lines)))
 
 (defun buffer-match-p (condition buffer-or-name &optional arg)
   "Return non-nil if BUFFER-OR-NAME matches CONDITION.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index e027c68d0b2..c431930c272 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1028,5 +1028,27 @@ final or penultimate step during initialization."))
   (should (readablep "foo"))
   (should-not (readablep (list (make-marker)))))
 
+(ert-deftest test-string-lines ()
+  (should (equal (string-lines "foo") '("foo")))
+  (should (equal (string-lines "foo\n") '("foo" "")))
+  (should (equal (string-lines "foo\nbar") '("foo" "bar")))
+
+  (should (equal (string-lines "foo" t) '("foo")))
+  (should (equal (string-lines "foo\n" t) '("foo")))
+  (should (equal (string-lines "foo\nbar" t) '("foo" "bar")))
+  (should (equal (string-lines "foo\n\n\nbar" t) '("foo" "bar")))
+
+  (should (equal (string-lines "foo" nil t) '("foo")))
+  (should (equal (string-lines "foo\n" nil t) '("foo\n")))
+  (should (equal (string-lines "foo\nbar" nil t) '("foo\n" "bar")))
+  (should (equal (string-lines "foo\n\n\nbar" nil t)
+                 '("foo\n" "\n" "\n" "bar")))
+
+  (should (equal (string-lines "foo" t t) '("foo")))
+  (should (equal (string-lines "foo\n" t t) '("foo\n")))
+  (should (equal (string-lines "foo\nbar" t t) '("foo\n" "bar")))
+  (should (equal (string-lines "foo\n\n\nbar" t t)
+                 '("foo\n" "bar"))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here