/ [runasimi] / trunk / src / runasimi / dictdb.scm
To checkout: svn checkout http://svn.gnu.org.ua/sources/runasimi/trunk/src/runasimi/dictdb.scm
Puszcza

Contents of /trunk/src/runasimi/dictdb.scm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 41 - (show annotations)
Fri Jun 20 12:23:48 2008 UTC (13 years, 3 months ago) by gray
File size: 4808 byte(s)
Do not preprocess dictdb.scm
1 ;;;; -*- scheme -*-
2 ;;;; This file is a part of Quechua Web Dictionary Search Engine
3 ;;;; Copyright (C) 2005, 2007, 2008 Sergey Poznyakoff
4 ;;;;
5 ;;;; This program is free software; you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation; either version 3 of the License, or
8 ;;;; (at your option) any later version.
9 ;;;;
10 ;;;; This program is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
14 ;;;;
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
17 ;;;;
18
19 (define-module (runasimi dictdb)
20 #:use-module (gamma sql))
21
22 ;; FIXME
23 (define (regexp? str)
24 (or (string-index str #\*)
25 (string-index str #\?)))
26
27 ;;; NOTE: Terms accepted in the function names and comments below:
28 ;;; 1) "POS" = "part of speech"
29 ;;; 2) "SRC" = "source language" is the language to translate from
30 ;;; 3) "DST" = "destination language" is the language to transalte
31 ;;; to
32 ;;; 4) "forward" = "forward translation" means the translation from
33 ;;; Quechua to a destination language
34 ;;; 5) "reverse" = "reverse translation" means the translation from
35 ;;; the given source language to Quechua
36
37 (define-public (dictdb:build-forward-query src-desc dst-desc key)
38 (let ((key-expr (string-append (if (regexp? key)
39 " REGEXP "
40 "=")
41 "\"" key "\"")))
42 (string-append
43 "SELECT q.part_of_speech, q.common "
44 ", e.entry FROM "
45 (caddr src-desc) " q, "
46 (caddr dst-desc) " e WHERE e.common=q.common AND e.part_of_speech=q.part_of_speech AND q.common"
47 key-expr
48 " ORDER BY 2,1,3")))
49
50 (define-public (dictdb:build-forward-dialect-query src-desc dst-desc key)
51 (let ((key-expr (string-append (if (regexp? key)
52 " REGEXP "
53 "=")
54 "\"" key "\"")))
55 (string-append
56 "SELECT q.part_of_speech, q.entry "
57 ", e.entry FROM "
58 (caddr src-desc) " q, "
59 (caddr dst-desc) " e WHERE e.common=q.common AND e.part_of_speech=q.part_of_speech AND q.entry"
60 key-expr
61 " ORDER BY 2,1,3")))
62
63 (define-public (dictdb:build-reverse-query src-desc dst-desc key)
64 (if (regexp? key)
65 (let ((key-expr (string-append " REGEXP "
66 "\"" key "\"")))
67 (string-append
68 "SELECT dst.part_of_speech, dst.entry, src.entry FROM "
69 (caddr src-desc) " src, "
70 (caddr dst-desc) " dst WHERE src.common=dst.common \
71 AND dst.part_of_speech=src.part_of_speech AND src.entry "
72 key-expr " ORDER BY 1"))
73 (string-append
74 "SELECT dst.part_of_speech, dst.entry, src.entry FROM "
75 (caddr src-desc) " src, "
76 (caddr src-desc) "_key k,"
77 (caddr dst-desc) " dst WHERE src.common=dst.common AND \
78 k.serial=src.serial AND k.entry = \"" key "\"")))
79
80 ;;; Display
81
82 (define out-method-list
83 (list
84 (cons 'html (list
85 ;; Begin
86 (lambda ()
87 (display "<table>"))
88 ;; End
89 (lambda ()
90 (display "</table>"))
91 ;; print-header
92 (lambda (word pos)
93 (display "<tr><td>")
94 (display "<b>")
95 (display word)
96 (display "</b>, <i>")
97 (display pos)
98 (display "</i></td></tr>"))
99 ;; print-trans
100 (lambda (n trans)
101 (display "<tr><td></td><td>")
102 (display trans)
103 (display "</td></tr>"))))
104 (cons 'html (list
105 ;; Begin
106 (lambda () #f)
107 ;; End
108 newline
109 ;; print-header
110 (lambda (word pos)
111 (display word)
112 (display ", <")
113 (display pos)
114 (display ">")
115 (newline))
116 ;; print-trans
117 (lambda (n trans)
118 (display n)
119 (display ". ")
120 (display trans)
121 (display ";\n"))))))
122
123 (defmacro out-get-function (x n)
124 `(list-ref ,x ,n))
125
126 (defmacro out-begin-output (x)
127 `(out-get-function ,x 0))
128
129 (defmacro out-end-output (x)
130 `(out-get-function ,x 1))
131
132 (defmacro out-print-header (x)
133 `(out-get-function ,x 2))
134
135 (defmacro out-print-trans (x)
136 `(out-get-function ,x 3))
137
138
139 ;; Result format is:
140 ;; (POS SRC DST)
141
142 (define-public (dictdb:display-forward-result res method)
143 (let ((key "")
144 (value "")
145 (num 0)
146 (out (cdr (assoc method out-method-list))))
147 ((out-begin-output out))
148 (for-each
149 (lambda (x)
150 (let ((k (string-append (car x) (cadr x))))
151 (if (not (string=? key k))
152 (begin
153 (set! key k)
154 (set! num 0)
155 (set! value "")
156 ((out-print-header out) (list-ref x 1) (car x))))
157 (if (not (string=? value (list-ref x 2)))
158 (begin
159 ;; Print translation
160 (set! value (list-ref x 2))
161 (set! num (1+ num))
162 ((out-print-trans out) num value)))))
163 res)
164 ((out-end-output out))))

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