From 05293016637437df00d07f631f0f5324af884210 Mon Sep 17 00:00:00 2001 From: afiw Date: Mon, 22 Dec 2025 20:51:05 +0100 Subject: [PATCH] Initial commit --- srfi-233.egg | 9 +++++ srfi-233.release-info | 4 ++ srfi-233.scm | 87 +++++++++++++++++++++++++++++++++++++++++++ srfi-233.sld | 36 ++++++++++++++++++ tests/run.scm | 27 ++++++++++++++ 5 files changed, 163 insertions(+) create mode 100644 srfi-233.egg create mode 100644 srfi-233.release-info create mode 100644 srfi-233.scm create mode 100644 srfi-233.sld create mode 100644 tests/run.scm diff --git a/srfi-233.egg b/srfi-233.egg new file mode 100644 index 0000000..1bc3571 --- /dev/null +++ b/srfi-233.egg @@ -0,0 +1,9 @@ +;; -*- lisp-data -*- +((synopsis "SRFI 233: INI files") + (license "MIT") + (category parsing) + (dependencies srfi-13) + (test-dependencies test) + (maintainer "Lilianna Smólska") + (author "Lilianna Smólska, John Cowan, Arvydas Silanskas") + (components (extension srfi-233 (source "srfi-233.sld")))) diff --git a/srfi-233.release-info b/srfi-233.release-info new file mode 100644 index 0000000..d1d51ba --- /dev/null +++ b/srfi-233.release-info @@ -0,0 +1,4 @@ +;; -*- lisp-data -*- +(repo git "git://git.linuxposting.xyz/afiw/chicken-srfi-233.git") +(uri targz "https://git.linuxposting.xyz/afiw/chicken-srfi-233.git/archive/{egg-release}.tar.gz") +(release "1.0") diff --git a/srfi-233.scm b/srfi-233.scm new file mode 100644 index 0000000..fdbfc34 --- /dev/null +++ b/srfi-233.scm @@ -0,0 +1,87 @@ +;;;; 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)))))))))))) diff --git a/srfi-233.sld b/srfi-233.sld new file mode 100644 index 0000000..80e32d9 --- /dev/null +++ b/srfi-233.sld @@ -0,0 +1,36 @@ +;;;; 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-library (srfi-233) + (import + (scheme base) + (scheme cxr) + (chicken base) + (chicken format) + (srfi-13)) + (export + make-ini-file-generator + make-ini-file-accumulator) + (include "srfi-233.scm")) diff --git a/tests/run.scm b/tests/run.scm new file mode 100644 index 0000000..cbca42a --- /dev/null +++ b/tests/run.scm @@ -0,0 +1,27 @@ +(import (scheme base) + (chicken port) + (srfi-233) + (test)) + +(test "accumulator" + "[section1]\nkey1ævalue1\nß acomment\nvaluewithnokey\n[section2]\nkey2ævalue2\n" + (call-with-output-string + (lambda (out) + (let ((my-accumulator (make-ini-file-accumulator out #\æ #\ß))) + (for-each my-accumulator + (list (list 'section1 'key1 "value1") + "acomment" + (list 'section1 #f "valuewithnokey") + (list 'section2 'key2 "value2"))))))) + +(test "generator" + (list (list 'section1 'key1 "value1") + (list 'section1 #f "valuewithnokey") + (list 'section2 'key2 "value2")) + (call-with-input-string + "[section1]\nkey1øvalue1\nđ acomment\nvaluewithnokey\n[section2]\nkey2øvalue2\n" + (lambda (in) + (let ((my-generator (make-ini-file-generator in #\ø #\đ))) + (port-map identity my-generator))))) + +(test-exit)