aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-15 10:05:10 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-15 10:24:46 +0300
commitbb9dd8a54a96307aad7bf976f1736d20c70d43e3 (patch)
treedf632e2c76facc932c4c34978eba4b9ae4cb0354
parenta27881a1c5bd7d8f8f42cd6526adf80815acfe63 (diff)
downloadellinika-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.
-rw-r--r--src/cgi-bin/.gitignore2
-rw-r--r--src/cgi-bin/Makefile.am5
-rw-r--r--src/cgi-bin/conj.scm4235
-rw-r--r--src/cgi-bin/dict.scm416
-rw-r--r--src/ellinika/Makefile.am3
-rw-r--r--src/ellinika/cgi.scm415
-rw-r--r--src/ellinika/conjugator.scm36
-rw-r--r--src/ellinika/sql.scm2
-rw-r--r--src/ellinika/tenses.scm13
-rw-r--r--src/ellinika/test-conjugation.scm14
-rw-r--r--xml/lingua.conf.in10
-rw-r--r--xml/pl/ellinika.xml3
-rw-r--r--xml/pl/rhmata.xml6
13 files changed, 309 insertions, 51 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
@@ -6,2 +6,2 @@ 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
@@ -18,4 +18,4 @@ 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
@@ -52,2 +52,3 @@ dict.scm: dict.scm4 dict.m4
nea.scm: nea.scm4 dict.m4
+conj.scm: conj.scm4 dict.m4
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 "&amp;")
+ (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
@@ -54,16 +54,2 @@ ifelse(IFACE,[CGI],(cgi:init))
-;; Protect occurences of " in a string.
-;; Usual backslash escapes do not work in INPUT widgets, so I
-;; change all quotation marks to &#34;
-;; 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)
@@ -132,3 +118,3 @@ ifelse(IFACE,[CGI],(cgi:init))
(display " value=\"")
- (display (protect value))
+ (display (cgi-protect-quotes value))
(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
@@ -25,3 +25,4 @@ guile_DATA=\
tenses.scm\
- sql.scm
+ sql.scm\
+ conjugator.scm
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
@@ -167,2 +167,17 @@ THUNK.
+;; Protect occurences of " in a string.
+;; Usual backslash escapes do not work in INPUT widgets, so I
+;; change all quotation marks to &#34;
+;; 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
@@ -79,19 +79,19 @@
; (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 '() '())))))
@@ -183,3 +183,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
(define (complement-verb-info vinfo verb voice thema)
-; (format #t "COMPLEMENT ~A~%" thema)
+; (format #t "COMPLEMENT ~A~%" vinfo)
(let ((elverb (string->elstr verb))
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
@@ -44,3 +44,3 @@
((string? arg) arg)
- ((elstr? arg) (elstr->string? arg))
+ ((elstr? arg) (elstr->string arg))
((number? arg) (number->string 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
@@ -37,2 +37,13 @@
"Παρακείμενος"))))
- \ 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
@@ -29,12 +29,2 @@
-(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)
@@ -42,3 +32,5 @@
(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)))
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
@@ -45,2 +45,12 @@
+(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
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
@@ -35,3 +35,3 @@
<FOOTER VCS-ID="$Id$">
-Copyright <![CDATA[&copy;]]> 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff
+Copyright <![CDATA[&copy;]]> 2004-2011 Sergey Poznyakoff
</FOOTER>
@@ -41,2 +41,3 @@ Copyright <![CDATA[&copy;]]> 2004, 2005, 2006, 2007, 2010 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
@@ -2494,2 +2494,8 @@ równy drugiej osobie czasu przeszłego dokonanego trybu łączącego:
+<PAGE PREFIX="conj" HEADER="Koniugator" REF="CONJ">
+
+@@conj@@
+
+</PAGE>
+
</CHAPTER>

Return to:

Send suggestions and report system problems to the System administrator.