diff options
-rw-r--r-- | ChangeLog | 35 | ||||
-rw-r--r-- | po/ru.po | 27 | ||||
-rw-r--r-- | scm/conj.scm | 274 | ||||
-rw-r--r-- | scm/xlat.scm | 23 | ||||
-rw-r--r-- | src/trans.h | 5 |
5 files changed, 275 insertions, 89 deletions
@@ -1,3 +1,38 @@ +2004-06-13 Sergey Poznyakoff <gray@Noldor.runasimi.org> + + * mainstyle.css (comment,expl): New styles + + * cgi-bin/dict.cgi.in: Display dictionary stats + + * data/db.struct (stat): New table + * data/dict.m4: New file + * data/dict.0: New file + * data/dict.1: Use m4 macros + * data/dict.2: Likewise + * data/dict.3: Likewise + * data/dict.4: Likewise + * data/dict.5: Likewise + * data/dict.7: Likewise + * po/ru.po: Updated + + * scm/conj.scm: Updated + * scm/xlat.scm: Updated + + * src/gram.y (parse): Change declaration + (yyerror): file_name can be NULL + * src/input.l: Hande LINE statement + (make_m4_args,yywrap,set_location): New functions + (open_input): Preprocess sources using m4 + * src/main.c: Update call to parse(). New command line + options: -I passes include dir to m4, -m sets full path + to m4 binary + (update_stat): Updated stat table. + * src/trans.h: Updated + + * xml/ellinika.ru.xml (dict): Provide dictionary statistics + * xtrans/LINGUA.html.xtrans (BOTTOM): New tag + (ClosePage): Add BOTTOM info, if available + 2004-06-11 Sergey Poznyakoff <gray@Mirddin.farlep.net> * scm: New directory @@ -7,7 +7,7 @@ msgid "" msgstr "" "Project-Id-Version: Ellinika 1.0\n" "Report-Msgid-Bugs-To: gray@gnu.org\n" -"POT-Creation-Date: 2004-03-08 19:38+0200\n" +"POT-Creation-Date: 2004-06-13 18:51+0300\n" "PO-Revision-Date: 2004-03-07 17:40+0200\n" "Last-Translator: Sergey Poznyakoff <gray@gnu.org>, 2004.\n" "Language-Team: Russian <ru@li.org>\n" @@ -18,39 +18,46 @@ msgstr "" "10<=4 && (n%100<10 || n%100>=20) ? 1 : 2;\n" "\n" -#: cgi-bin/dict.cgi:151 +#: cgi-bin/dict.cgi:160 msgid "Εισάγετε τη λέξη" msgstr "Введите слово" -#: cgi-bin/dict.cgi:168 +#: cgi-bin/dict.cgi:177 msgid "Επιλέξτε το μέρος του λόγου" msgstr "Выберите часть речи" -#: cgi-bin/dict.cgi:199 +#: cgi-bin/dict.cgi:208 msgid "Επιλέξτε το θέμα" msgstr "Выберите тему" -#: cgi-bin/dict.cgi:229 +#: cgi-bin/dict.cgi:238 msgid "Αναζήτηση" msgstr "Поиск" -#: cgi-bin/dict.cgi:590 +#: cgi-bin/dict.cgi:668 #, lisp-format msgid "Συγγνώμη, η λέξη \"~A\" δεν βρέθηκε στο λέξικο." msgstr "Извините, слово \"~A\" не найдено в словаре." -#: cgi-bin/dict.cgi:688 +#: cgi-bin/dict.cgi:769 msgid "Антоним: " msgstr "Антоним: " -#: cgi-bin/dict.cgi:688 +#: cgi-bin/dict.cgi:769 msgid "Антонимы: " msgstr "Антонимы: " -#: cgi-bin/dict.cgi:697 +#: cgi-bin/dict.cgi:778 msgid "См. также " msgstr "См. также " -#: cgi-bin/dict.cgi:707 +#: cgi-bin/dict.cgi:788 msgid "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε." msgstr "ОШИБКА: не удалось подключится к словарю." + +#: cgi-bin/dict.cgi:839 +msgid "λέξη" +msgid_plural "λέξεις" +msgstr[0] "слово" +msgstr[1] "слова" +msgstr[2] "слов"
\ No newline at end of file diff --git a/scm/conj.scm b/scm/conj.scm index 781d630..3c2e96a 100644 --- a/scm/conj.scm +++ b/scm/conj.scm @@ -30,7 +30,7 @@ ((and (not (null? (cdr last-syllable))) (or (char=? (cadr last-syllable) #\a) (char=? (cadr last-syllable) #\e))) - (set! last-syllable (cons #\* (cddr last-syllable)))))) + (set! last-syllable (cons #\* (cdr last-syllable)))))) (else (throw 'grammar "Dont't know how to handle " present-root))) (cons last-syllable (cdr present-root)))) @@ -42,26 +42,15 @@ (define (add-flection word flect) (let* ((syl-list (append (cdr flect) (cdr word))) - (acc-pos (if (car flect) - (car flect) - (+ (car word) (length (cdr flect)))))) + (acc-pos (or (car flect) + (and (car word) + (+ (car word) (length (cdr flect))))))) (cons - (if (> acc-pos 3) + (if (and acc-pos (> acc-pos 3)) 3 acc-pos) syl-list))) -(define (flect-list fun . p) - (cons - fun - (map - (lambda (pers) - (map - (lambda (f) - (cons #f (cdr (greek->xlat f)))) - pers)) - p))) - ; FIXME: Should return real augment! (define (get-augment root) #\e) @@ -74,6 +63,50 @@ (append (cdr word) (list (list (get-augment root)))) (cdr word))))) +(define (create-paratatikos-B root flect) + (add-flection root (add-flection (greek->xlat "ούσ") + (cons + #f + (cdr flect))))) + +(define (create-prostaktiki-enestota root flect) + (let ((w (add-flection root flect))) + (cond + ((car flect) + (cons (car flect) (cdr w))) + ((>= (length (cdr w)) 3) + (cons 3 (cdr w))) + ((not (car w)) + (cons (length (cdr w)) (cdr w))) + (else + w)))) + +;; Verbal form Accessors +(define (vtab-root tab) + (car tab)) + +(define (vtab-analizer tab) + (list-ref tab 2)) + +(define (vtab-composer tab) + (or (list-ref tab 1) + add-flection)) + +(define (vtab-flection tab person) + (list-ref tab (+ person 2))) + +;; +(define (flect-list root composer analizer . p) + (append + (list root composer analizer) + (map + (lambda (pers) + (map + greek->xlat + pers)) + p))) + +;; (define verbal-flect-table (list (cons "Α" @@ -84,6 +117,8 @@ (list (cons "ενεστώτας" (flect-list + #:present-root + #f #f (list "ω") (list "εις") @@ -93,7 +128,9 @@ (list "ουν" "ουνε"))) (cons "παρατατικός" (flect-list + #:present-root create-paratatikos-A + #f (list "α") (list "ες") (list "ε") @@ -102,30 +139,121 @@ (list "αν" "ανε"))) (cons "μέλλοντας διαρκείας" (flect-list - (lambda (x) - (list "θα" x)) + #:present-root + #f ;; FIXME: "θα" + #f (list "ω") (list "εις") (list "ει") (list "ουμε") (list "ετε") - (list "ουν" "ουνε"))))))))))) - + (list "ουν" "ουνε"))))) -;; ("άω") -;; ("άς") -;; ("ά" "άει") -;; ("άμε") -;; ("άτε") -;; ("ούν" "ούνε") -;; -;; ("ώ") -;; ("είς") -;; ("εί") -;; ("ούμε") -;; ("είτε") -;; ("ούν" "ούνε") + (cons "προστακτική" + (list + (cons "ενεστώτας" + (flect-list + #:present-root + create-prostaktiki-enestota + #f + '() + (list "ε") + '() + '() + (list "ετε") + '())))) )))) + (cons "Β1" + (list + (cons "ενεργητηκή" + (list + (cons "οριστική" + (list + (cons "ενεστώτας" + (flect-list + #:present-root + #f + #f + (list "άω") + (list "άς") + (list "ά" "άει") + (list "άμε") + (list "άτε") + (list "ούν" "ούνε"))) + (cons "παρατατικός" + (flect-list + #:present-root + create-paratatikos-B + #f + (list "α") + (list "ες") + (list "ε") + (list "αμε") + (list "ατε") + (list "αν" "ανε"))) + (cons "μέλλοντας διαρκείας" + (flect-list + #:present-root + #f ;; FIXME: "θα" + #f + (list "άω") + (list "άς") + (list "ά" "άει") + (list "άμε") + (list "άτε") + (list "ούν" "ούνε"))) )) + (cons "προστακτική" + (list + (cons "ενεστώτας" + (flect-list + #:present-root + create-prostaktiki-enestota + #f + '() + (list "α") + '() + '() + (list "άτε") + '())))) )))) + (cons "Β2" + (list + (cons "ενεργητηκή" + (list + (cons "οριστική" + (list + (cons "ενεστώτας" + (flect-list + #:present-root + #f + #f + (list "ώ") + (list "είς") + (list "εί") + (list "ούμε") + (list "είτε") + (list "ούν" "ούνε"))) + (cons "παρατατικός" + (flect-list + #:present-root + create-paratatikos-B + #f + (list "α") + (list "ες") + (list "ε") + (list "αμε") + (list "ατε") + (list "αν" "ανε"))) + (cons "μέλλοντας διαρκείας" + (flect-list + #:present-root + #f ;; FIXME: "θα" + #f + (list "ώ") + (list "είς") + (list "εί") + (list "ούμε") + (list "είτε") + (list "ούν" "ούνε"))) )))))))) (define (verbal-flect-table-lookup table form-list) (if (null? form-list) @@ -139,53 +267,69 @@ (verbal-flect-table-lookup verbal-flect-table rest)) -(define (conjugate root pers . forms) +(define (conjugate root pers forms) (let ((tab (verbal-flect-table-lookup verbal-flect-table forms))) (if (not tab) (throw 'grammar "Verbal form not found " forms)) - (let ((func (or (car tab) - add-flection))) + (let ((func (vtab-composer tab)) + (root-selector (vtab-root tab))) + (map (lambda (x) (func root x)) - (list-ref tab pers))))) + (vtab-flection tab pers))))) +(define (conjugate-v root pers . forms) + (conjugate root pers forms)) + +;; Test -(do ((i 1 (1+ i))) - ((> i 6) #f) - (map - (lambda (x) - (display (xlat->greek x))(display ",")) - (conjugate (greek->xlat "βεβαίων") - i "Α" "ενεργητηκή" "οριστική" "ενεστώτας")) - (newline)) -(newline) +(define (conj-all root . rest) + (map (lambda (x) + (display x)(display "/")) + rest) + (newline) + (do ((i 1 (1+ i))) + ((> i 6) #f) + (map + (lambda (x) + (display (xlat->greek x))(display ",")) + (conjugate (greek->xlat root) i rest)) + (newline))) + -(do ((i 1 (1+ i))) - ((> i 6) #f) - (map - (lambda (x) - (display (xlat->greek x))(display ",")) - (conjugate (greek->xlat "βεβαίων") - i "Α" "ενεργητηκή" "οριστική" "παρατατικός")) - (newline)) -(newline) +;(conj-all "βεβαίων" "Α" "ενεργητηκή" "οριστική" "ενεστώτας") +;(newline) -(do ((i 1 (1+ i))) - ((> i 6) #f) - (map - (lambda (x) - (display (xlat->greek x))(display ",")) - (conjugate (greek->xlat "λύν") - i "Α" "ενεργητηκή" "οριστική" "παρατατικός")) - (newline)) +;(conj-all "βεβαίων" "Α" "ενεργητηκή" "οριστική" "παρατατικός") +;(newline) +;(conj-all "ντυν" "Α" "ενεργητηκή" "προστακτική" "ενεστώτας") +;(newline) +;(conj-all "βεβαίων" "Α" "ενεργητηκή" "προστακτική" "ενεστώτας") +;(newline) +;(conj-all "διαβάζ" "Α" "ενεργητηκή" "προστακτική" "ενεστώτας") +;(newline) +;(conj-all "λύν" "Α" "ενεργητηκή" "οριστική" "παρατατικός") +;(newline) +;(conj-all "νικ" "Β1" "ενεργητηκή" "οριστική" "ενεστώτας") +;(newline) +;(conj-all "νικ" "Β1" "ενεργητηκή" "οριστική" "παρατατικός") +;(newline) +;(conj-all "νικ" "Β1" "ενεργητηκή" "προστακτική" "ενεστώτας") +;(newline) + +;(conj-all "θεωρ" "Β2" "ενεργητηκή" "οριστική" "ενεστώτας") +;(newline) - - +;(conj-all "θεωρ" "Β2" "ενεργητηκή" "οριστική" "παρατατικός") +;(newline) + +;(display (xlat->greek (cons #f (active-aorist-root (cdr (greek->xlat "ιατρευ")))))) +;(newline) diff --git a/scm/xlat.scm b/scm/xlat.scm index 7548e54..37028b3 100644 --- a/scm/xlat.scm +++ b/scm/xlat.scm @@ -101,7 +101,7 @@ (cons "Ϋ" #\Y ) (cons "ΰ" (cons #\Y #t)))) -(define (greek->xlat0 str) +(define-public (greek->xlat0 str) "Convert the greek STRing into its latin transliteration. Returns (list AP XLAT) @@ -116,9 +116,8 @@ Secondary accents are ignored" (lcnt 0 (1+ lcnt)) (sl '())) ((= i len) (cons - (if accent-pos - (- (length sl) accent-pos 1) - 0) + (and accent-pos + (- (length sl) accent-pos 1)) (reverse sl))) (letrec ((get-trans (lambda (x) (let ((y (cdr x))) @@ -225,7 +224,7 @@ Secondary accents are ignored" (set! wl (cdr wl)) (set! syl (cons a syl)) (cond - ((= ap (length wl)) + ((and ap (= ap (length wl))) (set! accented (length sl))) (else (case a @@ -235,7 +234,7 @@ Secondary accents are ignored" (or (char=? (car wl) #\i) (char=? (car wl) #\y))) (set! syl (cons (car wl) syl)) (set! wl (cdr wl)) - (if (= ap (length wl)) + (if (and ap (= ap (length wl))) (set! accented (length sl)))))) ((#\i) (if (not (null? wl)) @@ -244,19 +243,19 @@ Secondary accents are ignored" (char=? (car wl) #\a)) (set! syl (cons (car wl) syl)) (set! wl (cdr wl)) - (if (= ap (length wl)) + (if (and ap (= ap (length wl))) (set! accented (length sl)))) ((char=? (car wl) #\o) ;; "ιο" ή "ιου" (set! syl (cons (car wl) syl)) (set! wl (cdr wl)) (cond - ((= ap (length wl)) + ((and ap (= ap (length wl))) (set! accented (length sl))) ((and (not (null? wl)) (char=? (car wl) #\y)) (set! syl (cons (car wl) syl)) (set! wl (cdr wl)) - (if (= ap (length wl)) + (if (and ap (= ap (length wl))) (set! accented (length sl))))))))) ((#\y) (cond @@ -264,7 +263,7 @@ Secondary accents are ignored" (char=? (car wl) #\i)) (set! syl (cons (car wl) syl)) (set! wl (cdr wl)) - (if (= ap (length wl)) + (if (and ap (= ap (length wl))) (set! accented (length sl)))))) ((#\Y #\I) (set! accented (length sl)))))) @@ -273,9 +272,9 @@ Secondary accents are ignored" (define-public (greek->xlat str) (let* ((wl (greek->xlat0 str)) - (sl (prosodia (car wl) (cdr wl) 0 '()))) + (sl (prosodia (car wl) (cdr wl) #f '()))) (cons - (- (length (cdr sl)) (car sl)) + (and (car sl) (- (length (cdr sl)) (car sl))) (cdr sl)))) ;;;; End of file
\ No newline at end of file diff --git a/src/trans.h b/src/trans.h index 7c38227..1244cab 100644 --- a/src/trans.h +++ b/src/trans.h @@ -53,8 +53,9 @@ extern RAD_LIST *node_list; extern struct node *create_node(RAD_LIST *hdr, RAD_LIST *descr); - -void open_input(char *name); +void make_m4_args (char *m4_bin, RAD_LIST *include_list); +void open_input(int argc, char **argv); +int parse(int argc, char **argv); int sql_query(char *fmt, ...); int sql_query_n(unsigned long *pret, char *fmt, ...); |