diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2006-10-08 21:39:00 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2006-10-08 21:39:00 +0000 |
commit | c4a4896b38006d9966ffd6112e27539ba0efeaca (patch) | |
tree | 92531f80844dc3815cde1ececdebcd8d92e9c9ce | |
parent | 38cd77fba411fdc8684654bb6f163809ffe1eb46 (diff) | |
download | ellinika-c4a4896b38006d9966ffd6112e27539ba0efeaca.tar.gz ellinika-c4a4896b38006d9966ffd6112e27539ba0efeaca.tar.bz2 |
Removed
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@459 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rw-r--r-- | cgi-bin/dict.cgi.in | 622 | ||||
-rw-r--r-- | cgi-bin/nea.cgi.in | 534 | ||||
-rw-r--r-- | xml/nea.scm | 9 |
3 files changed, 0 insertions, 1165 deletions
diff --git a/cgi-bin/dict.cgi.in b/cgi-bin/dict.cgi.in deleted file mode 100644 index d087bf3..0000000 --- a/cgi-bin/dict.cgi.in +++ /dev/null | |||
@@ -1,622 +0,0 @@ | |||
1 | #! =GUILE_BINDIR=/guile -s | ||
2 | =AUTOGENERATED= | ||
3 | !# | ||
4 | ;;;; Greek Dictionary Web Engine | ||
5 | ;;;; Copyright (C) 2004, 2005 Sergey Poznyakoff | ||
6 | ;;;; | ||
7 | ;;;; This program is free software; you can redistribute it and/or modify | ||
8 | ;;;; it under the terms of the GNU General Public License as published by | ||
9 | ;;;; the Free Software Foundation; either version 2 of the License, or | ||
10 | ;;;; (at your option) any later version. | ||
11 | ;;;; | ||
12 | ;;;; This program is distributed in the hope that it will be useful, | ||
13 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
14 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
15 | ;;;; GNU General Public License for more details. | ||
16 | ;;;; | ||
17 | ;;;; You should have received a copy of the GNU General Public License | ||
18 | ;;;; along with this program; if not, write to the Free Software | ||
19 | ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | ||
20 | ;;;; | ||
21 | |||
22 | ;;; Tailor this statement to your needs if necessary. | ||
23 | ;=GUILE_COMMENT=;(set! %load-path (cons "=GUILE_SITE=" %load-path)) | ||
24 | |||
25 | (use-modules (www cgi) | ||
26 | (gamma sql) | ||
27 | (gamma gettext) | ||
28 | (xmltools dict) | ||
29 | (ellinika xlat) | ||
30 | (ellinika cgi)) | ||
31 | (cgi:init) | ||
32 | |||
33 | (ellinika-cgi-init dict-template-file-name) | ||
34 | |||
35 | ;; Τα μέρη του λογου | ||
36 | (define part-of-speech '()) | ||
37 | |||
38 | (define (sql-error-handler err descr) | ||
39 | (format #t "<h1 class=\"error\">~A</h1>\n" | ||
40 | (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")) | ||
41 | (with-output-to-port | ||
42 | (current-error-port) | ||
43 | (lambda () | ||
44 | (display err) | ||
45 | (display ": ") | ||
46 | (display descr)))) | ||
47 | |||
48 | (define (mk-dict-connect) | ||
49 | (let ((db-connection #f)) | ||
50 | (lambda (. rest) | ||
51 | (cond | ||
52 | ((null? rest) | ||
53 | (if (not db-connection) | ||
54 | (begin | ||
55 | (set! db-connection | ||
56 | (sql-connect | ||
57 | sql-iface sql-host sql-port sql-database | ||
58 | sql-username sql-password)) | ||
59 | (sql-query db-connection "SET NAMES utf8") | ||
60 | ))) | ||
61 | (else | ||
62 | (if db-connection | ||
63 | (sql-connect-close db-connection)) | ||
64 | (set! db-connection #f))) | ||
65 | db-connection))) | ||
66 | |||
67 | (define dict-connect (mk-dict-connect)) | ||
68 | |||
69 | (defmacro catch-sql-failure (expr) | ||
70 | `(catch 'gsql-error | ||
71 | (lambda () ,expr) | ||
72 | (lambda (key err descr) | ||
73 | (sql-error-handler err descr)))) | ||
74 | |||
75 | (defmacro ignore-sql-failure (expr) | ||
76 | `(catch 'gsql-error | ||
77 | (lambda () ,expr) | ||
78 | (lambda (key err descr) | ||
79 | #f))) | ||
80 | |||
81 | (define (load-pos) | ||
82 | (ignore-sql-failure | ||
83 | (let ((conn (dict-connect))) | ||
84 | (let ((plist (my-sql-query | ||
85 | conn | ||
86 | "SELECT name,id FROM pos WHERE canonical='Y' order by id"))) | ||
87 | (set! part-of-speech | ||
88 | (cons | ||
89 | (cons "κανένα μέρος του λόγου" #f) | ||
90 | (map | ||
91 | (lambda (x) | ||
92 | (cons (car x) (cadr x))) | ||
93 | plist))))))) | ||
94 | |||
95 | ;; Protect occurences of " in a string. | ||
96 | ;; Usual backslash escapes do not work in INPUT widgets, so I | ||
97 | ;; change all quotation marks to " | ||
98 | ;; Possibly not the better solution, though... | ||
99 | (define (protect string) | ||
100 | (list->string | ||
101 | (apply append | ||
102 | (map | ||
103 | (lambda (x) | ||
104 | (if (eq? x #\") | ||
105 | (list #\& #\# #\3 #\4 #\;) | ||
106 | (list x))) | ||
107 | (string->list string))))) | ||
108 | |||
109 | (define (get-topic-list) | ||
110 | (let ((categories #f)) | ||
111 | (letrec ((getcat | ||
112 | (lambda () | ||
113 | (ignore-sql-failure | ||
114 | (let ((conn (dict-connect))) | ||
115 | (let ((ctg (my-sql-query | ||
116 | conn | ||
117 | (string-append | ||
118 | "SELECT t.category, c.title, c.description " | ||
119 | "FROM category c,topic t " | ||
120 | "WHERE c.lang='" (language-code target-language) "' " | ||
121 | "AND c.category=t.category GROUP BY 1 ORDER BY 1")))) | ||
122 | (if (null? ctg) | ||
123 | '() | ||
124 | (map | ||
125 | (lambda (category) | ||
126 | (let ((topics (my-sql-query | ||
127 | conn | ||
128 | (string-append | ||
129 | "SELECT ident,title FROM topic WHERE category=" | ||
130 | (car category) | ||
131 | " ORDER BY title")))) | ||
132 | (append category (if (null? topics) | ||
133 | '() | ||
134 | (list topics))))) | ||
135 | ctg)))))))) | ||
136 | (if (not categories) | ||
137 | (set! categories (or (getcat) '()))) | ||
138 | categories))) | ||
139 | |||
140 | (define (join-widget widget-id tabindex) | ||
141 | (let* ((name (string-append "join" widget-id)) | ||
142 | (selected-choice (or (let ((s (cgi:value name))) | ||
143 | (if s | ||
144 | (string->number s) | ||
145 | #f)) | ||
146 | 0))) | ||
147 | (display (string-append "<SELECT NAME=\"" | ||
148 | name | ||
149 | "\" TABINDEX=\"" | ||
150 | tabindex | ||
151 | "\">")) | ||
152 | (display "<OPTION VALUE=\"0\"") | ||
153 | (if (= selected-choice 0) | ||
154 | (display " selected")) | ||
155 | (display ">") (display (_"και")) (display "</OPTION>") | ||
156 | (display "<OPTION VALUE=\"1\"") | ||
157 | (if (= selected-choice 1) | ||
158 | (display " selected")) | ||
159 | (display ">") (display (_"ή")) (display "</OPTION>") | ||
160 | (display "</SELECT>"))) | ||
161 | |||
162 | (define (main-form) | ||
163 | (load-pos) | ||
164 | (display "<FORM ACTION=\"") | ||
165 | (display (make-cgi-name dict-cgi-path)) | ||
166 | (display "\" METHOD=POST> | ||
167 | <table class=\"noframe\"> | ||
168 | <tr> | ||
169 | <td>") | ||
170 | (display (_"Εισάγετε τη λέξη")) | ||
171 | (display " | ||
172 | </td> | ||
173 | <td> | ||
174 | <input size=\"36\" name=\"key\" tabindex=\"1\"") | ||
175 | (let ((value (cgi:value "key"))) | ||
176 | (if value | ||
177 | (begin | ||
178 | (display "value=\"") | ||
179 | (display (protect value)) | ||
180 | (display "\"")))) | ||
181 | (display "> | ||
182 | </td> | ||
183 | </tr>") | ||
184 | |||
185 | (display "<tr><td colspan=\"3\" align=\"center\">") | ||
186 | (display (_"Συμπληρωματικοί όροι")) | ||
187 | (display "</td></tr>") | ||
188 | |||
189 | (display " | ||
190 | <tr> | ||
191 | <td>") | ||
192 | (display (_"Επιλέξτε το μέρος του λόγου")) | ||
193 | (display "</td><td>") | ||
194 | |||
195 | (let ((selected-choice (or (let ((s (cgi:value "POS"))) | ||
196 | (if s | ||
197 | (string->number s) | ||
198 | #f)) | ||
199 | 0)) | ||
200 | (index 0)) | ||
201 | |||
202 | (display "<select name=\"POS\" tabindex=\"2\">") | ||
203 | |||
204 | (for-each | ||
205 | (lambda (x) | ||
206 | (let ((name (car x))) | ||
207 | (display "<option value=") | ||
208 | (display index) | ||
209 | (if (= index selected-choice) | ||
210 | (display " selected")) | ||
211 | (display ">") | ||
212 | (display name) | ||
213 | (set! index (1+ index)))) | ||
214 | part-of-speech) | ||
215 | (display "</select>")) | ||
216 | |||
217 | (display "</td><td>") | ||
218 | (join-widget "pos" "3") | ||
219 | (display "</td></tr>") | ||
220 | |||
221 | (let ((tabindex 4)) | ||
222 | (for-each | ||
223 | (lambda (category) | ||
224 | (display "<tr><td>") | ||
225 | (display (list-ref category 1)) | ||
226 | (display "</td><td>") | ||
227 | (let ((selected-choice (or (let ((s (cgi:value (list-ref category 0)))) | ||