87 lines
4 KiB
Scheme
87 lines
4 KiB
Scheme
;;;; SPDX-License-Identifier: MIT
|
|
;;;; SPDX-FileCopyrightText: 2022 John Cowan, Arvydas Silanskas
|
|
;;;; SPDX-FileCopyrightText: 2025 Lilianna Smólska
|
|
|
|
;;;; Copyright (c) 2022 John Cowan, Arvydas Silanskas.
|
|
;;;; Copyright (c) 2025 Lilianna Smólska
|
|
;;;;
|
|
;;;; Permission is hereby granted, free of charge, to any person obtaining a copy of
|
|
;;;; this software and associated documentation files (the "Software"), to deal in
|
|
;;;; the Software without restriction, including without limitation the rights to
|
|
;;;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
|
|
;;;; the Software, and to permit persons to whom the Software is furnished to do so,
|
|
;;;; subject to the following conditions:
|
|
;;;;
|
|
;;;; The above copyright notice and this permission notice (including the next
|
|
;;;; paragraph) shall be included in all copies or substantial portions of the
|
|
;;;; Software.
|
|
;;;;
|
|
;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
|
|
;;;; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
|
|
;;;; COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
|
;;;; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
;;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
|
|
(define (make-ini-file-accumulator port #!optional (key-value-separator #\=) (comment-delimiter #\;))
|
|
(define current-section '||)
|
|
(define (write-comment str)
|
|
(format port "~a ~a~%" comment-delimiter str))
|
|
(define (write-data section key value)
|
|
(unless (eq? section current-section)
|
|
(set! current-section section)
|
|
(format port "[~a]~%" section))
|
|
(if key
|
|
(format port "~a~a~a~%" key key-value-separator value)
|
|
(format port "~a~%" value)))
|
|
(define (data-triple? arg)
|
|
(and (list? arg)
|
|
(= (length arg) 3)
|
|
(symbol? (car arg))
|
|
(or (not (cadr arg))
|
|
(symbol? (cadr arg)))
|
|
(string? (caddr arg))))
|
|
(lambda (arg)
|
|
(cond ((eof-object? arg) (eof-object))
|
|
((string? arg) (write-comment arg))
|
|
((data-triple? arg) (apply write-data arg))
|
|
(else (error (format #f "unexpected input: ~s" arg))))))
|
|
|
|
(define (make-ini-file-generator port #!optional (key-value-separator #\=) (comment-delimiter #\;))
|
|
(define (comment? line)
|
|
(char=? (string-ref line 0) comment-delimiter))
|
|
(define (section line)
|
|
(let ((last-index (sub1 (string-length line))))
|
|
(and (char=? (string-ref line 0) #\[)
|
|
(char=? (string-ref line last-index) #\])
|
|
(string->symbol (string-copy line 1 last-index)))))
|
|
(define (key-value line)
|
|
(let ((separator-position (string-index line key-value-separator)))
|
|
(if separator-position
|
|
(cons (string->symbol (string-trim-right (string-copy line 0 separator-position)))
|
|
(string-trim (string-copy line (add1 separator-position))))
|
|
(cons #f line))))
|
|
(define current-section '||)
|
|
(define at-eof #f)
|
|
(lambda ()
|
|
(if at-eof
|
|
(eof-object)
|
|
(let loop ()
|
|
(let ((line (read-line port)))
|
|
(if (eof-object? line)
|
|
(begin
|
|
(set! at-eof #t)
|
|
(eof-object))
|
|
(let ((trimmed-line (string-trim-both line)))
|
|
(cond
|
|
((string-null? trimmed-line)
|
|
(loop))
|
|
((comment? trimmed-line)
|
|
(loop))
|
|
((section trimmed-line) => (lambda (section)
|
|
(set! current-section section)
|
|
(loop)))
|
|
((key-value trimmed-line) => (lambda (key-value-pair)
|
|
(list current-section
|
|
(car key-value-pair)
|
|
(cdr key-value-pair))))))))))))
|