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 | |
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.
-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 | ||||
-rw-r--r-- | xml/lingua.conf.in | 10 | ||||
-rw-r--r-- | xml/pl/ellinika.xml | 3 | ||||
-rw-r--r-- | xml/pl/rhmata.xml | 6 |
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 | |||
4 | dict.sed | 4 | dict.sed |
5 | nea.cgi | 5 | nea.cgi |
6 | nea.scm | 6 | nea.scm |
7 | 7 | 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 @@ | |||
16 | 16 | ||
17 | cgidir=@CGIDIR@ | 17 | cgidir=@CGIDIR@ |
18 | cgi_SCRIPTS=$(EXTRA_DIST:.scm4=.@SCRIPT_SUFFIX@) | 18 | cgi_SCRIPTS=$(EXTRA_DIST:.scm4=.@SCRIPT_SUFFIX@) |
19 | EXTRA_DIST=dict.scm4 nea.scm4 | 19 | EXTRA_DIST=dict.scm4 nea.scm4 conj.scm4 |
20 | CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi | 20 | CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi conj.cgi |
21 | 21 | ||
22 | dict.m4: Makefile | 22 | dict.m4: Makefile |
23 | echo 'divert(-1)' > $@ | 23 | echo 'divert(-1)' > $@ |
@@ -50,6 +50,7 @@ SUFFIXES = .scm4 .scm .cgi | |||
50 | 50 | ||
51 | dict.scm: dict.scm4 dict.m4 | 51 | dict.scm: dict.scm4 dict.m4 |
52 | nea.scm: nea.scm4 dict.m4 | 52 | nea.scm: nea.scm4 dict.m4 |
53 | conj.scm: conj.scm4 dict.m4 | ||
53 | 54 | ||
54 | dict.cgi: dict.scm | 55 | dict.cgi: dict.scm |
55 | nea.cgi: nea.scm | 56 | 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 @@ | |||
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 | |||
33 | ifelse(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 |