From 2bae7da012e2125762855ce014e63345ecbbbb18 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Tue, 7 Jun 2011 22:15:26 +0300
Subject: Improve conjugator

* data/dbverb.struct: Remove individual verb definitions.
* data/irregular-verbs.xml: New file.
* scm/verbop.scm: New file.
* scm/Makefile.am: Add rules for verbop.
* scm/conjugator.scm: Various fixes.
* src/ellinika/elmorph.c (elstr-accent-position): Fix handling
of string arguments.
(_elstr_set_accent): Fix error message.
(elstr-set-accent-character)
(elstr-set-accent-character!): New functions.
---
 src/ellinika/elmorph.c | 66 +++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 63 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/ellinika/elmorph.c b/src/ellinika/elmorph.c
index f55e010..1831610 100644
--- a/src/ellinika/elmorph.c
+++ b/src/ellinika/elmorph.c
@@ -352,7 +352,7 @@ SCM_DEFINE_PUBLIC(scm_elstr_accent_position, "elstr-accent-position", 1, 0, 0,
 #define FUNC_NAME s_scm_elstr_accent_position
 {
 	struct elstr *elstr;
-	force_elstr(&elstr, el, 0, SCM_ARG1, FUNC_NAME);
+	force_elstr(&elstr, el, 1, SCM_ARG1, FUNC_NAME);
 	return scm_from_uint(elstr->acc_pos);
 }
 #undef FUNC_NAME
@@ -559,7 +559,7 @@ _elstr_set_accent(SCM el, SCM n, int destructive, const char *func_name)
 	if (num > elstr->nsyl)
 		scm_misc_error(func_name,
 			       "cannot set accent on syllable #~S: not enough syllables: ~S",
-			       scm_list_2(el, n));
+			       scm_list_2(n, el));
 	acc_num = elstr->nsyl - num;
 	if (acc_num == 0)
 		start = 0;
@@ -613,7 +613,67 @@ SCM_DEFINE_PUBLIC(scm_elstr_set_accent_x, "elstr-set-accent!",
 {
 	return _elstr_set_accent(el, n, 1, s_scm_elstr_set_accent_x);
 }
-#undef FUNC_NAME
+
+static SCM
+_elstr_set_accent_on_char(SCM el, SCM n, int destructive, const char *func_name)
+{
+	struct elstr *elstr;
+	unsigned i;
+	unsigned acc_num, num, len, start;
+	SCM scm;
+	int dstate;
+	
+	if (destructive) {
+		SCM_ASSERT(scm_is_elstr(el), el, SCM_ARG1, func_name);
+		elstr = (struct elstr*) SCM_CDR(el);
+	} else
+		scm = force_elstr(&elstr, el, 0, SCM_ARG1, func_name);
+
+	SCM_ASSERT(scm_is_integer(n), n, SCM_ARG2, func_name);
+	num = scm_to_uint(n);
+	if (num > elstr->len)
+		scm_misc_error(func_name,
+			       "cannot set accent on character #~S: not enough characters: ~S",
+			       scm_list_2(el, n));
+	if (!elchr_isvowel(elstr->str[num]))
+		scm_misc_error(func_name,
+			       "cannot set accent on character #~S: not a vowel: ~S",
+			       scm_list_2(el, n));
+			       
+	if (destructive)
+		scm = SCM_UNSPECIFIED;
+	else if (scm == el) {
+		scm = _elstr_dup(elstr);
+		elstr = (struct elstr*) SCM_CDR(scm);
+	}
+
+        /* Clear all accents */
+	for (i = 0; i < elstr->len; i++)
+		elstr->str[i] = elchr_deaccent(elstr->str[i]);
+	
+	elstr->str[num] = elchr_accent(elstr->str[num], CHF_OXEIA);
+	_elstr_syllabize(elstr);
+	return scm;
+}
+
+SCM_DEFINE_PUBLIC(scm_elstr_set_accent_character, "elstr-set-accent-character",
+		  2, 0, 0,
+		  (SCM el, SCM n),
+"Set accent on Nth character of EL\n")
+{
+	return _elstr_set_accent_on_char(el, n, 0,
+					 s_scm_elstr_set_accent_character);
+}
+
+SCM_DEFINE_PUBLIC(scm_elstr_set_accent_character_x,
+		  "elstr-set-accent-character!",
+		  2, 0, 0,
+		  (SCM el, SCM n),
+"Set accent on Nth character of EL (destructive)\n")
+{
+	return _elstr_set_accent_on_char(el, n, 1,
+					 s_scm_elstr_set_accent_character_x);
+}
 
 SCM_DEFINE_PUBLIC(scm_elstr_char_prop_bitmask, "elstr-char-prop-bitmask",
 		  2, 0, 0,
-- 
cgit v1.2.1