artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Fix dumping of strings > M1_STRING_MAX.

Browse source 
* module/mes/M1.mes (object->M1): Skip opening quote.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-02 15:53:37 +02:00
parent 6d3fee91b9
commit f8eaebf713
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 14 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
module/mes/M1.mes
View file

@ -158,20 +158,26 @@
(string-append "&" label)))))) (string-append "&" label))))))
(let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o) (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
(string->label (car o)))) (string->label (car o))))
(string? (string-prefix? "_string" label))
(foo (if (not (eq? (car (string->list label)) #\_)) (foo (if (not (eq? (car (string->list label)) #\_))
(display (string-append " :" label "\n") (current-error-port)))) (display (string-append " :" label "\n") (current-error-port))))
(data (cdr o)) (data (cdr o))
(data (filter-map labelize data)) (data (filter-map labelize data))
(len (length data)) (len (length data))
(string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 80))) (string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 256))
(string-data (and string? (list-head data (1- (length data))))))
(display (string-append "\n:" label "\n")) (display (string-append "\n:" label "\n"))
(cond ((and (< len string-max) (if (and string-data
(< len string-max)
(char? (car data)) (char? (car data))
(eq? (last data) #\nul) (eq? (last data) #\nul)
(not (find (cut memq <> '(#\nul #\backspace #\return #\" #\')) (list-head data (1- (length data))))) (not (find (cut memq <> '(#\")) string-data))
(not (any (lambda (ch) (>= (char->integer ch) #x80)) data))) (not (any (lambda (ch)
(display (string-append "\"" (list->string (list-head data (1- (length data)))) "\""))) (or (and (not (memq ch '(#\tab #\newline)))
(else (display-join (map text->M1 data) " "))) (< (char->integer ch) #x20))
(>= (char->integer ch) #x80))) string-data)))
(display (string-append "\"" (list->string string-data) "\""))
(display-join (map text->M1 data) " "))
(newline))) (newline)))
(display "M1: functions\n" (current-error-port)) (display "M1: functions\n" (current-error-port))
(for-each write-function (filter cdr functions)) (for-each write-function (filter cdr functions))