Initial commit

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"))))

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")

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))))))))))))

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"))

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)