From 804b6cbe0571d20e737d2cee37c4b81020b1dcc3 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Mon, 25 Nov 2019 16:59:36 -0500
Subject: [PATCH] Make 'read' handle logical lines.

* gash/built-ins/read.scm (read-logical-line): New procedure.
(main): Use it unless given the '-r' option.
* tests/read.org: Add tests.
---
 gash/built-ins/read.scm | 55 ++++++++++++++++++++++++++++++-----------
 tests/read.org          | 28 +++++++++++++++++++++
 2 files changed, 68 insertions(+), 15 deletions(-)

diff --git a/gash/built-ins/read.scm b/gash/built-ins/read.scm
index 6f7cf69..b8a3047 100644
--- a/gash/built-ins/read.scm
+++ b/gash/built-ins/read.scm
@@ -17,10 +17,13 @@
 ;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gash built-ins read)
+  #:use-module (gash compat)
+  #:use-module (gash compat textual-ports)
   #:use-module (gash environment)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
-  #:use-module (srfi srfi-1))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26))
 
 ;;; Commentary:
 ;;;
@@ -28,6 +31,21 @@
 ;;;
 ;;; Code:
 
+(define* (read-logical-line #:optional (port (current-input-port)))
+  "Return a ``logical'' line from @var{port} if specified, otherwise
+from the value returned by @code{(current-input-port)}.  A logical
+line allows ignoring a newline character by prefixing it with a
+backslash."
+  (let loop ((acc '()))
+    (match (get-char port)
+      ((? eof-object? eof) (cons (reverse-list->string acc) eof))
+      (#\newline (cons (reverse-list->string acc) #\newline))
+      (#\\ (match (get-char port)
+             ((? eof-object? eof) (cons (reverse-list->string acc) eof))
+             (#\newline (loop acc))
+             (chr (loop (cons chr acc)))))
+      (chr (loop (cons chr acc))))))
+
 ;; The '(gash word)' module already has a 'split-fields' procedure.
 ;; However, we need to be able to specify a maximum number of fields,
 ;; which it cannot do.  We could extend it, but it has to deal with
@@ -67,17 +85,24 @@ field, while contiguous sequences of characters from the set
    (else '())))
 
 (define (main . args)
-  (match (read-line (current-input-port))
-    ((? eof-object?) 1)
-    (str (let* ((limit (length args))
-                (dflt (string #\space #\tab #\newline))
-                (ifs (string->char-set (getvar "IFS" dflt)))
-                (ifs/w (char-set-intersection ifs char-set:whitespace))
-                (ifs/nw (char-set-difference ifs char-set:whitespace))
-                (fields (split-fields str limit ifs/nw ifs/w)))
-           (for-each (lambda (var field)
-                       ;; XXX: Verify that VAR is a valid variable name.
-                       (setvar! var field))
-                     args
-                     (append fields (circular-list "")))
-           0))))
+  (match-let* (((vars . get-line)
+                (match args
+                  (("-r" vars ...)
+                   (cons vars (cut read-line (current-input-port) 'split)))
+                  ((vars ...)
+                   (cons vars read-logical-line))))
+               (limit (length vars))
+               ((line . delimiter) (get-line))
+               (dflt (string #\space #\tab #\newline))
+               (ifs (string->char-set (getvar "IFS" dflt)))
+               (ifs/w (char-set-intersection ifs char-set:whitespace))
+               (ifs/nw (char-set-difference ifs char-set:whitespace))
+               (fields (split-fields line limit ifs/nw ifs/w)))
+    (for-each (lambda (var field)
+                ;; XXX: Verify that VAR is a valid variable name.
+                (setvar! var field))
+              vars
+              (append fields (circular-list "")))
+    (if (eof-object? delimiter)
+        EXIT_FAILURE
+        EXIT_SUCCESS)))
diff --git a/tests/read.org b/tests/read.org
index 7d36b52..b529b6c 100644
--- a/tests/read.org
+++ b/tests/read.org
@@ -88,3 +88,31 @@
   foo
   bar baz
 #+end_example
+
+* Allows escaping line breaks
+:script:
+#+begin_src sh
+  echo 'foo\
+  bar' | {
+      read x
+      echo $x
+  }
+#+end_src
+:stdout:
+#+begin_example
+  foobar
+#+end_example
+
+* Understands raw input flag
+:script:
+#+begin_src sh
+  echo 'foo\
+  bar' | {
+      read -r x
+      echo $x
+  }
+#+end_src
+:stdout:
+#+begin_example
+  foo\
+#+end_example