36 lines
1.5 KiB
Scheme
36 lines
1.5 KiB
Scheme
;;; 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 <afiw@linuxposting.xyz>
|
|
|
|
;; 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))))))))
|