From 81849edb86863a689de583de357eea758f17e690 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Fri, 19 Jul 2019 15:36:36 +0200 Subject: [PATCH] mes: Remove broken copy of simple-format. * mes/module/mes/simple-format.mes: New file. * mes/module/mes/guile.mes: Use it. (with-output-to-string, simple-format): Remove broken copies. * mes/module/mes/display.mes (with-output-to-string, simple-format, format): Remove. --- mes/module/mes/display.mes | 40 +------------------- mes/module/mes/guile.mes | 40 +------------------- mes/module/mes/simple-format.mes | 63 ++++++++++++++++++++++++++++++++ tests/display.test | 1 + 4 files changed, 67 insertions(+), 77 deletions(-) create mode 100644 mes/module/mes/simple-format.mes diff --git a/mes/module/mes/display.mes b/mes/module/mes/display.mes index 6d3f59d8..e3bbf58e 100644 --- a/mes/module/mes/display.mes +++ b/mes/module/mes/display.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -199,41 +199,3 @@ (define (newline . rest) (apply display (cons "\n" rest))) - -(define (with-output-to-string thunk) - (define save-write-byte write-byte) - (let ((stdout '())) - (set! write-byte - (lambda (x . rest) - (let ((out? (or (null? rest) (eq? (car rest) (current-output-port))))) - (if (not out?) (apply save-write-byte (cons x rest)) - (begin - (set! stdout (append stdout (list (integer->char x)))) - x))))) - (thunk) - (let ((r (apply string stdout))) - (set! write-byte save-write-byte) - r))) - -(define (simple-format destination format . rest) - (let ((port (if (boolean? destination) (current-output-port) destination)) - (lst (string->list format))) - (define (simple-format lst args) - (if (pair? lst) - (let ((c (car lst))) - (if (not (eq? c #\~)) (begin (write-char (car lst) port) - (simple-format (cdr lst) args)) - (let ((c (cadr lst))) - (case c - ((#\A) (display (car args) port)) - ((#\a) (display (car args) port)) - ((#\S) (write (car args) port)) - ((#\s) (write (car args) port)) - (else (display (car args) port))) - (simple-format (cddr lst) (cdr args))))))) - - (if destination (simple-format lst rest) - (with-output-to-string - (lambda () (simple-format lst rest)))))) - -(define format simple-format) diff --git a/mes/module/mes/guile.mes b/mes/module/mes/guile.mes index 1def63dc..00524d00 100644 --- a/mes/module/mes/guile.mes +++ b/mes/module/mes/guile.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -30,6 +30,7 @@ (mes-use-module (mes posix)) (mes-use-module (srfi srfi-16)) (mes-use-module (mes display)) +(mes-use-module (mes simple-format)) (define (drain-input port) (read-string)) @@ -117,42 +118,5 @@ (if (string-null? dir) "." dir)))))) -;; FIXME: c&p from display -(define (with-output-to-string thunk) - (define save-write-byte write-byte) - (let ((stdout '())) - (set! write-byte - (lambda (x . rest) - (let ((out? (or (null? rest) (eq? (car rest) (current-output-port))))) - (if (not out?) (apply save-write-byte (cons x rest)) - (begin - (set! stdout (append stdout (list (integer->char x)))) - x))))) - (thunk) - (let ((r (apply string stdout))) - (set! write-byte save-write-byte) - r))) - -;; FIXME: c&p from display -(define (simple-format destination format . rest) - (let ((port (if (boolean? destination) (current-output-port) destination)) - (lst (string->list format))) - (define (simple-format lst args) - (if (pair? lst) - (let ((c (car lst))) - (if (not (eq? c #\~)) (begin (write-char (car lst) port) - (simple-format (cdr lst) args)) - (let ((c (cadr lst))) - (case c - ((#\a) (display (car args) port)) - ((#\s) (write (car args) port))) - (simple-format (cddr lst) (cdr args))))))) - - (if destination (simple-format lst rest) - (with-output-to-string - (lambda () (simple-format lst rest)))))) - -(define format simple-format) - (define (file-exists? o) (access? o R_OK)) diff --git a/mes/module/mes/simple-format.mes b/mes/module/mes/simple-format.mes new file mode 100644 index 00000000..78794fb4 --- /dev/null +++ b/mes/module/mes/simple-format.mes @@ -0,0 +1,63 @@ +;;; -*-scheme-*- + +;;; GNU Mes --- Maxwell Equations of Software +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen +;;; +;;; This file is part of GNU Mes. +;;; +;;; GNU Mes 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. +;;; +;;; GNU Mes 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 GNU Mes. If not, see . + +;;; Commentary: + +;;; Code: + +(mes-use-module (mes display)) + +(define (with-output-to-string thunk) + (define save-write-byte write-byte) + (let ((stdout '())) + (set! write-byte + (lambda (x . rest) + (let ((out? (or (null? rest) (eq? (car rest) (current-output-port))))) + (if (not out?) (apply save-write-byte (cons x rest)) + (begin + (set! stdout (append stdout (list (integer->char x)))) + x))))) + (thunk) + (let ((r (apply string stdout))) + (set! write-byte save-write-byte) + r))) + +(define (simple-format destination format . rest) + (let ((port (if (boolean? destination) (current-output-port) destination)) + (lst (string->list format))) + (define (simple-format lst args) + (if (pair? lst) + (let ((c (car lst))) + (if (not (eq? c #\~)) (begin (write-char (car lst) port) + (simple-format (cdr lst) args)) + (let ((c (cadr lst))) + (case c + ((#\A) (display (car args) port)) + ((#\a) (display (car args) port)) + ((#\S) (write (car args) port)) + ((#\s) (write (car args) port)) + (else (display (car args) port))) + (simple-format (cddr lst) (cdr args))))))) + + (if destination (simple-format lst rest) + (with-output-to-string + (lambda () (simple-format lst rest)))))) + +(define format simple-format) diff --git a/tests/display.test b/tests/display.test index 8ea2d1a6..c920755e 100755 --- a/tests/display.test +++ b/tests/display.test @@ -27,6 +27,7 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests #:use-module (mes test)) (mes-use-module (mes display)) +(mes-use-module (mes guile)) (mes-use-module (mes test)) (pass-if "first dummy" #t)