;;; Gash -- Guile As SHell ;;; Copyright © 2018, 2019 Timothy Sample ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 . (define-module (gash built-ins echo) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26)) ;;; Commentary: ;;; ;;; The 'echo' utility. ;;; ;;; Code: (define (escape->control string) (list->string (let loop ((lst (string->list string))) (if (null? lst) '() (let ((char (car lst))) (if (or (not (eq? char #\\)) (null? (cdr lst))) (cons char (loop (cdr lst))) (let* ((lst (cdr lst)) (char (car lst))) (case char ((#\\) (cons #\\ (loop (cdr lst)))) ((#\a) (cons #\alarm (loop (cdr lst)))) ((#\b) (cons #\backspace (loop (cdr lst)))) ((#\c) '()) ;; Guile 2.0.9 does not understand '#\escape', ;; so we use the older '#\esc'. ((#\e) (cons #\esc (loop (cdr lst)))) ((#\f) (cons #\page (loop (cdr lst)))) ((#\n) (cons #\newline (loop (cdr lst)))) ((#\r) (cons #\return (loop (cdr lst)))) ((#\t) (cons #\tab (loop (cdr lst)))) ((#\v) (cons #\vtab (loop (cdr lst)))) ((#\0) (error "echo: TODO: \\0NNN")) ((#\x) (error "echo: TODO: \\xNNN")))))))))) (define (option? str) (and (> (string-length str) 1) (char=? (string-ref str 0) #\-) (string-every (cut member <> '(#\E #\e #\n)) (substring str 1)))) (define (main . args) (let* ((options (append-map (compose cdr string->list) (take-while option? args))) (args (drop-while option? args)) (newline? (not (member #\n options))) (escapes? (fold (lambda (x acc) (match x (#\e #t) (#\E #f) (_ acc))) #f options)) (string (string-join args))) (display (if escapes? (escape->control string) string)) (when newline? (newline)) 0))