From 222808c4bb3bef68ef4511c96e9f67b291c01c35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?c=C3=A6l=C5=8Drum=20spect=C4=81tr=C4=ABx?= Date: Thu, 4 Dec 2025 12:00:40 +0100 Subject: [PATCH] Initial commit --- .gitignore | 5 +++++ COPYING | 24 ++++++++++++++++++++++++ abbrev.egg | 9 +++++++++ abbrev.release-info | 4 ++++ abbrev.scm | 36 ++++++++++++++++++++++++++++++++++++ abbrev.sld | 14 ++++++++++++++ tests/run.scm | 33 +++++++++++++++++++++++++++++++++ 7 files changed, 125 insertions(+) create mode 100644 .gitignore create mode 100644 COPYING create mode 100644 abbrev.egg create mode 100644 abbrev.release-info create mode 100644 abbrev.scm create mode 100644 abbrev.sld create mode 100644 tests/run.scm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7984d73 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +*.so +*.o +*.import.scm +*.link +*.sh diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..bdd71a2 --- /dev/null +++ b/COPYING @@ -0,0 +1,24 @@ +# Open Works License + +This is version 0.9.4 of the Open Works License + +## Terms + +Permission is hereby granted by the holder(s) of copyright or other legal +privileges, author(s) or assembler(s), and contributor(s) of this work, to any +person who obtains a copy of this work in any form, to reproduce, modify, +distribute, publish, sell, sublicense, use, and/or otherwise deal in the +licensed material without restriction, provided the following conditions are +met: + +Redistributions, modified or unmodified, in whole or in part, must retain +applicable copyright and other legal privilege notices, the above license +notice, these conditions, and the following disclaimer. + +NO WARRANTY OF ANY KIND IS IMPLIED BY, OR SHOULD BE INFERRED FROM, THIS LICENSE +OR THE ACT OF DISTRIBUTION UNDER THE TERMS OF THIS LICENSE, INCLUDING BUT NOT +LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, +AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS, ASSEMBLERS, OR HOLDERS OF +COPYRIGHT OR OTHER LEGAL PRIVILEGE BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER +LIABILITY, WHETHER IN ACTION OF CONTRACT, TORT, OR OTHERWISE ARISING FROM, OUT +OF, OR IN CONNECTION WITH THE WORK OR THE USE OF OR OTHER DEALINGS IN THE WORK. diff --git a/abbrev.egg b/abbrev.egg new file mode 100644 index 0000000..1c78872 --- /dev/null +++ b/abbrev.egg @@ -0,0 +1,9 @@ +;; -*- lisp-data -*- +((synopsis "Create unique abbreviations for a list of strings") + (license "LicenseRef-OWL-0.9.4") + (category misc) + (dependencies srfi-1 srfi-13) + (test-dependencies test) + (maintainer "Lilianna Smólska") + (author "Peter Lane, Lilianna Smólska") + (components (extension abbrev (source "abbrev.sld")))) diff --git a/abbrev.release-info b/abbrev.release-info new file mode 100644 index 0000000..60053de --- /dev/null +++ b/abbrev.release-info @@ -0,0 +1,4 @@ +;; -*- lisp-data -*- +(repo git "git://git.linuxposting.xyz/afiw/chicken-abbrev.git") +(uri targz "https://git.linuxposting.xyz/afiw/chicken-abbrev/archive/{egg-release}.tar.gz") +(release "1.0") diff --git a/abbrev.scm b/abbrev.scm new file mode 100644 index 0000000..cb180ec --- /dev/null +++ b/abbrev.scm @@ -0,0 +1,36 @@ +;;; Abbrev library for R7RS Scheme. +;;; Calculate the set of unique abbreviations for a given set of +;;; words. (Borrowed from Ruby's Abbrev.) + +;;; SPDX-License-Identifier: LicenseRef-OWL-0.9.4 +;;; SPDX-FileCopyrightText: 2017 Peter Lane +;;; SPDX-FileCopyrightText: 2025 afiw + +;; input: a list of strings +;; and an optional string prefix +;; output: list of (abbrev . string) dotted pairs + +(define (abbrev strings #!optional prefix) + (let loop ((abbrevs '()) + (seen '()) + (words strings) + (idx 1)) + (cond ((null? words) ; done + abbrevs) + ((or (and prefix (not (string-prefix? prefix (car words)))) ; does not match prefix + (> idx (string-length (car words)))) ; or at end of word, so go to next word + (loop abbrevs + seen + (cdr words) + 1)) + (else + (let ((new-abbrev (substring (car words) 0 idx))) + (if (member new-abbrev seen string=?) ; if seen abbrev before + (loop (remove (lambda (w) (string=? new-abbrev (car w))) abbrevs) ; delete from abbrevs + seen ; but keep in seen + words + (+ 1 idx)) + (loop (cons (cons new-abbrev (car words)) abbrevs) ; not seen before, so add to abbrevs + (cons new-abbrev seen) ; and store in seen + words + (+ 1 idx)))))))) diff --git a/abbrev.sld b/abbrev.sld new file mode 100644 index 0000000..4edc64e --- /dev/null +++ b/abbrev.sld @@ -0,0 +1,14 @@ +;;; Abbrev library for R7RS Scheme. +;;; Calculate the set of unique abbreviations for a given set of +;;; words. (Borrowed from Ruby's Abbrev.) + +;;; SPDX-License-Identifier: LicenseRef-OWL-0.9.4 +;;; SPDX-FileCopyrightText: (c) 2017 Peter Lane +;;; SPDX-FileCopyrightText: (c) 2025 afiw + +(define-library (abbrev) + (import (scheme base) + (only (srfi-1) remove) + (only (srfi-13) string-prefix?)) + (export abbrev) + (include "abbrev.scm")) diff --git a/tests/run.scm b/tests/run.scm new file mode 100644 index 0000000..989bed6 --- /dev/null +++ b/tests/run.scm @@ -0,0 +1,33 @@ +;;; Abbrev library for R7RS Scheme. +;;; SPDX-License-Identifier: LicenseRef-OWL-0.9.4 +;;; SPDX-FileCopyrightText: 2025 afiw +(import (abbrev) + (test)) +(test "original example" + '(("lisp" . "lisp") + ("lis" . "lisp") + ("li" . "lisp") + ("l" . "lisp") + ("scala" . "scala") + ("scal" . "scala") + ("sca" . "scala") + ("scheme" . "scheme") + ("schem" . "scheme") + ("sche" . "scheme") + ("sch" . "scheme")) + (abbrev '("scheme" "scala" "lisp"))) +(test "original example with prefix" + '(("scala" . "scala") + ("scal" . "scala") + ("sca" . "scala") + ("scheme" . "scheme") + ("schem" . "scheme") + ("sche" . "scheme") + ("sch" . "scheme")) + (abbrev '("scheme" "scala" "lisp") "s")) +(test-assert "empty list" (null? (abbrev '()))) +(test "single-element list" '(("c" . "c")) (abbrev '("c"))) +(test-assert "identical elements" (null? (abbrev '("c" "c")))) +(test-error "non-list argument" (abbrev "")) +(test-error "non-string element" (abbrev '(()))) +(test-exit)