diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-15 10:05:10 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-15 10:24:46 +0300 |
commit | bb9dd8a54a96307aad7bf976f1736d20c70d43e3 (patch) | |
tree | df632e2c76facc932c4c34978eba4b9ae4cb0354 /src | |
parent | a27881a1c5bd7d8f8f42cd6526adf80815acfe63 (diff) | |
download | ellinika-bb9dd8a54a96307aad7bf976f1736d20c70d43e3.tar.gz ellinika-bb9dd8a54a96307aad7bf976f1736d20c70d43e3.tar.bz2 |
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/cgi-bin/.gitignore | 2 | ||||
-rw-r--r-- | src/cgi-bin/Makefile.am | 5 | ||||
-rw-r--r-- | src/cgi-bin/conj.scm4 | 235 | ||||
-rw-r--r-- | src/cgi-bin/dict.scm4 | 16 | ||||
-rw-r--r-- | src/ellinika/Makefile.am | 3 | ||||
-rw-r--r-- | src/ellinika/cgi.scm4 | 15 | ||||
-rw-r--r-- | src/ellinika/conjugator.scm | 36 | ||||
-rw-r--r-- | src/ellinika/sql.scm | 2 | ||||
-rw-r--r-- | src/ellinika/tenses.scm | 13 | ||||
-rw-r--r-- | src/ellinika/test-conjugation.scm | 14 |
10 files changed, 291 insertions, 50 deletions
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 @@ -1,7 +1,7 @@ dict.cgi dict.m4 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 @@ -13,14 +13,14 @@ # # You should have received a copy of the GNU General Public License # along with this program. If not, see <http://www.gnu.org/licenses/>. 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)' > $@ echo 'changequote([,])' >> $@ echo 'changecom([;],[' >> $@ echo '])' >> $@ @@ -47,10 +47,11 @@ SUFFIXES = .scm4 .scm .cgi .scm.cgi: cp $< $@ 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 <http://www.gnu.org/licenses/>. +;;;; + +;;; 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 "<h1 class=\"error\">~A</h1>\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 "<form action=\"~A\" method=\"post\">" + (make-cgi-name cgi-script-name)) + (display "\ +<table class=\"noframe\"> +<tr> + <td>") + (display (_"Εισάγετε τον ρήμα")) + (display " + </td> + <td> + <input size=\"36\" name=\"key\" tabindex=\"1\"") + (let ((value (cgi:value "key"))) + (if value + (begin + (display " value=\"") + (display (cgi-protect-quotes value)) + (display "\"")))) + (display " /> + </td> + <td> + <input type=\"submit\" name=\"conjugate\" value=\"") + (display (_"Κλίση")) + (display "\" tabindex=\"2\" /> + </td> +</tr> +</table> +</form> +")) + +(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 "\ + <table class=\"frame align-center\"> + <thead class=\"std\"> + <tr>") + (for-each + (lambda (tense) + (format #t "<th>~A</th>~%" tense)) + tense-names) + (display "</tr></thead>")) + +(define (table-footer) + (display "</table>")) + +(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 "<tr class=\"~A\">" class) + (for-each + (lambda (x) + (let ((val (concat-unique x))) + (format #t "<td>~A</td>" (if val val "--")))) + row) + (display "</tr>")))) + (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 "<div class=\"subsection\"><h3>~A</h3>" + (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 "<br/><br/>")))) + (assoc-ref tense-driver-list mood)) + (display "</div>")) + +(define (show-conjugation:voice voice verb) + (format #t "<div class=\"section\"><h2>~A</h2>" + (ellinika-conjugation-term voice)) + (for-each + (lambda (mood-tenses) + (show-conjugation:mood voice (car mood-tenses) (cdr mood-tenses) verb)) + ellinika-tense-list) + + (display "</div>")) + +(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 @@ -49,26 +49,12 @@ ifelse(IFACE,[CGI],(cgi:init)) (cons "κανένα μέρος του λόγου" #f) (map (lambda (x) (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 (lambda () (sql-ignore-failure (let ((ctg (ellinika:sql-query @@ -127,13 +113,13 @@ ifelse(IFACE,[CGI],(cgi:init)) <td> <input size=\"36\" name=\"key\" tabindex=\"1\"") (let ((value (cgi:value "key"))) (if value (begin (display " value=\"") - (display (protect value)) + (display (cgi-protect-quotes value)) (display "\"")))) (display " /> </td> </tr>") (display "<tr><td colspan=\"3\" align=\"center\">") 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 @@ -20,13 +20,14 @@ guile_DATA=\ cgi.scm\ i18n.scm\ config.scm\ dico.scm\ elmorph.scm\ tenses.scm\ - sql.scm + sql.scm\ + conjugator.scm cgi.m4: Makefile echo 'divert(-1)' > $@ echo 'changequote([,])' >> $@ echo 'changecom([;],[' >> $@ echo '])' >> $@ 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 @@ -162,7 +162,22 @@ THUNK. (set! target-language x))))) ;;; Initialize i18n (let ((x (locale-setup target-language "PACKAGE" locale-path))) (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 @@ -74,29 +74,29 @@ ((elstr-suffix? verb "ώ") "B2") ;; FIXME: deponentia? (else "A"))) (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) (let ((verbprop (ellinika:sql-query "SELECT property,value FROM verbtense WHERE \ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" @@ -178,13 +178,13 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" ((elstr-suffix? verb "ομαι") (elstr-trim verb -4)) (else (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")) (lookup-verb-info verb voice "aor") tmpres)))) (verb-set! vinfo #:root 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 @@ -39,13 +39,13 @@ (if ellinika:sql-conn (sql-close-connection ellinika:sql-conn))) (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 (error "Unhandled argument type: ~S" arg)))) 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 @@ -32,7 +32,18 @@ "Αόριστος" "Παρακείμενος")) (cons "imp" (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 @@ -24,26 +24,18 @@ (ellinika conjugator) (ellinika sql)) (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) (display "#f")) (else (let ((att (conjugation:attested result))) |