109 lines
4.5 KiB
Scheme
109 lines
4.5 KiB
Scheme
;;; Gash -- Guile As SHell
|
|
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
|
;;;
|
|
;;; This file is part of Gash.
|
|
;;;
|
|
;;; Gash is free software: you can redistribute it and/or modify
|
|
;;; it under the terms of the GNU General Public License as published by
|
|
;;; the Free Software Foundation, either version 3 of the License, or
|
|
;;; (at your option) any later version.
|
|
;;;
|
|
;;; Gash is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;; GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; 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-26))
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; The 'read' utility.
|
|
;;;
|
|
;;; 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
|
|
;; quotes, which we do not here. It is simpler to write a specialized
|
|
;; version that can deal with 'max' without quotes than it is to
|
|
;; extend the more general version.
|
|
(define* (split-fields str max hard-delims soft-delims
|
|
#:optional (start 0) (end (string-length str)))
|
|
"Split @var{str} into at most @var{max} fields. Each individual
|
|
occurrence of a character in the set @var{hard-delims} delimits a
|
|
field, while contiguous sequences of characters from the set
|
|
@var{soft-delims} are treated as a single delimiter."
|
|
(define non-soft-delims (char-set-complement soft-delims))
|
|
(define all-delims (char-set-union hard-delims soft-delims))
|
|
|
|
(define* (field+next-index str i)
|
|
(let* ((end* (or (string-index str all-delims i end) end))
|
|
(start* (string-index str non-soft-delims end* end)))
|
|
(values (substring str i end*)
|
|
(if (and start*
|
|
(char-set-contains? hard-delims
|
|
(string-ref str start*)))
|
|
(or (string-index str non-soft-delims (1+ start*) end) end)
|
|
start*))))
|
|
|
|
(cond
|
|
((string-index str non-soft-delims start end)
|
|
=> (lambda (start*)
|
|
(let loop ((i start*) (count 0) (acc '()))
|
|
(if (>= count (1- max))
|
|
(reverse! (cons (string-trim-right str soft-delims i end) acc))
|
|
(call-with-values (lambda () (field+next-index str i))
|
|
(lambda (field i*)
|
|
(if i*
|
|
(loop i* (1+ count) (cons field acc))
|
|
(reverse! (cons field acc)))))))))
|
|
(else '())))
|
|
|
|
(define (main . args)
|
|
(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)))
|