/ [runasimi] / trunk / cgi-bin / dict.cgi.in
To checkout: svn checkout http://svn.gnu.org.ua/sources/runasimi/trunk/cgi-bin/dict.cgi.in
Puszcza

Annotation of /trunk/cgi-bin/dict.cgi.in

Parent Directory Parent Directory | Revision Log Revision Log


Revision 33 - (hide annotations)
Fri Jun 20 08:40:55 2008 UTC (13 years, 4 months ago) by gray
File size: 20081 byte(s)
Fix error handling. Use  UTF-8.

* rawdata/struct.sql: New file.
* rawdata/Makefile: Use UTF-8
* cgi-bin/dict.cgi.in: Use sql-catch-failure to handle SQL errors.

1 gray 14 #!/usr/local/bin/guile -s
2 gray 20 =AUTOGENERATED=
3 gray 14 !#
4     ;;;; This is a Quechua Web Dictionary Search Engine
5 gray 29 ;;;; Copyright (C) 2002, 2003, 2008 Sergey Poznyakoff
6 gray 14 ;;;;
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 gray 32 ;;;; the Free Software Foundation; either version 3 of the License, or
10 gray 14 ;;;; (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 gray 32 ;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19 gray 14 ;;;;
20    
21 gray 20 ;;; Tailor this statement to your needs if necessary.
22     ;=GUILE_COMMENT=;(set! %load-path (cons "=GUILE_SITE=" %load-path))
23    
24 gray 32 (use-modules (www cgi)
25     (gamma sql)
26     (ice-9 rdelim))
27 gray 14 (cgi:init)
28    
29     ;;; User-definable variables
30     (define base-dir "=PREFIX=")
31     (define html-dir "=HTMLDIR=")
32     (define sysconf-dir "=SYSCONFDIR=")
33     (define locale-dir "=LOCALEDIR=")
34     (define ref-loc #f)
35    
36     (define dict-cgi-path "cgi-bin/dict.cgi") ;; Path to the cgi (relative
37     ;; to the Base HREF)
38    
39     (define config-file-name "runasimi.conf")
40     (define template-file-name "dict.html")
41     (define target-language "es_ES")
42    
43     (define word-forms-reference '())
44    
45     (define sql-iface "mysql") ;; SQL interface ("mysql" or "postgres")
46     (define sql-host "localhost") ;; SQL server hostname or a path to the UNIX
47     ;; socket
48     (define sql-port 3306) ;; SQL port number (0 for sockaddr_un
49     ;; connection)
50     (define sql-database "runasimi") ;; Name of the database
51     (define sql-username "gray") ;; Database user name
52     (define sql-password "") ;; Password for that user name
53    
54     (define match-list-columns 4) ;; Number of colums in fuzzy search output
55     ;;; End of user-definable variables
56    
57     ;;; Load the site defaults
58     (let ((rc-file (string-append sysconf-dir "/" config-file-name)))
59     (if (file-exists? rc-file)
60     (load rc-file)))
61    
62     (define (language-code lang)
63     (cond
64     ((string-index lang #\_) =>
65     (lambda (len)
66     (substring lang 0 len)))
67     (else
68     lang)))
69    
70     (define (template-file lang)
71     (string-append html-dir "/" (language-code lang) "/" template-file-name))
72    
73     ;;; Load the language-specific defaults
74     (cond
75     ((cgi:value "LANG") =>
76     (lambda (x)
77     (if (and (file-exists? (template-file x))
78     (false-if-exception (setlocale LC_ALL x)))
79     (set! target-language x)))))
80    
81     ;;; Initialize i18n
82     (setlocale LC_ALL target-language)
83     (bindtextdomain "=PACKAGE=" locale-dir)
84 gray 32 (bind-textdomain-codeset "=PACKAGE=" "UTF-8")
85 gray 14 (textdomain "=PACKAGE=")
86    
87     (define (make-cgi-name . rest)
88     (apply
89     string-append
90     (cons
91     dict-cgi-path
92     (let ((arglist (let ((lang (cgi:value "LANG")))
93     (do ((ilist (if lang
94     (cons "LANG" (cons lang rest))
95     rest) (cdr ilist))
96     (i 1 (1+ i))
97     (olist '()))
98     ((null? ilist) (if (null? olist)
99     olist
100     (reverse (cdr olist))))
101     (set! olist (cons (car ilist) olist))
102     (set! olist (cons
103     (if (odd? i) "=" "&")
104     olist))))))
105     (if (null? arglist)
106     arglist
107     (cons "?" arglist))))))
108    
109     ;;; Encode 8-bit string
110     (define (encode-string str)
111     (apply
112     string-append
113     (map
114     (lambda (x)
115     (let ((n (char->integer x)))
116     (if (or (and (> n 97) (< n 122))
117     (and (> n 65) (< n 90))
118     (and (> n 48) (< n 57)))
119     (string x)
120     (let ((s (number->string n 16)))
121     (string-append "%"
122     (if (< n 16)
123     "0" "")
124     s)))))
125     (string->list str))))
126    
127     ;;; Decode a string encoded with encode-string
128     (define (decode-string str)
129     (do ((i 0)
130     (sl '()))
131     ((= i (string-length str)) (list->string (reverse sl)))
132     (let ((c (string-ref str i)))
133     (set! sl
134     (cons
135     (cond
136     ((char=? c #\%)
137     (set! i (+ i 3))
138     (integer->char
139     (string->number (substring str (- i 2) i) 16)))
140     (else
141     (set! i (1+ i))
142     c))
143     sl)))))
144    
145     ;;;;
146    
147     (define lang-list
148     ;; key Option Table Flag
149     ;;----+---------+---------+------
150     '((en "English" "english" #f)
151     (de "Deutsch" "deutsch" #f)
152 gray 29 (es "Español" "espanol" #f)
153 gray 14 (qu "Quechua" "quechua" #t)))
154    
155     (define dialect-list
156     ;; key Name Table
157     ;; ------------+-------------+--------------
158     '(("cozco" "Cozco" "cozco")
159     ("ayacucho" "Ayacucho" "ayacucho")
160     ("cochabamba" "Cochabamba" "cochabamba")
161 gray 29 ("tucuman" "Tucumán" "tucuman")
162 gray 14 ("imbabura" "Imbabura" "imbabura")))
163    
164     (define (dict-make-lang-selector name defval tabindex)
165 gray 29 (display (string-append "<select name=\""
166 gray 14 name
167 gray 29 "\" tabindex=\""
168 gray 14 (number->string tabindex) "\">"))
169     (let* ((selected-choice (or
170     (let ((s (cgi:value name)))
171     (if s
172     (string->symbol s)
173     #f)) defval))
174     (sel (assoc selected-choice lang-list)))
175     (for-each
176     (lambda (x)
177     (let ((id (car x))
178     (name (car (cdr x))))
179 gray 29 (display "<option value=\"")
180 gray 14 (display id)
181 gray 29 (display "\"")
182 gray 14 (if (eq? id selected-choice)
183 gray 29 (display " selected=\"selected\""))
184 gray 14 (display ">")
185 gray 29 (display name)
186     (display "</option>")))
187 gray 14 lang-list))
188 gray 29 (display "</select>"))
189 gray 14
190 gray 17 (define (get-dialect-list)
191     (let ((ds (or (cgi:value "dialsel") "all")))
192     (if (string=? ds "all")
193     (map car dialect-list)
194     (cgi:values "dialect"))))
195    
196 gray 14 (define (dict-make-dialect-selector)
197     (let* ((name "dialect")
198 gray 17 (ds (or (cgi:value "dialsel") "all"))
199 gray 14 (sel (cgi:values name)))
200     (display "
201 gray 29 <table frame=\"box\" rules=\"rows\">
202     <tr>
203     <td colspan=\"2\">
204     <input type=\"radio\" name=\"dialsel\" value=\"all\"")
205 gray 17 (if (string=? ds "all")
206 gray 29 (display " checked=\"checked\""))
207     (display " tabindex=\"10\" />Todos los dialectos
208     </td>
209     </tr>
210     <tr>
211     <td valign=\"top\">
212     <input type=\"radio\" name=\"dialsel\" value=\"select\"")
213 gray 17 (if (string=? ds "select")
214 gray 29 (display " checked=\"checked\""))
215     (display " tabindex=\"10\" />Selecciona dialectos
216     </td>
217     <td valign=\"top\">
218     <table>")
219 gray 14 (for-each
220     (lambda (x)
221     (display (string-append
222 gray 29 "<tr><td><input type=\"checkbox\" name=\""
223 gray 14 name "\" "))
224 gray 29 (display " value=\"")
225 gray 17 (display (car x))
226     (display "\"")
227     (if (and sel (member (car x) sel))
228 gray 29 (display " checked=\"checked\""))
229     (display "/>")
230 gray 17 (display (cadr x))
231 gray 29 (display "</td></tr>\n"))
232 gray 14 dialect-list)
233 gray 17
234 gray 14 (display "
235 gray 29 </table>
236     </td>
237     </tr>
238     </table>")))
239 gray 14
240     (define (dict-make-alfa-selector tabindex)
241     (let ((sel (or (cgi:value "alfabet") "iso")))
242     (display "
243 gray 29 <table frame=\"box\" rules=\"rows\">
244     <tr valign=\"top\">
245     <td align=\"center\">
246     Escoge alfábeto de entrada
247     </td>
248     </tr>
249     <tr valign=\"top\">
250     <td>
251     <table>
252     <tr>
253     <td>
254     <input type=\"radio\" name=\"alfabet\" value=\"iso\"")
255 gray 14 (if (string=? sel "iso")
256 gray 29 (display " checked=\"checked\""))
257 gray 14 (display (string-append
258 gray 29 " tabindex=\"" (number->string tabindex)
259     "\" /> alfábeto español"))
260 gray 14 (display "
261 gray 29 </td>
262     </tr>
263     <tr>
264     <td>
265     <input type=\"radio\" name=\"alfabet\" value=\"postfix\"")
266 gray 14
267     (if (string=? sel "postfix")
268 gray 29 (display " checked=\"checked\""))
269 gray 14
270 gray 29 (display (string-append " tabindex=\"" (number->string (1+ tabindex))
271     "\" /> a' para á, n~ para ñ, etc."))
272 gray 14 (display "
273 gray 29 </td>
274     </tr>
275     </table>
276     </td>
277     </tr>
278     </table>")))
279 gray 14
280     ;; Protect occurences of " in a string.
281     ;; Usual backslash espaces do not work in INPUT widgets, so I
282     ;; change all quotation marks to &#34;
283     ;; Possibly not the better solution, though...
284     (define (protect string)
285     (list->string
286     (apply append
287     (map
288     (lambda (x)
289     (if (eq? x #\")
290     (list #\& #\# #\3 #\4 #\;)
291     (list x)))
292     (string->list string)))))
293    
294     (define (main-form)
295 gray 29 (display "<form action=\"")
296 gray 14 (display (make-cgi-name))
297 gray 29 (display "\" method=\"post\">
298     <table border=\"0\">
299     <tr>
300     <td>
301     <input size=\"64\" name=\"key\" tabindex=\"1\"")
302 gray 14 (let ((value (cgi:value "key")))
303     (if value
304     (begin
305 gray 29 ; (display (string-append "GOT VALUE " value) (current-error-port))
306     (display "value=\"")
307 gray 14 (display (protect value))
308     (display "\""))))
309 gray 29 (display " />
310     </td>
311     <td>
312     <input type=\"submit\" name=\"buscar\" value=\"Buscar\" tabindex=\"2\" />
313     </td>
314     </tr>
315     <tr>
316     <td>
317 gray 14 Traducir de ")
318     (dict-make-lang-selector "src" 'qu 3)
319     (display " al ")
320     (dict-make-lang-selector "dst" 'es 3)
321     (display "
322 gray 29 </td>
323     </tr>
324     <tr>
325     <td>
326     <hr />
327     </td>
328     </tr>
329     <tr>
330     <td colspan=\"2\">
331     <table width=\"100%\">
332     <tr>
333     <td>")
334 gray 17 (dict-make-dialect-selector)
335     (display "
336 gray 29 </td>
337     <td align=\"right\" valign=\"top\">")
338 gray 17 (dict-make-alfa-selector 4)
339     (display "
340 gray 29 </td>
341     </tr>
342     </table>
343     </td>
344     </tr>
345     </table>")
346     (display "</form>"))
347 gray 14
348     ;; Implementation of a Common LISP mapcan function
349     ;; NOTE: not used _yet_
350     (define (mapcan fun list)
351     (apply (lambda ( . slist)
352     (let loop ((elt '())
353     (slist slist))
354     (cond
355     ((null? slist)
356     (reverse elt))
357     ((not (car slist))
358     (loop elt (cdr slist)))
359     (else
360     (loop (cons (car slist) elt) (cdr slist))))))
361     (map fun list)))
362    
363     ;;; Translate input
364     ;;; The only map currenly used is postfix -> latin-1
365     ;;; The map is adopted from emacs iso-acc.el
366     (define latin-1-map
367     (list
368     (cons #\' (list (cons #\A #\301) (cons #\E #\311) (cons #\I #\315)
369     (cons #\O #\323) (cons #\U #\332) (cons #\Y #\335)
370     (cons #\a #\341) (cons #\e #\351) (cons #\i #\355)
371     (cons #\o #\363) (cons #\u #\372) (cons #\y #\375)
372     (cons #\' #\') (cons #\ #\')))
373     (cons #\` (list (cons #\A #\300) (cons #\E #\310) (cons #\I #\314)
374     (cons #\O #\322) (cons #\U #\331) (cons #\a #\340)
375     (cons #\e #\350) (cons #\i #\354) (cons #\o #\362)
376     (cons #\u #\371) (cons #\` #\`) (cons #\ #\`)))
377     (cons #\^ (list (cons #\A #\302) (cons #\E #\312) (cons #\I #\316)
378     (cons #\O #\324) (cons #\U #\333) (cons #\a #\342)
379     (cons #\e #\352) (cons #\i #\356) (cons #\o #\364)
380     (cons #\u #\373) (cons #\^ #\^) (cons #\ #\^)))
381     (cons #\" (list (cons #\A #\304) (cons #\E #\313) (cons #\I #\317)
382     (cons #\O #\326) (cons #\U #\334) (cons #\a #\344)
383     (cons #\e #\353) (cons #\i #\357) (cons #\o #\366)
384     (cons #\s #\337) (cons #\u #\374) (cons #\y #\377)
385     (cons #\" #\") (cons #\ #\")))
386     (cons #\~ (list (cons #\A #\303) (cons #\C #\307) (cons #\D #\320)
387     (cons #\N #\321) (cons #\O #\325) (cons #\T #\336)
388     (cons #\a #\343) (cons #\c #\347) (cons #\d #\360)
389     (cons #\n #\361) (cons #\o #\365) (cons #\t #\376)
390     (cons #\> #\273) (cons #\< #\253) (cons #\! #\241)
391     (cons #\\ #\277) (cons #\~ #\~) (cons #\ #\~)))
392     (cons #\/ (list (cons #\A #\305) (cons #\E #\306) (cons #\O #\330)
393     (cons #\a #\345) (cons #\e #\346) (cons #\o #\370)
394     (cons #\/ #\/) (cons #\ #\/)))))
395    
396     ;; Translate a string from postfix notation to latin-1 encoding
397     (define (translate-postfix str)
398     (list->string
399     (do ((sl (reverse (cons #f (string->list str))) (cdr sl))
400     (l '() (cons (car sl) l))
401     (charmap #f (assoc (car sl) latin-1-map)))
402     ((null? sl) (cdr l))
403     (if charmap
404     (let ((x (assoc (car sl) (cdr charmap))))
405     (if x
406     (begin
407     (set! l (cons (cdr x) (cdr l)))
408     (set! sl (cdr sl)))))))))
409    
410     (define (translate-input input)
411     (case (string->symbol (cgi:value "alfabet"))
412     ((iso)
413     input)
414     ((postfix)
415     (translate-postfix input))
416     (else
417     ;; Internal error?
418     input)))
419    
420     ;; FIXME
421     (define (regexp? str)
422     (or (string-index str #\*)
423     (string-index str #\?)))
424    
425     ;;; NOTE: Terms accepted in the function names and comments below:
426     ;;; 1) "POS" = "part of speech"
427     ;;; 2) "SRC" = "source language" is the language to translate from
428     ;;; 3) "DST" = "destination language" is the language to transalte
429     ;;; to
430     ;;; 4) "forward" = "forward translation" means the translation from
431     ;;; Quechua to a destination language
432     ;;; 5) "reverse" = "reverse translation" means the translation from
433     ;;; the given source language to Quechua
434    
435     (define (dict-build-forward-query src-desc dst-desc key)
436     (let ((key-expr (string-append (if (regexp? key)
437     " REGEXP "
438     "=")
439     "\"" key "\"")))
440     (string-append
441     "SELECT q.part_of_speech, q.common "
442     ", e.entry FROM "
443     (caddr src-desc) " q, "
444     (caddr dst-desc) " e WHERE e.common=q.common AND e.part_of_speech=q.part_of_speech AND q.common"
445     key-expr
446     " ORDER BY 2,1,3")))
447    
448     (define (dict-build-forward-dialect-query src-desc dst-desc key)
449     (let ((key-expr (string-append (if (regexp? key)
450     " REGEXP "
451     "=")
452     "\"" key "\"")))
453     (string-append
454     "SELECT q.part_of_speech, q.entry "
455     ", e.entry FROM "
456     (caddr src-desc) " q, "
457     (caddr dst-desc) " e WHERE e.common=q.common AND e.part_of_speech=q.part_of_speech AND q.entry"
458     key-expr
459     " ORDER BY 2,1,3")))
460    
461     ;; Result format is:
462     ;; (POS SRC DST)
463    
464     (define (dict-display-forward-result res)
465     (let ((key "")
466     (value "")
467     (num 0))
468 gray 29 (display "<table>")
469 gray 14 (for-each
470     (lambda (x)
471     (let ((k (string-append (car x) (cadr x))))
472     (if (not (string=? key k))
473     (begin
474     (set! key k)
475     (set! num 0)
476     (set! value "")
477 gray 29 (display "<tr><td><b>")
478 gray 14 (display (list-ref x 1))
479     (display "</b>, <i>")
480     (display (car x))
481 gray 29 (display "</i></td></tr>")))
482 gray 14 (if (not (string=? value (list-ref x 2)))
483     (begin
484     (set! value (list-ref x 2))
485     (set! num (1+ num))
486 gray 29 (display "<tr><td></td><td>")
487 gray 14 (display (list-ref x 2))
488 gray 29 (display "</td></tr>")))))
489 gray 14 res)
490 gray 29 (display "</table>")))
491 gray 14
492     (define (dict-build-reverse-query src-desc dst-desc key)
493     (if (regexp? key)
494     (let ((key-expr (string-append " REGEXP "
495     "\"" key "\"")))
496     (string-append
497     "SELECT dst.part_of_speech, dst.entry, src.entry FROM "
498     (caddr src-desc) " src, "
499     (caddr dst-desc) " dst WHERE src.common=dst.common \
500     AND dst.part_of_speech=src.part_of_speech AND src.entry "
501     key-expr " ORDER BY 1"))
502     (string-append
503     "SELECT dst.part_of_speech, dst.entry, src.entry FROM "
504     (caddr src-desc) " src, "
505     (caddr src-desc) "_key k,"
506     (caddr dst-desc) " dst WHERE src.common=dst.common AND \
507     k.serial=src.serial AND k.entry = \"" key "\"")))
508    
509    
510     ;; On input input-list is a list of conses. Each cons takes the form:
511     ;; ( DIALECT-NAME . SOLUTION-LIST )
512     ;; Each SOLUTION-LIST is a list of lists, each list in it takes the form:
513     ;; (POS DST SRC)
514     ;; The purpose of the function is to merge all sublists with the same
515     ;; solutions (i.e. DIALECT-NAME POS SRC triplets). The return value
516     ;; is a list of the following elements:
517     ;; ( DIALECT-LIST POS DST SRC)
518     ;; where DIALECT-LIST is itself the list of dialects this solution
519     ;; pertains to.
520     (define (sort-solution input-list)
521     (let ((l '()))
522     (for-each
523     (lambda (x)
524     (if (and (not (null? l))
525     (string=? (list-ref x 1) (list-ref (car l) 1))
526     (string=? (list-ref x 2) (list-ref (car l) 2)))
527     (if (not (member (caar x) (caar l)))
528     (set! l (cons
529     (cons
530     (cons (caar x) (caar l))
531     (cdar l))
532     (cdr l))))
533     (set! l (cons x l))))
534     (let ((less (lambda (a b)
535     (or (string<? (list-ref a 1) (list-ref b 1))
536     (string<? (list-ref a 2) (list-ref b 2))))))
537     (sort-list (apply append
538     (map (lambda (x)
539     (let ((dial (car x)))
540     (map (lambda (y)
541     (cons (list dial) y))
542     (cdr x))))
543     input-list)) less)))
544     (reverse l)))
545    
546     ;; Display the obtained reverse solutions. KEY is the key value used
547     ;; to obtain the solutions.
548     ;; RESULT is the list of solutions obtained from the call to
549     ;; sort-solution (see the comment above for its structure)
550     (define (dict-display-reverse-result key result)
551     (if (null? result)
552     0
553     (let ((less (lambda (a b)
554     (string<? (list-ref a 1) (list-ref b 1))))
555     (num 0)
556     (pos ""))
557     (for-each
558     (lambda (x)
559     (cond
560     ((not (string=? (list-ref x 1) pos))
561 gray 29 (display "<p><b>")
562 gray 14 (display key)
563 gray 29 (display "</b> ")
564 gray 14 ;; Print the part of speech.
565     (set! pos (list-ref x 1))
566 gray 29 (display "<i>")
567 gray 14 (display pos)
568 gray 29 (display "</i> ")))
569 gray 14 ;; Print the list of dialects if it contains more than
570     ;; one item or its only item is not a null string.
571     (if (or (> (length (car x)) 1)
572     (not (string-null? (caar x))))
573     (begin
574     (display "&nbsp;<i>(")
575     (display (caar x))
576     (for-each
577     (lambda (y)
578     (display ", ")
579     (display y))
580     (cdar x))
581     (display ")</i>")))
582     ;; Print the translation
583    
584     (display (list-ref x 2))
585     ;; Print the description (SRC)
586     (if (not (string-ci=? (list-ref x 3) key))
587     (begin
588     (display " <i>")
589     (display (list-ref x 3))
590     (display "</i>")))
591 gray 29 (display "<br />")
592 gray 14 (set! num (1+ num)))
593     ;; Operate on alphabetically sorted list
594     (sort-list result less))
595     num)))
596    
597    
598     ;;; Main
599     (define (get-source-language)
600     (cond
601     ((cgi:value "src") =>
602     (lambda (res) res))
603     (else
604     "qu")))
605    
606     (define (get-dest-language)
607     (cond
608     ((cgi:value "dst") =>
609     (lambda (res) res))
610     ((assoc (string->symbol (language-code target-language)) lang-list) =>
611     (lambda (res) (language-code target-language)))
612     (else
613     "es")))
614 gray 33
615     (define (sql-error-handler err descr)
616     (format #t "<h1 class=\"error\">~A</h1>\n"
617     "no se puede conectar al diccionário")
618     (with-output-to-port
619     (current-error-port)
620     (lambda ()
621     (display err)
622     (display ": ")
623     (display descr))))
624    
625     (define (dict-connect)
626     (let ((conn (sql-connect
627     sql-iface sql-host sql-port sql-database
628     sql-username sql-password)))
629     (sql-query conn "SET NAMES utf8")
630     conn))
631    
632 gray 14 (define (dict-search)
633     (let ((keyval (if (cgi:value "IDENT")
634     (decode-string (cgi:value "IDENT"))
635     (if (cgi:value "key")
636     (translate-input (cgi:value "key"))
637     #f))))
638     (if keyval
639 gray 33 (sql-catch-failure
640     (let ((conn (dict-connect)))
641     (display "<hr />")
642     (let* ((num 0)
643     (src (get-source-language))
644     (dst (get-dest-language))
645     (src-desc (assoc (string->symbol src) lang-list))
646     (dst-desc (assoc (string->symbol dst) lang-list)))
647 gray 14
648 gray 33 (if (list-ref src-desc 3)
649     ;; Source language is Quechua
650     (for-each
651     (lambda (x)
652     (let ((res (sql-query conn (cdr x))))
653     (if (not (null? res))
654     (begin
655     (set! num (1+ num))
656     (display (string-append
657     "<h3>" (car x) "</h3>"))
658     (dict-display-forward-result res)))))
659     (append
660     (list (cons "" (dict-build-forward-query src-desc
661     dst-desc
662     keyval)))
663     (map
664     (lambda (dialect)
665     (let ((descr (assoc dialect dialect-list)))
666     (cons (cadr descr)
667     (dict-build-forward-dialect-query descr
668     dst-desc
669     keyval))))
670     (get-dialect-list))))
671     ;; Otherwise
672     (set! num
673     (dict-display-reverse-result
674     keyval
675     (sort-solution
676     (append
677     (list (cons ""
678     (sql-query
679     conn
680     (dict-build-reverse-query src-desc
681     dst-desc
682     keyval))))
683     (map
684     (lambda (dialect)
685     (let ((descr (assoc dialect dialect-list)))
686     (cons (cadr descr)
687     (sql-query
688     conn
689     (dict-build-reverse-query src-desc
690     descr
691     keyval)))))
692     (get-dialect-list)))))))
693     (if (= num 0)
694     (display
695     "Disculpa, no se ha encontrado la palabra en el diccionário\n"))
696     (sql-connect-close conn))))
697     (display "<hr />"))))
698 gray 14
699    
700     (define (dict-html)
701     (do ((line (read-line) (read-line)))
702     ((eof-object? line) #f)
703     (cond
704     ((string=? line "@@dict@@")
705     (main-form)
706     (dict-search))
707     (else
708     (display line)
709     (newline)))))
710    
711     ;;; Main
712 gray 29 (display "Content-type: text/html; charset=UTF-8\r\n\r\n")
713 gray 14 (with-input-from-file
714     (template-file target-language)
715     dict-html)
716    
717    
718    
719     ;;;; Local variables:
720     ;;;; mode: Scheme
721     ;;;; End:

Properties

Name Value
svn:eol-style native
svn:executable *
svn:keywords Author Date Id Revision

Send suggestions and bug reports to Sergey Poznyakoff
ViewVC Help
Powered by ViewVC 1.1.20