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
@@ -4,4 +4,4 @@ dict.scm
4dict.sed 4dict.sed
5nea.cgi 5nea.cgi
6nea.scm 6nea.scm
7 7conj.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 @@
16 16
17cgidir=@CGIDIR@ 17cgidir=@CGIDIR@
18cgi_SCRIPTS=$(EXTRA_DIST:.scm4=.@SCRIPT_SUFFIX@) 18cgi_SCRIPTS=$(EXTRA_DIST:.scm4=.@SCRIPT_SUFFIX@)
19EXTRA_DIST=dict.scm4 nea.scm4 19EXTRA_DIST=dict.scm4 nea.scm4 conj.scm4
20CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi 20CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi conj.cgi
21 21
22dict.m4: Makefile 22dict.m4: Makefile
23 echo 'divert(-1)' > $@ 23 echo 'divert(-1)' > $@
@@ -50,6 +50,7 @@ SUFFIXES = .scm4 .scm .cgi
50 50
51dict.scm: dict.scm4 dict.m4 51dict.scm: dict.scm4 dict.m4
52nea.scm: nea.scm4 dict.m4 52nea.scm: nea.scm4 dict.m4
53conj.scm: conj.scm4 dict.m4
53 54
54dict.cgi: dict.scm 55dict.cgi: dict.scm
55nea.cgi: nea.scm 56nea.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 @@
1;;;; Greek Dictionary Web Engine
2;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 Sergey Poznyakoff
3;;;;
4;;;; This program is free software; you can redistribute it and/or modify
5;;;; it under the terms of the GNU General Public License as published by
6;;;; the Free Software Foundation; either version 3 of the License, or
7;;;; (at your option) any later version.
8;;;;
9;;;; This program is distributed in the hope that it will be useful,
10;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12;;;; GNU General Public License for more details.
13;;;;
14;;;; You should have received a copy of the GNU General Public License
15;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16;;;;
17
18;;; Tailor this statement to your needs if necessary.
19(set! %load-path (cons "GUILE_SITE" %load-path))
20
21(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
22 (srfi srfi-1)
23 (ice-9 rdelim)
24 (xmltools dict)
25 (ellinika elmorph)
26 (ellinika tenses)
27 (ellinika conjugator)
28 (ellinika sql)
29 (ellinika i18n)
30 (ellinika xlat)
31 (ellinika cgi))
32
33ifelse(IFACE,[CGI],(cgi:init))
34
35(define conj-template-file-name "conj_08.html")
36
37(ellinika-cgi-init conj-template-file-name)
38
39(define (sql-error-handler key func fmt fmtargs data)
40 (format #t "<h1 class=\"error\">~A</h1>\n"
41 (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
42 (apply format (current-error-port) fmt fmtargs))
43
44;;;
45(define (dict-connect)
46 (if (not ellinika:sql-conn)
47 (ellinika:sql-connect ellinika-sql-connection)))
48
49
50(define (main-form)
51 (format #t "<form action=\"~A\" method=\"post\">"
52 (make-cgi-name cgi-script-name))
53 (display "\
54<table class=\"noframe\">
55<tr>
56 <td>")
57 (display (_"Εισάγετε τον ρήμα"))
58 (display "
59 </td>
60 <td>
61 <input size=\"36\" name=\"key\" tabindex=\"1\"")
62 (let ((value (cgi:value "key")))
63 (if value
64 (begin
65 (display " value=\"")
66 (display (cgi-protect-quotes value))
67 (display "\""))))
68 (display " />
69 </td>
70 <td>
71 <input type=\"submit\" name=\"conjugate\" value=\"")
72 (display (_"Κλίση"))
73 (display "\" tabindex=\"2\" />
74 </td>
75</tr>
76</table>
77</form>
78"))
79
80(define tense-driver-list
81 '(("ind" 3 5)
82 ("sub" 3)
83 ("imp" 3)))
84
85(define (show-conjugation:tense verb voice mood tense)
86
87 #t)
88
89(define (table-header count tense-names)
90 (display "\
91 <table class=\"frame align-center\">
92 <thead class=\"std\">
93 <tr>")
94 (for-each
95 (lambda (tense)
96 (format #t "<th>~A</th>~%" tense))
97 tense-names)
98 (display "</tr></thead>"))
99
100(define (table-footer)
101 (display "</table>"))
102
103(define (transpose mtx)
104 (let* ((w (length (car mtx)))
105 (res (make-list w)))
106 (do ((i 0 (1+ i)))
107 ((= i w))
108 (list-set! res i (map
109 (lambda (row)
110 (list-ref row i))
111 mtx)))
112 res))
113
114(define (compact-conj-list conj)
115 (map
116 (lambda (x)
117 (fold-right
118 (lambda (elt prev)
119 (if (member elt prev)
120 prev
121 (cons elt prev)))
122 '()
123 x))
124 conj))
125
126(define (concat-unique lst)
127 (fold
128 (lambda (elt prev)
129 (if prev
130 (string-append prev "," elt)
131 elt))
132 #f
133 lst))
134
135
136(define (format-tenses count tense-names voice mood verb)
137 (let ((prosopa (if (string=? mood "imp")
138 '(2 5)
139 '(1 2 3 4 5 6))))
140 (for-each
141 (lambda (row pers class)
142 (cond
143 ((member pers prosopa)
144 (format #t "<tr class=\"~A\">" class)
145 (for-each
146 (lambda (x)
147 (let ((val (concat-unique x)))
148 (format #t "<td>~A</td>" (if val val "--"))))
149 row)
150 (display "</tr>"))))
151 (transpose
152 (map
153 (lambda (tense)
154 (let ((conj (conjugator verb voice mood tense)))
155 (compact-conj-list (transpose (map conjugation:table conj)))))
156 tense-names))
157 '(1 2 3 4 5 6)
158 '("odd" "even" "odd" "even" "odd" "even"))))
159
160(define (show-conjugation:mood voice mood tense-list verb)
161 (format #t "<div class=\"subsection\"><h3>~A</h3>"
162 (ellinika-conjugation-term mood))
163 (for-each
164 (lambda (count)
165 (let ((tenses (list-head tense-list count)))
166 (table-header count tenses)
167 (format-tenses count tenses voice mood verb)
168 (table-footer)
169 (set! tense-list (list-tail tense-list count))
170 (if (not (null? tense-list))
171 (display "<br/><br/>"))))
172 (assoc-ref tense-driver-list mood))
173 (display "</div>"))
174
175(define (show-conjugation:voice voice verb)
176 (format #t "<div class=\"section\"><h2>~A</h2>"
177 (ellinika-conjugation-term voice))
178 (for-each
179 (lambda (mood-tenses)
180