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

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; 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)

mes/module/mes/guile.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; 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))

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 <janneke@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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)

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)