diff options
-rw-r--r-- | data/irregular-verbs.xml | 1 | ||||
-rw-r--r-- | scm/verbop.scm | 32 | ||||
-rw-r--r-- | src/cgi-bin/conj.scm4 | 3 | ||||
-rw-r--r-- | src/ellinika/conjugator.scm | 73 | ||||
-rw-r--r-- | src/ellinika/sql.scm | 2 |
5 files changed, 72 insertions, 39 deletions
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml index 2e604e3..1923d88 100644 --- a/data/irregular-verbs.xml +++ b/data/irregular-verbs.xml | |||
@@ -461,12 +461,13 @@ | |||
461 | <p n="p" p="2">πείτε,πέστε</p> | 461 | <p n="p" p="2">πείτε,πέστε</p> |
462 | </t> | 462 | </t> |
463 | </imp> | 463 | </imp> |
464 | </act> | 464 | </act> |
465 | <pas> | 465 | <pas> |
466 | <root theme="aor">ειπώθ</root> | 466 | <root theme="aor">ειπώθ</root> |
467 | <root theme="aor">λεχθ</root> | ||
467 | <ind> | 468 | <ind> |
468 | <t name="Ενεστώτας"> | 469 | <t name="Ενεστώτας"> |
469 | <prop name="root">λέγ</prop> | 470 | <prop name="root">λέγ</prop> |
470 | </t> | 471 | </t> |
471 | <t name="Παρατατικός"> | 472 | <t name="Παρατατικός"> |
472 | <prop name="root">λέγ</prop> | 473 | <prop name="root">λέγ</prop> |
diff --git a/scm/verbop.scm b/scm/verbop.scm index 0fff38f..8308d70 100644 --- a/scm/verbop.scm +++ b/scm/verbop.scm | |||
@@ -127,16 +127,24 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@" | |||
127 | (define (get-conjugation) | 127 | (define (get-conjugation) |
128 | (let ((ret conjugation)) | 128 | (let ((ret conjugation)) |
129 | (set! conjugation #f) | 129 | (set! conjugation #f) |
130 | ret)) | 130 | ret)) |
131 | 131 | ||
132 | (define (conjugation-set key val) | 132 | (define (conjugation-set key val) |
133 | (set! conjugation | 133 | (let ((elt (cond |
134 | (if conjugation | 134 | ((not (eq? key #:root)) |
135 | (append conjugation (list (cons key val))) | 135 | (cons key val)) |
136 | (list (cons key val))))) | 136 | ((and conjugation (assoc (car val) conjugation)) => |
137 | (lambda (entry) | ||
138 | (set-cdr! entry (cons (cdr val) (cdr entry))))) | ||
139 | (else | ||
140 | (cons key (list val)))))) | ||
141 | (set! conjugation | ||
142 | (if conjugation | ||
143 | (append conjugation (list elt)) | ||
144 | (list elt))))) | ||
137 | 145 | ||
138 | 146 | ||
139 | ;;; Verb structure: | 147 | ;;; Verb structure: |
140 | (define verbdef '()) | 148 | (define verbdef '()) |
141 | 149 | ||
142 | (define (verbdef:index c) | 150 | (define (verbdef:index c) |
@@ -219,20 +227,22 @@ VALUES (~Q,~Q,~Q,~Q,~Q)" | |||
219 | mood | 227 | mood |
220 | tense | 228 | tense |
221 | ident)) | 229 | ident)) |
222 | 230 | ||
223 | (define (flush-mood mood vstr) | 231 | (define (flush-mood mood vstr) |
224 | (if (eq? (car mood) #:root) | 232 | (if (eq? (car mood) #:root) |
225 | (let ((val (cdr mood))) | 233 | (for-each |
226 | (ellinika:sql-query | 234 | (lambda (val) |
227 | "INSERT INTO irregular_root (verb,voice,thema,root) \ | 235 | (ellinika:sql-query |
236 | "INSERT INTO irregular_root (verb,voice,thema,root) \ | ||
228 | VALUES (~Q,~Q,~Q,~Q)" | 237 | VALUES (~Q,~Q,~Q,~Q)" |
229 | (verb-get #:verb) | 238 | (verb-get #:verb) |
230 | vstr | 239 | vstr |
231 | (car val) | 240 | (car val) |
232 | (cdr val))) | 241 | (cdr val))) |
242 | (cdr mood)) | ||
233 | (let ((mood-str (car mood))) | 243 | (let ((mood-str (car mood))) |
234 | (let ((lst (cdr mood))) | 244 | (let ((lst (cdr mood))) |
235 | (cond | 245 | (cond |
236 | ((null? lst) | 246 | ((null? lst) |
237 | (for-each | 247 | (for-each |
238 | (lambda (tense) | 248 | (lambda (tense) |
diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4 index fec7eca..8c5e317 100644 --- a/src/cgi-bin/conj.scm4 +++ b/src/cgi-bin/conj.scm4 | |||
@@ -325,12 +325,14 @@ ifelse(IFACE,[CGI],(cgi:init)) | |||
325 | WHERE sound LIKE ~Q\ | 325 | WHERE sound LIKE ~Q\ |
326 | AND (pos & 1048576) <> 0 ORDER BY 1" | 326 | AND (pos & 1048576) <> 0 ORDER BY 1" |
327 | (ellinika:sounds-like key)))) | 327 | (ellinika:sounds-like key)))) |
328 | (cond | 328 | (cond |
329 | ((null? result) | 329 | ((null? result) |
330 | (search-failure key)) | 330 | (search-failure key)) |
331 | ((= (length result) 1) | ||
332 | (show-conjugation (caar result))) | ||
331 | (else | 333 | (else |
332 | (format #t | 334 | (format #t |
333 | "<div class=\"error\"><p>~A</p></div>" | 335 | "<div class=\"error\"><p>~A</p></div>" |
334 | (_ "Στην λέξη εισαγωγής δεν υπάρχει τόνος. Μήπος θέλατε να κλίσετε ένα απ'αυτά τα ρήματα:")) | 336 | (_ "Στην λέξη εισαγωγής δεν υπάρχει τόνος. Μήπος θέλατε να κλίσετε ένα απ'αυτά τα ρήματα:")) |
335 | (display "<table width=\"100%\" class=\"noframe\">") | 337 | (display "<table width=\"100%\" class=\"noframe\">") |
336 | (let* ((result-length (length result)) | 338 | (let* ((result-length (length result)) |
@@ -404,12 +406,13 @@ ifelse(IFACE,[CGI],(cgi:init)) | |||
404 | (display name) | 406 | (display name) |
405 | (display "=") | 407 | (display "=") |
406 | (display v))))))) | 408 | (display v))))))) |
407 | (cgi:names)))) | 409 | (cgi:names)))) |
408 | (cons "@@conj@@" | 410 | (cons "@@conj@@" |
409 | (lambda () | 411 | (lambda () |
412 | (format #t "<!-- ~A -->" (environ)) | ||
410 | (dict-connect) | 413 | (dict-connect) |
411 | (main-form) | 414 | (main-form) |
412 | (do-conj) | 415 | (do-conj) |
413 | (if (not (null? unattested)) | 416 | (if (not (null? unattested)) |
414 | (footnotes))))))) | 417 | (footnotes))))))) |
415 | 418 | ||
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index 0abec8d..f70e20c 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm | |||
@@ -44,13 +44,16 @@ | |||
44 | (list-set! verb 0 value)) | 44 | (list-set! verb 0 value)) |
45 | ((#:verb) | 45 | ((#:verb) |
46 | (list-set! verb 1 value)) | 46 | (list-set! verb 1 value)) |
47 | ((#:attested) | 47 | ((#:attested) |
48 | (list-set! verb 3 (append (list-ref verb 3) (list value)))) | 48 | (list-set! verb 3 (append (list-ref verb 3) (list value)))) |
49 | (else | 49 | (else |
50 | (let ((container (assoc key (list-ref verb 2)))) | 50 | (let ((container (assoc key (list-ref verb 2))) |
51 | (value (if (and (eq? key #:root) (not (list? value))) | ||
52 | (list value) | ||
53 | value))) | ||
51 | (if container | 54 | (if container |
52 | (set-cdr! container value) | 55 | (set-cdr! container value) |
53 | (list-set! verb 2 (append (list-ref verb 2) | 56 | (list-set! verb 2 (append (list-ref verb 2) |
54 | (list | 57 | (list |
55 | (cons key value))))))))) | 58 | (cons key value))))))))) |
56 | 59 | ||
@@ -98,27 +101,39 @@ | |||
98 | (define (load-verb-info verb voice mood tense) | 101 | (define (load-verb-info verb voice mood tense) |
99 | ; (format #t "LOAD ~A~%" verb) | 102 | ; (format #t "LOAD ~A~%" verb) |
100 | (let ((verbprop (ellinika:sql-query | 103 | (let ((verbprop (ellinika:sql-query |
101 | "SELECT property,value FROM verbtense WHERE \ | 104 | "SELECT property,value FROM verbtense WHERE \ |
102 | verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | 105 | verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" |
103 | verb voice mood tense))) | 106 | verb voice mood tense))) |
104 | (create-basic-verb-info verb | 107 | (create-basic-verb-info |
105 | (if (null? verbprop) | 108 | verb |
106 | '() | 109 | (let loop ((inlist (if (null? verbprop) |
107 | (map | 110 | '() |
108 | (lambda (elt) | 111 | (map |
109 | (let ((name (car elt)) | 112 | (lambda (elt) |
110 | (value (cadr elt))) | 113 | (let ((name (car elt)) |
111 | (if (string=? name "override") | 114 | (value (cadr elt))) |
112 | (cons #:override | 115 | (if (string=? name "override") |
113 | (string-split value #\,)) | 116 | (cons #:override |
114 | (cons (symbol->keyword | 117 | (string-split value #\,)) |
115 | (string->symbol name)) | 118 | (cons (symbol->keyword |
116 | value)))) | 119 | (string->symbol name)) |
117 | verbprop))))) | 120 | value)))) |
118 | 121 | verbprop))) | |
122 | (rootlist '()) | ||
123 | (outlist '())) | ||
124 | ; (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist) | ||
125 | (cond | ||
126 | ((null? inlist) | ||
127 | (if (null? rootlist) | ||
128 | outlist | ||
129 | (cons (cons #:root rootlist) outlist))) | ||
130 | ((eq? (caar inlist) #:root) | ||
131 | (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist)) | ||
132 | (else | ||
133 | (loop (cdr inlist) rootlist (cons (car inlist) outlist)))))))) | ||
119 | 134 | ||
120 | (define (thema-aoristoy-mesapathitikis-A root) | 135 | (define (thema-aoristoy-mesapathitikis-A root) |
121 | (cond | 136 | (cond |
122 | ((elstr-suffix? root "αίν") | 137 | ((elstr-suffix? root "αίν") |
123 | (elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ | 138 | (elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ |
124 | ((and | 139 | ((and |
@@ -189,13 +204,13 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
189 | (lookup-verb-info verb voice "aor") | 204 | (lookup-verb-info verb voice "aor") |
190 | tmpres)))) | 205 | tmpres)))) |
191 | (verb-set! vinfo #:root | 206 | (verb-set! vinfo #:root |
192 | (cond | 207 | (cond |
193 | ((not (null? result)) | 208 | ((not (null? result)) |
194 | (verb-set! |