WiLiKiソース解読:src/extract.scm
(define (scan-src file)
(define msgs '())
(define (rec expr)
(when (pair? expr)
(if (and (eq? (car expr) '$$)
(pair? (cdr expr))
(null? (cddr expr))
(string? (cadr expr)))
(push! msgs
`(,(cadr expr) ,(pair-attribute-get expr 'source-info #f) ""))
(for-each rec expr))))
(rec (call-with-input-file file port->sexp-list))
msgs)
(define (scan-msgfile file)
(if (file-exists? file)
(call-with-input-file file port->sexp-list)
'()))
(define (multiline-string str)
(string-append
"\""
(string-join
(map (cut regexp-replace-all #/[\"\\]/ <> (lambda (m) #`"\\,(m 0)"))
(string-split str #\newline))
"\n")
"\""))
(define (main args)
(unless (= (length args) 3)
(error "usage: gosh extract.scm file.scm msg-file"))
(let* ((src-file (cadr args))
(dst-file (caddr args))
(dst-tmp (string-append dst-file ".t"))
(src-msgs (scan-src src-file))
(dst-msgs (scan-msgfile dst-file)))
(for-each (lambda (dst-msg)
(cond ((assoc (car dst-msg) src-msgs)
=> (lambda (p)
(set! (caddr p) (cadr dst-msg))
(set! (cddr dst-msg) #t)))))
dst-msgs)
(call-with-output-file (string-append dst-file ".t")
(lambda (p)
(for-each (lambda (src-msg)
(apply format p ";; ~a : line ~a\n" (cadr src-msg))
(format p "(~a\n" (multiline-string (car src-msg)))
(format p " ~a\n" (multiline-string (caddr src-msg)))
(format p ")\n\n"))
(reverse src-msgs))
(for-each (lambda (dst-msg)
(when (null? (cddr dst-msg))
(format p "#| obsoleted message\n")
(format p "~a\n" (multiline-string (car dst-msg)))
(format p "~a\n|#\n" (multiline-string (cadr dst-msg)))))
(reverse dst-msgs))))
(when (file-exists? dst-file)
(sys-rename dst-file (string-append dst-file ".orig")))
(sys-rename dst-tmp dst-file))
0)
Last modified : 2003/03/24 07:15:14 UTC