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 @@
           <p n="p" p="2">πείτε,πέστε</p>
         </t>
       </imp>
     </act>
     <pas>
       <root theme="aor">ειπώθ</root>
+      <root theme="aor">λεχθ</root>
       <ind>
         <t name="Ενεστώτας">
           <prop name="root">λέγ</prop>
         </t>
         <t name="Παρατατικός">
           <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))" "$@"
 (define (get-conjugation)
   (let ((ret conjugation))
     (set! conjugation #f)
     ret))
 
 (define (conjugation-set key val)
-  (set! conjugation
-        (if conjugation
-            (append conjugation (list (cons key val)))
-            (list (cons key val)))))
+  (let ((elt (cond
+              ((not (eq? key #:root))
+               (cons key val))
+              ((and conjugation (assoc (car val) conjugation)) =>
+               (lambda (entry)
+                 (set-cdr! entry (cons (cdr val) (cdr entry)))))
+              (else
+               (cons key (list val))))))
+    (set! conjugation
+          (if conjugation
+              (append conjugation (list elt))
+              (list elt)))))
       
 
 ;;; Verb structure:
 (define verbdef '())
   
 (define (verbdef:index c)
@@ -219,20 +227,22 @@ VALUES (~Q,~Q,~Q,~Q,~Q)"
              mood
              tense
              ident))
 
 (define (flush-mood mood vstr)
   (if (eq? (car mood) #:root)
-      (let ((val (cdr mood)))
-        (ellinika:sql-query
-         "INSERT INTO irregular_root (verb,voice,thema,root) \
+      (for-each
+       (lambda (val)
+         (ellinika:sql-query
+          "INSERT INTO irregular_root (verb,voice,thema,root) \
 VALUES (~Q,~Q,~Q,~Q)"
-                   (verb-get #:verb)
-                   vstr
-                   (car val)
-                   (cdr val)))
+          (verb-get #:verb)
+          vstr
+          (car val)
+          (cdr val)))
+       (cdr mood))
       (let ((mood-str (car mood)))
         (let ((lst (cdr mood)))
           (cond
            ((null? lst)
             (for-each
              (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))
  WHERE sound LIKE ~Q\
  AND (pos & 1048576) <> 0 ORDER BY 1"
                  (ellinika:sounds-like key))))
     (cond
      ((null? result)
       (search-failure key))
+     ((= (length result) 1)
+      (show-conjugation (caar result)))
      (else
       (format #t
               "<div class=\"error\"><p>~A</p></div>"
               (_ "Στην λέξη εισαγωγής δεν υπάρχει τόνος. Μήπος θέλατε να κλίσετε ένα απ'αυτά τα ρήματα:")) 
       (display "<table width=\"100%\" class=\"noframe\">")
       (let* ((result-length (length result))
@@ -404,12 +406,13 @@ ifelse(IFACE,[CGI],(cgi:init))
                                          (display name)
                                          (display "=")
                                          (display v)))))))
                             (cgi:names))))
                    (cons "@@conj@@"
                          (lambda ()
+                           (format #t "<!-- ~A -->" (environ))
                            (dict-connect)
                            (main-form)
                            (do-conj)
                            (if (not (null? unattested))
                                (footnotes)))))))
      
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 @@
      (list-set! verb 0 value))
     ((#:verb)
      (list-set! verb 1 value))
     ((#:attested)
      (list-set! verb 3 (append (list-ref verb 3) (list value))))
     (else
-     (let ((container (assoc key (list-ref verb 2))))
+     (let ((container (assoc key (list-ref verb 2)))
+           (value (if (and (eq? key #:root) (not (list? value)))
+                      (list value)
+                      value)))
        (if container
            (set-cdr! container value)
            (list-set! verb 2 (append (list-ref verb 2)
                                      (list
                                       (cons key value)))))))))
 
@@ -98,27 +101,39 @@
 (define (load-verb-info verb voice mood tense)
 ;  (format #t "LOAD ~A~%" verb)
   (let ((verbprop (ellinika:sql-query
                    "SELECT property,value FROM verbtense WHERE \
 verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
                    verb voice mood tense)))
-    (create-basic-verb-info verb
-                            (if (null? verbprop)
-                                '()
-                                (map
-                                 (lambda (elt)
-                                   (let ((name (car elt))
-                                         (value (cadr elt)))
-                                     (if (string=? name "override")
-                                         (cons #:override
-                                               (string-split value #\,))
-                                         (cons (symbol->keyword
-                                                (string->symbol name))
-                                               value))))
-                                 verbprop)))))
-    
+    (create-basic-verb-info
+     verb
+     (let loop ((inlist (if (null? verbprop)
+                            '()
+                            (map
+                             (lambda (elt)
+                               (let ((name (car elt))
+                                     (value (cadr elt)))
+                                 (if (string=? name "override")
+                                     (cons #:override
+                                           (string-split value #\,))
+                                     (cons (symbol->keyword
+                                            (string->symbol name))
+                                           value))))
+                             verbprop)))
+                (rootlist '())
+                (outlist '()))
+;       (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist)
+       (cond
+        ((null? inlist)
+         (if (null? rootlist)
+             outlist
+             (cons (cons #:root rootlist) outlist)))
+        ((eq? (caar inlist) #:root)
+         (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist))
+        (else
+         (loop (cdr inlist) rootlist (cons (car inlist) outlist))))))))
         
 (define (thema-aoristoy-mesapathitikis-A root)
   (cond
    ((elstr-suffix? root "αίν")
     (elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ
    ((and
@@ -189,13 +204,13 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
                       (lookup-verb-info verb voice "aor")
                       tmpres))))
     (verb-set! vinfo #:root
                (cond
                 ((not (null? result))
                  (verb-set! vinfo #:attested 'root)