From bb9dd8a54a96307aad7bf976f1736d20c70d43e3 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Wed, 15 Jun 2011 10:05:10 +0300 Subject: Implement web conjugator. * src/cgi-bin/.gitignore: Update. * src/cgi-bin/Makefile.am: Build conj,cgi * src/cgi-bin/conj.scm4: New file. * src/cgi-bin/dict.scm4 (protect): Move to cgi.scm, function cgi-protect-quotes. All uses updated. * src/ellinika/cgi.scm4 (cgi-protect-quotes): New function. * src/ellinika/Makefile.am (guile_DATA): Add conjugator.scm * src/ellinika/conjugator.scm: Minor fixes. * src/ellinika/sql.scm (->string): Fix typo. * src/ellinika/tenses.scm (ellinika-conjugation-term-transtab): New var. (ellinika-conjugation-term): New function. * src/ellinika/test-conjugation.scm: Use ellinika-conjugation-term instead of (term). * xml/lingua.conf.in (install-conj): New macro. * xml/pl/ellinika.xml (GUILE): Call install-conj. * xml/pl/rhmata.xml: Define conjugator template page. --- src/cgi-bin/.gitignore | 2 +- src/cgi-bin/Makefile.am | 5 +- src/cgi-bin/conj.scm4 | 235 ++++++++++++++++++++++++++++++++++++++ src/cgi-bin/dict.scm4 | 16 +-- src/ellinika/Makefile.am | 3 +- src/ellinika/cgi.scm4 | 15 +++ src/ellinika/conjugator.scm | 36 +++--- src/ellinika/sql.scm | 2 +- src/ellinika/tenses.scm | 13 ++- src/ellinika/test-conjugation.scm | 14 +-- xml/lingua.conf.in | 10 ++ xml/pl/ellinika.xml | 3 +- xml/pl/rhmata.xml | 6 + 13 files changed, 309 insertions(+), 51 deletions(-) create mode 100644 src/cgi-bin/conj.scm4 diff --git a/src/cgi-bin/.gitignore b/src/cgi-bin/.gitignore index 1ae9efa..a2d76a3 100644 --- a/src/cgi-bin/.gitignore +++ b/src/cgi-bin/.gitignore @@ -4,4 +4,4 @@ dict.scm dict.sed nea.cgi nea.scm - +conj.scm diff --git a/src/cgi-bin/Makefile.am b/src/cgi-bin/Makefile.am index bb90eed..16fc3d2 100644 --- a/src/cgi-bin/Makefile.am +++ b/src/cgi-bin/Makefile.am @@ -16,8 +16,8 @@ cgidir=@CGIDIR@ cgi_SCRIPTS=$(EXTRA_DIST:.scm4=.@SCRIPT_SUFFIX@) -EXTRA_DIST=dict.scm4 nea.scm4 -CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi +EXTRA_DIST=dict.scm4 nea.scm4 conj.scm4 +CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi conj.cgi dict.m4: Makefile echo 'divert(-1)' > $@ @@ -50,6 +50,7 @@ SUFFIXES = .scm4 .scm .cgi dict.scm: dict.scm4 dict.m4 nea.scm: nea.scm4 dict.m4 +conj.scm: conj.scm4 dict.m4 dict.cgi: dict.scm nea.cgi: nea.scm diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4 new file mode 100644 index 0000000..b48b225 --- /dev/null +++ b/src/cgi-bin/conj.scm4 @@ -0,0 +1,235 @@ +;;;; Greek Dictionary Web Engine +;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see . +;;;; + +;;; Tailor this statement to your needs if necessary. +(set! %load-path (cons "GUILE_SITE" %load-path)) + +(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user)) + (srfi srfi-1) + (ice-9 rdelim) + (xmltools dict) + (ellinika elmorph) + (ellinika tenses) + (ellinika conjugator) + (ellinika sql) + (ellinika i18n) + (ellinika xlat) + (ellinika cgi)) + +ifelse(IFACE,[CGI],(cgi:init)) + +(define conj-template-file-name "conj_08.html") + +(ellinika-cgi-init conj-template-file-name) + +(define (sql-error-handler key func fmt fmtargs data) + (format #t "

~A

\n" + (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")) + (apply format (current-error-port) fmt fmtargs)) + +;;; +(define (dict-connect) + (if (not ellinika:sql-conn) + (ellinika:sql-connect ellinika-sql-connection))) + + +(define (main-form) + (format #t "
" + (make-cgi-name cgi-script-name)) + (display "\ + + + + + + +
") + (display (_"Εισάγετε τον ρήμα")) + (display " + + + + +
+
+")) + +(define tense-driver-list + '(("ind" 3 5) + ("sub" 3) + ("imp" 3))) + +(define (show-conjugation:tense verb voice mood tense) + + #t) + +(define (table-header count tense-names) + (display "\ + + + ") + (for-each + (lambda (tense) + (format #t "~%" tense)) + tense-names) + (display "")) + +(define (table-footer) + (display "
~A
")) + +(define (transpose mtx) + (let* ((w (length (car mtx))) + (res (make-list w))) + (do ((i 0 (1+ i))) + ((= i w)) + (list-set! res i (map + (lambda (row) + (list-ref row i)) + mtx))) + res)) + +(define (compact-conj-list conj) + (map + (lambda (x) + (fold-right + (lambda (elt prev) + (if (member elt prev) + prev + (cons elt prev))) + '() + x)) + conj)) + +(define (concat-unique lst) + (fold + (lambda (elt prev) + (if prev + (string-append prev "," elt) + elt)) + #f + lst)) + + +(define (format-tenses count tense-names voice mood verb) + (let ((prosopa (if (string=? mood "imp") + '(2 5) + '(1 2 3 4 5 6)))) + (for-each + (lambda (row pers class) + (cond + ((member pers prosopa) + (format #t "" class) + (for-each + (lambda (x) + (let ((val (concat-unique x))) + (format #t "~A" (if val val "--")))) + row) + (display "")))) + (transpose + (map + (lambda (tense) + (let ((conj (conjugator verb voice mood tense))) + (compact-conj-list (transpose (map conjugation:table conj))))) + tense-names)) + '(1 2 3 4 5 6) + '("odd" "even" "odd" "even" "odd" "even")))) + +(define (show-conjugation:mood voice mood tense-list verb) + (format #t "

~A

" + (ellinika-conjugation-term mood)) + (for-each + (lambda (count) + (let ((tenses (list-head tense-list count))) + (table-header count tenses) + (format-tenses count tenses voice mood verb) + (table-footer) + (set! tense-list (list-tail tense-list count)) + (if (not (null? tense-list)) + (display "

")))) + (assoc-ref tense-driver-list mood)) + (display "
")) + +(define (show-conjugation:voice voice verb) + (format #t "

~A

" + (ellinika-conjugation-term voice)) + (for-each + (lambda (mood-tenses) + (show-conjugation:mood voice (car mood-tenses) (cdr mood-tenses) verb)) + ellinika-tense-list) + + (display "
")) + +(define (show-conjugation verb) + (show-conjugation:voice "act" verb) + (show-conjugation:voice "pas" verb)) + +(define (do-conj) + (let ((keyval (cgi:value "key"))) + (if keyval + (show-conjugation keyval)))) + +(define (conj-html) + (sql-catch-failure + (let ((explist (list + (cons "@@args@@" + (lambda () + (for-each + (lambda (name) + (cond + ((string=? name "LANG")) + (else + (let ((v (cgi:value name))) + (cond ((and v (not (string-null? v))) + (display "&") + (display name) + (display "=") + (display v))))))) + (cgi:names)))) + (cons "@@conj@@" + (lambda () + (dict-connect) + (main-form) + (do-conj)))))) + + (do ((line (read-line) (read-line))) + ((eof-object? line) #f) + (expand-template explist line) + (newline)) + (ellinika:sql-disconnect)))) + +;;; Main +ifelse(IFACE,[CGI],(display ["Content-type: text/html; charset=utf-8\r\n\r\n"])) + +(with-input-from-file + (template-file target-language conj-template-file-name) + conj-html) + + +;;;; Local variables: +;;;; mode: Scheme +;;;; buffer-file-coding-system: utf-8 +;;;; End: + diff --git a/src/cgi-bin/dict.scm4 b/src/cgi-bin/dict.scm4 index 1440454..c3429e9 100644 --- a/src/cgi-bin/dict.scm4 +++ b/src/cgi-bin/dict.scm4 @@ -52,20 +52,6 @@ ifelse(IFACE,[CGI],(cgi:init)) (cons (car x) (cadr x))) plist)))))) -;; Protect occurences of " in a string. -;; Usual backslash escapes do not work in INPUT widgets, so I -;; change all quotation marks to " -;; Possibly not the better solution, though... -(define (protect string) - (list->string - (apply append - (map - (lambda (x) - (if (eq? x #\") - (list #\& #\# #\3 #\4 #\;) - (list x))) - (string->list string))))) - (define (get-topic-list) (let ((categories #f)) (letrec ((getcat @@ -130,7 +116,7 @@ ifelse(IFACE,[CGI],(cgi:init)) (if value (begin (display " value=\"") - (display (protect value)) + (display (cgi-protect-quotes value)) (display "\"")))) (display " /> diff --git a/src/ellinika/Makefile.am b/src/ellinika/Makefile.am index 581a537..01534c0 100644 --- a/src/ellinika/Makefile.am +++ b/src/ellinika/Makefile.am @@ -23,7 +23,8 @@ guile_DATA=\ dico.scm\ elmorph.scm\ tenses.scm\ - sql.scm + sql.scm\ + conjugator.scm cgi.m4: Makefile echo 'divert(-1)' > $@ diff --git a/src/ellinika/cgi.scm4 b/src/ellinika/cgi.scm4 index c7fbdb6..8cbfeca 100644 --- a/src/ellinika/cgi.scm4 +++ b/src/ellinika/cgi.scm4 @@ -165,4 +165,19 @@ THUNK. (if x (set! target-language x)))) +;; Protect occurences of " in a string. +;; Usual backslash escapes do not work in INPUT widgets, so I +;; change all quotation marks to " +;; Possibly not the better solution, though... +(define-public (cgi-protect-quotes string) + (list->string + (apply append + (map + (lambda (x) + (if (eq? x #\") + (list #\& #\# #\3 #\4 #\;) + (list x))) + (string->list string))))) + + ;;; End of cgi.scmi diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index 0079d12..41575c2 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm @@ -77,23 +77,23 @@ (define (create-basic-verb-info verb proplist . rest) ; (format #t "PROPLIST ~A~%" proplist) - (let ((class (if (null? rest) - "" - (string-append - " AND conj=\"" (utf8-escape (car rest)) "\"")))) - (let ((vdb (ellinika:sql-query - "SELECT conj FROM verbclass WHERE verb=\"~A\"~A" - verb class))) - (cond - ((and vdb (not (null? vdb))) - (list (caar vdb) verb proplist '(class))) - ((elstr-suffix? verb "άω") - (create-basic-verb-info (elstr-append - (elstr-trim verb -2) "ώ") "B1")) - ((null? rest) - (list (guess-verb-class verb) verb proplist '())) - (else - (list (car rest) verb '() '())))))) + (let ((vdb (if (null? rest) + (ellinika:sql-query + "SELECT conj FROM verbclass WHERE verb=\"~A\"" + verb) + (ellinika:sql-query + "SELECT conj FROM verbclass WHERE verb=\"~A\" AND conj=~Q" + verb (car rest))))) + (cond + ((and vdb (not (null? vdb))) + (list (caar vdb) verb proplist '(class))) + ((elstr-suffix? verb "άω") + (create-basic-verb-info (elstr-append + (elstr-trim verb -2) "ώ") proplist "B1")) + ((null? rest) + (list (guess-verb-class verb) verb proplist '())) + (else + (list (car rest) verb '() '()))))) (define (load-verb-info verb voice mood tense) ; (format #t "LOAD ~A~%" verb) @@ -181,7 +181,7 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" (error "cannot handle ~A~%" verb)))) (define (complement-verb-info vinfo verb voice thema) -; (format #t "COMPLEMENT ~A~%" thema) +; (format #t "COMPLEMENT ~A~%" vinfo) (let ((elverb (string->elstr verb)) (result (let ((tmpres (lookup-verb-info verb voice thema))) (if (and (null? tmpres) (string=? thema "sub")) diff --git a/src/ellinika/sql.scm b/src/ellinika/sql.scm index f49ddf1..5867d28 100644 --- a/src/ellinika/sql.scm +++ b/src/ellinika/sql.scm @@ -42,7 +42,7 @@ (define (->string arg) (cond ((string? arg) arg) - ((elstr? arg) (elstr->string? arg)) + ((elstr? arg) (elstr->string arg)) ((number? arg) (number->string arg)) ((bool? arg) (if arg "true" "false")) (else diff --git a/src/ellinika/tenses.scm b/src/ellinika/tenses.scm index f830870..137cfff 100644 --- a/src/ellinika/tenses.scm +++ b/src/ellinika/tenses.scm @@ -35,4 +35,15 @@ (list "Ενεστώτας" "Αόριστος" "Παρακείμενος")))) - \ No newline at end of file + +(define-public ellinika-conjugation-term-transtab + '(("act" . "Ενεργητηκή φωνή") + ("pas" . "Μεσοπαθητική φωνή") + ("ind" . "Οριστική") + ("sub" . "Υποτακτική") + ("imp" . "Προστακτική"))) + +(define-public (ellinika-conjugation-term x) + (or (assoc-ref ellinika-conjugation-term-transtab x) x)) + + diff --git a/src/ellinika/test-conjugation.scm b/src/ellinika/test-conjugation.scm index 055138b..1504553 100644 --- a/src/ellinika/test-conjugation.scm +++ b/src/ellinika/test-conjugation.scm @@ -27,20 +27,12 @@ (ellinika-cgi-init dict-template-file-name) (ellinika:sql-connect ellinika-sql-connection) -(define transtab - '(("act" . "Ενεργητηκή φωνή") - ("pas" . "Μεσοπαθητική φωνή") - ("ind" . "Οριστική") - ("sub" . "Υποτακτική") - ("imp" . "Προστακτική"))) - -(define (term x) - (or (assoc-ref transtab x) x)) - (define-public (test-conjugation:tense verb voice mood tense) (for-each (lambda (result) - (format #t "~A ~A/~A/~A: " verb (term voice) (term mood) tense) + (format #t "~A ~A/~A/~A: " verb + (ellinika-conjugation-term voice) + (ellinika-conjugation-term mood) tense) (let ((conj (conjugation:table result))) (cond ((empty-conjugation? conj) diff --git a/xml/lingua.conf.in b/xml/lingua.conf.in index 22570b8..3b86202 100644 --- a/xml/lingua.conf.in +++ b/xml/lingua.conf.in @@ -43,6 +43,16 @@ (lingua:LANG args))))) (xmltrans:set-attr "LINGUA" "NEA" nea))) +(define-macro (install-conj) + `(use-modules (xmltrans lingua) + (xmltools dict)) + (letrec ((conj (lambda (. args) + (string-append + (lingua:get-cgi-bin) + "/conj.=SCRIPT_SUFFIX=?LANG=" + (lingua:LANG args))))) + (xmltrans:set-attr "LINGUA" "CONJ" conj))) + (xmltrans:end-tag "FOOTER" (tag attr text) diff --git a/xml/pl/ellinika.xml b/xml/pl/ellinika.xml index 8dcd1f3..f2d7f15 100644 --- a/xml/pl/ellinika.xml +++ b/xml/pl/ellinika.xml @@ -33,12 +33,13 @@
-Copyright 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff +Copyright 2004-2011 Sergey Poznyakoff
(install-nea) + (install-conj) #f diff --git a/xml/pl/rhmata.xml b/xml/pl/rhmata.xml index 10b9978..42d5caa 100644 --- a/xml/pl/rhmata.xml +++ b/xml/pl/rhmata.xml @@ -2492,6 +2492,12 @@ równy drugiej osobie czasu przeszłego dokonanego trybu łączącego: + + +@@conj@@ + + + -- cgit v1.2.1