feat: add adjective declension
Some checks failed
CI / build (29.4) (push) Failing after 1m15s
CI / build (snapshot) (push) Failing after 58s

This commit is contained in:
Lucien Cartier-Tilet 2024-09-14 14:03:40 +02:00
parent 00d0b2f1ae
commit 7a97a51361
Signed by: phundrak
GPG Key ID: 347803E8073EACE0
3 changed files with 121 additions and 7 deletions

1
Eask
View File

@ -17,3 +17,4 @@
(depends-on "org" "9") (depends-on "org" "9")
(depends-on "counsel" "0.13") (depends-on "counsel" "0.13")
(depends-on "dash" "2.19") (depends-on "dash" "2.19")
(depends-on "s" "1.13")

View File

@ -29,11 +29,33 @@
;;; Code: ;;; Code:
(require 'dash) (require 'dash)
(require 's)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constants ; ;; Constants ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst conlanging-eittlandic--vowels
'("a" "e" "i" "o" "u" "y" "á" "é" "í" "ó" "ú" "ý")
"Vowels in Eittlandic.")
(defconst conlanging-eittlandic--rounded-vowels
'("o" "u" "y" "ó" "ú" "ý")
"Rounded vowels in Eittlandic.")
; Adjectives ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst conlanging-eittlandic--adjective-inflexion-common
'("r" "" "um" "s" "ar" "" "um" "ar")
"Declensions of Eittlandic adjectives for the common gender.
See also `conlanging-eittlandic--strong-common-noun-declension'.")
(defconst conlanging-eittlandic--adjective-inflexion-neuter
'("t" "t" "um" "s" "" "" "um" "r")
"Declensions of Eittlandic adjectives for the neuter gender.
See also `conlanging-eittlandic--strong-common-noun-declension'.")
; Verbs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Verbs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst conlanging-eittlandic--generic-verb-inflexion-indicative-present (defconst conlanging-eittlandic--generic-verb-inflexion-indicative-present
@ -133,6 +155,10 @@ See `conlanging-eittlandic--strong-common-noun-declension' for more info.")
; Generic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Generic ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun conlanging-eittlandic--string-ends-with-p (str suffix)
"Determine whether STR ends with SUFFIX."
(string-match (regexp-quote suffix) str (- (length str) (length suffix))))
(defun conlanging-eittlandic--maybe-underlying-vowel (underlying-vowel default-vowel) (defun conlanging-eittlandic--maybe-underlying-vowel (underlying-vowel default-vowel)
"Return which underlying vowel should be used. "Return which underlying vowel should be used.
@ -152,7 +178,7 @@ UNDERLYING-VOWEL is non-nil."
(defun conlanging-eittlandic--generate-declension-from-table (root underlying-vowel table) (defun conlanging-eittlandic--generate-declension-from-table (root underlying-vowel table)
"Decline a ROOT (with maybe an UNDERLYING-VOWEL) with TABLE." "Decline a ROOT (with maybe an UNDERLYING-VOWEL) with TABLE."
(seq-reverse (reverse
(let (result) (let (result)
(dolist (declension table result) (dolist (declension table result)
(push (concat root (push (concat root
@ -160,13 +186,92 @@ UNDERLYING-VOWEL is non-nil."
(cdr declension)) (cdr declension))
result))))) result)))))
; Adjectives ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun conlanging-eittlandic--starts-with-any-p (str list)
"Check whether STR start with any element of LIST."
(seq-some (lambda (elt) (s-starts-with-p elt str)) list))
(defun conlanging-eittlandic--ends-with-any-p (str list)
"Check whether STR end with any element of LIST."
(seq-some (lambda (elt) (s-ends-with-p elt str)) list))
(defun conlanging-eittlandic--ends-with-a-vowel-p (str)
"Return whether STR end with a vowel."
(conlanging-eittlandic--ends-with-any-p str conlanging-eittlandic--vowels))
(defun conlanging-eittlandic--starts-with-a-vowel-p (str)
"Return whether STR start with a vowel."
(conlanging-eittlandic--starts-with-any-p str conlanging-eittlandic--vowels))
(defun conlanging-eittlandic--ends-with-a-vowel-p (str)
"Return whether STR start with a vowel."
(conlanging-eittlandic--ends-with-any-p str conlanging-eittlandic--vowels))
(defun conlanging-eittlandic--ends-with-a-rounded-vowel-p (str)
"Return whether STR start with a rounded vowel."
(conlanging-eittlandic--ends-with-any-p str conlanging-eittlandic--rounded-vowels))
(defun conlanging-eittlandic--generate-adjective-declension-from-table (root table)
"Generate an adjective's declensions from its ROOT.
The TABLE stores the adjectives declensions.
If the declension starts with a vowel, then a \"v\" will be
inserted before it if the root ends with a rounded vowel.
Otherwise, if any other vowel ends the root and the declension
starts with a vowel, the last onsonant of the declension will be
inserted before the declension itself.
We assume here any former long vowel cannot be unstressed."
(reverse
(let* (declensions
(root-ends-with-vowel (conlanging-eittlandic--ends-with-a-vowel-p root))
(root-ends-with-rounded-vowel (conlanging-eittlandic--ends-with-a-rounded-vowel-p root)))
(dolist (declension table declensions)
(push
(let ((declension-starts-with-vowel (conlanging-eittlandic--starts-with-a-vowel-p declension)))
(cond
((and root-ends-with-rounded-vowel declension-starts-with-vowel)
(concat root "v" declension))
((and root-ends-with-vowel declension-starts-with-vowel)
(concat root (s-right 1 declension) declension))
(t (concat root declension))))
declensions)))))
(defun conlanging-eittlandic--make-adjective-declension (root gender)
"Create declensions for an Eittlandic adjective.
The declension is based on the adjectives ROOT and the GENDER it
agrees with."
(conlanging-eittlandic--generate-adjective-declension-from-table
root
(if (eq 'common gender)
conlanging-eittlandic--adjective-inflexion-common
conlanging-eittlandic--adjective-inflexion-neuter)))
(defmacro conlanging-eittlandic--build-adjective-declension-org ()
"Just to avoid typing all of this out."
`(format "| | Common | Neuter |
|---------+--------+--------|
| Sg.Nom. | %s | %s |
| Acc.| %s | %s |
| Dat.| %s | %s |
| Gen.| %s | %s |
| Pl.Nom. | %s | %s |
| Acc.| %s | %s |
| Dat.| %s | %s |
| Gen.| %s | %s |"
,@(reverse (let ((i 0)
declensions)
(while (< i 8)
(dolist (gender '(common neuter) declensions)
(push `(nth ,i ,gender) declensions))
(setq i (1+ i)))
declensions))))
; Verbs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Verbs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro conlanging-eittlandic--build-verb-declension-org () (defmacro conlanging-eittlandic--build-verb-declension-org ()
"Just to avoid typing all of this out. "Just to avoid typing all of this out."
ROOT, IMPERATIVE-PASSIVE, PRESENT-PARTICIPLE, PAST-PARTICIPLE,
IND-PRES, SUBJ-PRES, PAST, and PASSIVE are all different forms of
the verb that will be inserted in the org text."
`(format "Declensions: `(format "Declensions:
- infinitive :: %s - infinitive :: %s
- imperative :: %s - imperative :: %s
@ -278,6 +383,14 @@ list, going in the following order:
;; Public functions ; ;; Public functions ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun conlanging-eittlandic-insert-adjective-declension (root)
"Insert adjective declensions of ROOT."
(interactive "sAdjective root: ")
(let ((common (conlanging-eittlandic--make-adjective-declension root 'common))
(neuter (conlanging-eittlandic--make-adjective-declension root 'neuter)))
(insert (conlanging-eittlandic--build-adjective-declension-org))))
;;;###autoload ;;;###autoload
(defun conlanging-eittlandic-insert-verb-declension (root strength underlying-vowel) (defun conlanging-eittlandic-insert-verb-declension (root strength underlying-vowel)
"Insert declensions of ROOT in org format at point. "Insert declensions of ROOT in org format at point.

View File

@ -3,7 +3,7 @@
;; Author: Lucien Cartier-Tilet ;; Author: Lucien Cartier-Tilet
;; Maintainer: Lucien Cartier-Tilet ;; Maintainer: Lucien Cartier-Tilet
;; Version: 0.1.0 ;; Version: 0.1.0
;; Package-Requires: ((emacs "29") (org "9") (ivy "0.13") (counsel "0.13") (dash "2.19")) ;; Package-Requires: ((emacs "29") (org "9") (ivy "0.13") (counsel "0.13") (dash "2.19") (s "1.13"))
;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el ;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el
;; Keywords: convenience ;; Keywords: convenience