diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-10-08 18:51:46 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-10-08 18:51:46 +0000 |
commit | 7c6fc162fb2c9cba19025cb3237695288216e5c5 (patch) | |
tree | dc11b08785f5acb19dba16dbad7f5c2ce7e6f333 /scm/dictrans.scm | |
parent | 72d789af56bad636cfc1a8d6e55fee928118b22b (diff) | |
download | ellinika-7c6fc162fb2c9cba19025cb3237695288216e5c5.tar.gz ellinika-7c6fc162fb2c9cba19025cb3237695288216e5c5.tar.bz2 |
Mostly finished :^)
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@198 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'scm/dictrans.scm')
-rw-r--r-- | scm/dictrans.scm | 508 |
1 files changed, 339 insertions, 169 deletions
diff --git a/scm/dictrans.scm b/scm/dictrans.scm index 5cfc50e..ff99dea 100644 --- a/scm/dictrans.scm +++ b/scm/dictrans.scm | |||
@@ -80,8 +80,11 @@ | |||
80 | ;;;; </NODE> | 80 | ;;;; </NODE> |
81 | 81 | ||
82 | (set! %load-path (cons "/usr/local/share/guile-sql" %load-path)) | 82 | (set! %load-path (cons "/usr/local/share/guile-sql" %load-path)) |
83 | (set! %load-path (cons "/home/gray/linguae/ellinika" %load-path)) | ||
84 | |||
83 | (use-modules (xmltools xmltrans) | 85 | (use-modules (xmltools xmltrans) |
84 | (sql) | 86 | (sql) |
87 | (ellinika xlat) | ||
85 | (ice-9 getopt-long)) | 88 | (ice-9 getopt-long)) |
86 | 89 | ||
87 | (use-syntax (ice-9 syncase)) | 90 | (use-syntax (ice-9 syncase)) |
@@ -110,6 +113,31 @@ | |||
110 | (newline)))) | 113 | (newline)))) |
111 | 114 | ||
112 | 115 | ||
116 | (define pos-xlat #f) | ||
117 | |||
118 | (define (convert-pos pos) | ||
119 | (cond | ||
120 | (compile-only | ||
121 | pos) | ||
122 | ((assoc pos pos-xlat) => | ||
123 | (lambda (x) | ||
124 | (cdr x))) | ||
125 | (else | ||
126 | (xmltrans:parse-error #f "unknown or misspelled part of speech") | ||
127 | (mark-invalid) | ||
128 | pos))) | ||
129 | |||
130 | (define (read-pos conn) | ||
131 | (set! pos-xlat | ||
132 | (map | ||
133 | (lambda (p) | ||
134 | (cons (car p) (string->number (cadr p)))) | ||
135 | (append | ||
136 | (run-query conn "SELECT abbr, id FROM pos") | ||
137 | (run-query conn "SELECT abbr_lat, id FROM pos") | ||
138 | (run-query conn "SELECT name, id FROM pos"))))) | ||
139 | |||
140 | |||
113 | ;;;; XML definitions | 141 | ;;;; XML definitions |
114 | 142 | ||
115 | ;;; Set the default handler | 143 | ;;; Set the default handler |
@@ -137,93 +165,105 @@ | |||
137 | 165 | ||
138 | (define-syntax node-get | 166 | (define-syntax node-get |
139 | (syntax-rules () | 167 | (syntax-rules () |
140 | ((node-get #:key) | 168 | ((node-get #:key node) |
141 | (vector-ref current-node 0)) | 169 | (vector-ref node 0)) |
142 | ((node-get #:forms) | 170 | ((node-get #:forms node) |
143 | (vector-ref current-node 1)) | 171 | (vector-ref node 1)) |
144 | ((node-get #:xref) | 172 | ((node-get #:xref node) |
145 | (vector-ref current-node 2)) | 173 | (vector-ref node 2)) |
146 | ((node-get #:p-list) | 174 | ((node-get #:p-list node) |
147 | (vector-ref current-node 3)))) | 175 | (vector-ref node 3)))) |
176 | |||
177 | (define-macro (current-node-get key) | ||
178 | `(node-get ,key current-node)) | ||
148 | 179 | ||
149 | (define (mark-invalid) | 180 | (define (mark-invalid) |
150 | (xmltrans:set-attr "NODE" "__INVALID__" 1)) | 181 | (xmltrans:set-attr "NODE" "__INVALID__" 1)) |
151 | 182 | ||
152 | (define-syntax node-set | 183 | (define-syntax node-set |
153 | (syntax-rules () | 184 | (syntax-rules () |
154 | ((node-set #:key k) | 185 | ((node-set #:key node k) |
155 | (cond | 186 | (cond |
156 | ((node-get #:key) => | 187 | ((node-get #:key node) => |
157 | (lambda (klist) | 188 | (lambda (klist) |
158 | (vector-set! current-node 0 (append klist (list k))))) | 189 | (vector-set! node 0 (append klist (list k))))) |
159 | (else | 190 | (else |
160 | (vector-set! current-node 0 (list k))))) | 191 | (vector-set! node 0 (list k))))) |
161 | ((node-set #:forms f) | 192 | ((node-set #:forms node f) |
162 | (begin | 193 | (begin |
163 | (cond | 194 | (cond |
164 | ((node-get #:forms) | 195 | ((node-get #:forms node) |
165 | (xmltrans:parse-error #f "Forms already set") | 196 | (xmltrans:parse-error #f "Forms already set") |
166 | (mark-invalid))) | 197 | (mark-invalid))) |
167 | (vector-set! current-node 1 f))) | 198 | (vector-set! node 1 f))) |
168 | ((node-set #:xref x) | 199 | ((node-set #:xref node x) |
169 | (cond | 200 | (cond |
170 | ((node-get #:xref) => | 201 | ((node-get #:xref node) => |
171 | (lambda (xlist) | 202 | (lambda (xlist) |
172 | (vector-set! current-node 2 (append xlist (list x))))) | 203 | (vector-set! node 2 (append xlist (list x))))) |
173 | (else | 204 | (else |
174 | (vector-set! current-node 2 (list x))))) | 205 | (vector-set! node 2 (list x))))) |
175 | ((node-set! #:p-article p) | 206 | ((node-set #:p-article node p) |
176 | (cond | 207 | (cond |
177 | ((node-get #:p-list) => | 208 | ((node-get #:p-list node) => |
178 | (lambda (plist) | 209 | (lambda (plist) |
179 | (vector-set! current-node 3 (append plist (list p))))) | 210 | (vector-set! node 3 (append plist (list p))))) |
180 | (else | 211 | (else |
181 | (vector-set! current-node 3 (list p))))) | 212 | (vector-set! node 3 (list p))))) |
182 | ((node-set #:topic t) | 213 | ((node-set #:topic node t) |
183 | (for-each | 214 | (for-each |
184 | (lambda (p) | 215 | (lambda (p) |
185 | ;; FIXME: Use p-article-set | 216 | (p-article-set #:topic p t)) |
186 | (vector-set! p 4 (append (vector-ref p 4) (list t)))) | 217 | (node-get #:p-list node))))) |
187 | (node-get #:p-list))))) | 218 | |
219 | (define-macro (current-node-set key val) | ||
220 | `(node-set ,key current-node ,val)) | ||
221 | |||
188 | 222 | ||
189 | (define p-article #f) | 223 | (define p-article #f) |
190 | 224 | ||
191 | (define-syntax p-article-get | 225 | (define-syntax p-article-get |
192 | (syntax-rules () | 226 | (syntax-rules () |
193 | ((p-article-get #:pos) | 227 | ((p-article-get #:pos article) |
194 | (vector-ref p-article 0)) | 228 | (vector-ref article 0)) |
195 | ((p-article-get #:article) | 229 | ((p-article-get #:article article) |
196 | (vector-ref p-article 1)) | 230 | (vector-ref article 1)) |
197 | ((p-article-get #:aref) | 231 | ((p-article-get #:aref article) |
198 | (vector-ref p-article 2)) | 232 | (vector-ref article 2)) |
199 | ((p-article-get #:xref) | 233 | ((p-article-get #:xref article) |
200 | (vector-ref p-article 3)) | 234 | (vector-ref article 3)) |
201 | ((p-article-get #:topic) | 235 | ((p-article-get #:topic article) |
202 | (vector-ref p-article 4)))) | 236 | (vector-ref article 4)))) |
203 | 237 | ||
204 | (define-syntax p-set | 238 | (define-syntax p-set |
205 | (syntax-rules () | 239 | (syntax-rules () |
206 | ((p-set key n val) | 240 | ((p-set key article n val) |
207 | (vector-set! p-article n | 241 | (vector-set! article n |
208 | (cond | 242 | (cond |
209 | ((p-article-get key) => | 243 | ((p-article-get key article) => |
210 | (lambda (alst) | 244 | (lambda (alst) |
211 | (append alst (list val)))) | 245 | (append alst (list val)))) |
212 | (else | 246 | (else |
213 | (list val))))))) | 247 | (list val))))))) |
214 | 248 | ||
249 | (define-macro (current-article-get key) | ||
250 | `(p-article-get ,key p-article)) | ||
251 | |||
215 | (define-syntax p-article-set | 252 | (define-syntax p-article-set |
216 | (syntax-rules () | 253 | (syntax-rules () |
217 | ((p-article-set #:pos val) | 254 | ((p-article-set #:pos article val) |
218 | (vector-set! p-article 0 val)) | 255 | (vector-set! article 0 val)) |
219 | ((p-article-set #:article val) | 256 | ((p-article-set #:article article val) |
220 | (p-set #:article 1 val)) | 257 | (p-set #:article article 1 val)) |
221 | ((p-article-set #:aref val) | 258 | ((p-article-set #:aref article val) |
222 | (p-set #:aref 2 val)) | 259 | (p-set #:aref article 2 val)) |
223 | ((p-article-set #:xref val) | 260 | ((p-article-set #:xref article val) |
224 | (p-set #:xref 3 val)) | 261 | (p-set #:xref article 3 val)) |
225 | ((p-article-set #:topic val) | 262 | ((p-article-set #:topic article val) |
226 | (p-set #:topic 4 val)))) | 263 | (p-set #:topic article 4 val)))) |
264 | |||
265 | (define-macro (current-article-set key val) | ||
266 | `(p-article-set ,key p-article ,val)) | ||
227 | 267 | ||
228 | 268 | ||
229 | ;;; Node list | 269 | ;;; Node list |
@@ -251,7 +291,7 @@ | |||
251 | (debug 10 "APPEND") | 291 | (debug 10 "APPEND") |
252 | (for-each | 292 | (for-each |
253 | (lambda (x) | 293 | (lambda (x) |
254 | (p-article-set #:topic x)) | 294 | (current-article-set #:topic x)) |
255 | topic-list)) | 295 | topic-list)) |
256 | 296 | ||
257 | ;;; | 297 | ;;; |
@@ -299,17 +339,17 @@ | |||
299 | (tag attr text) | 339 | (tag attr text) |
300 | (cond | 340 | (cond |
301 | (p-article | 341 | (p-article |
302 | (if (not (null? (node-get #:p-list))) | 342 | (if (not (null? (current-node-get #:p-list))) |
303 | (xmltrans:parse-warning #f "Mixed definition style")) | 343 | (xmltrans:parse-warning #f "Mixed definition style")) |
304 | (append-topics) | 344 | (append-topics) |
305 | (node-set #:p-article p-article) | 345 | (current-node-set #:p-article p-article) |
306 | (set! p-article #f))) | 346 | (set! p-article #f))) |
307 | 347 | ||
308 | (cond | 348 | (cond |
309 | ((xm |