mescc: Bugfix: output M1-strings if possible.

[mes.git] / module / mes / M1.mes

diff --git a/module/mes/M1.mes b/module/mes/M1.mes
index 470a183863003aa78085a66b9fc03fc858ed10e5..0740e2aa34398fa762e6a90f88cdc6c69b529e50 100644 (file)
--- a/module/mes/M1.mes
+++ b/module/mes/M1.mes
@@ -142,14 +142,14 @@
       (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
                        (string->label (car o))))
              (data (cdr o))
       (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
                        (string->label (car o))))
              (data (cdr o))

-             (data (filter-map labelize data)))
+             (data (filter-map labelize data))
+             (len (length data))
+             (string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 0)))

         (format #t "\n:~a\n" label)
         (format #t "\n:~a\n" label)

-        (cond ((and (char? (car data))
-                    ;; FIXME: 0 in M1 strings
-                    (not (find (cut eq? #\nul <>) (list-head data (1- (length data)))))
-                    ;; FIXME: " in M1 strings
-                    (not (find (cut member <> '(#\" #\' #\backspace)) data))
-                    (eq? (last data)= #\nul))
+        (cond ((and (< len string-max)
+                    (char? (car data))
+                    (eq? (last data) #\nul)
+                    (not (find (cut memq <> '(#\nul #\backspace #\return #\" #\')) (list-head data (1- (length data))))))

                (format #t "\"~a\"" (list->string (list-head data (1- (length data))))))
               (else (format #t "~a" (string-join (map text->M1 data) " "))))
         (newline)))
                (format #t "\"~a\"" (list->string (list-head data (1- (length data))))))
               (else (format #t "~a" (string-join (map text->M1 data) " "))))
         (newline)))