diff options
-rw-r--r-- | scm/freedict.scm | 847 |
1 files changed, 847 insertions, 0 deletions
diff --git a/scm/freedict.scm b/scm/freedict.scm new file mode 100644 index 0000000..f931299 --- /dev/null +++ b/scm/freedict.scm | |||
@@ -0,0 +1,847 @@ | |||
1 | #! =GUILE_BINDIR=/guile -s | ||
2 | =AUTOGENERATED= | ||
3 | !# | ||
4 | ;;;; This file is part of Ellinika | ||
5 | ;;;; Copyright (C) 2004, 2005, 2007, 2010, 2015 Sergey Poznyakoff | ||
6 | ;;;; | ||
7 | ;;;; Ellinika 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 3 of the License, or | ||
10 | ;;;; (at your option) any later version. | ||
11 | ;;;; | ||
12 | ;;;; Ellinika 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, see <http://www.gnu.org/licenses/>. | ||
19 | ;;;; | ||
20 | |||
21 | ;;;; Dictionary structure | ||
22 | ;;;; Internal representation: | ||
23 | ;;;; | ||
24 | ;;;; * Each dictionary entry is represented as a vector: | ||
25 | ;;;; | ||
26 | ;;;; #(KEY FORMS XREF P-LIST LOC) | ||
27 | ;;;; | ||
28 | ;;;; KEY is list of strings | ||
29 | ;;;; | ||
30 | ;;;; * FORMS is either #f or a string describing forms of the key if they | ||
31 | ;;;; are formed in an irregular manner. | ||
32 | ;;;; | ||
33 | ;;;; * XREF is a list of cross-references | ||
34 | ;;;; | ||
35 | ;;;; * P-LIST is a list of P-ARTICLES. Each P-ARTICLE is a vector: | ||
36 | ;;;; | ||
37 | ;;;; #(POS ARTICLE AREF XREF TOPIC) | ||
38 | ;;;; | ||
39 | ;;;; Member Type Meaning | ||
40 | ;;;; POS string part of speech | ||
41 | ;;;; ARTICLE list(string) Dictionary article associated with this key/pos | ||
42 | ;;;; AREF list(string) List of antonyms | ||
43 | ;;;; XREF list(string) List of cross-references | ||
44 | ;;;; TOPIC list(string) List of topics this item pertains to | ||
45 | ;;;; | ||
46 | ;;;; * LOC is source location where the entry was defined (cons FILE LINE). | ||
47 | ;;;; | ||
48 | ;;;; External representation (XML): | ||
49 | ;;;; | ||
50 | ;;;; <NODE> | ||
51 | ;;;; <K>string</K>+ | ||
52 | ;;;; [<F>string</F>] | ||
53 | ;;;; <P ID="string"> | ||
54 | ;;;; <M>string</M>+ | ||
55 | ;;;; <A>string</A>* | ||
56 | ;;;; <X>string</X>* | ||
57 | ;;;; <T ID="string" />* | ||
58 | ;;;; </P>+ | ||
59 | ;;;; <X>string</X>* | ||
60 | ;;;; </NODE> | ||
61 | ;;;; | ||
62 | ;;;; If only one P entry is present, the following alternative forms | ||
63 | ;;;; are understood: | ||
64 | ;;;; | ||
65 | ;;;; <NODE> | ||
66 | ;;;; <K>string</K>+ | ||
67 | ;;;; [<F>string</F>] | ||
68 | ;;;; <P>string</P> | ||
69 | ;;;; <M>string</M>* | ||
70 | ;;;; <A>string</A>* | ||
71 | ;;;; <X>string</X>* | ||
72 | ;;;; <T ID="string" />* | ||
73 | ;;;; </NODE> | ||
74 | ;;;; | ||
75 | ;;;; or | ||
76 | ;;;; | ||
77 | ;;;; <NODE> | ||
78 | ;;;; <K>string</K>+ | ||
79 | ;;;; [<F>string</F>] | ||
80 | ;;;; <P>string</P> | ||
81 | ;;;; <X>string</X>* | ||
82 | ;;;; <T ID="string" />* | ||
83 | ;;;; </NODE> | ||
84 | |||
85 | ;;; Tailor this statement to your needs if necessary. | ||
86 | ;=GUILE_COMMENT=;(set! %load-path (cons "=GUILE_SITE=" %load-path)) | ||
87 | (set! %load-path (cons "/home/gray/linguae/ellinika/" %load-path)) | ||
88 | (use-modules (xmltools xmltrans) | ||
89 | (gamma sql) | ||
90 | (ellinika xlat) | ||
91 | (ellinika elmorph) | ||
92 | (ice-9 getopt-long) | ||
93 | (ice-9 regex)) | ||
94 | |||
95 | (setlocale LC_ALL "") | ||
96 | |||
97 | (define compile-only #f) | ||
98 | (define cleanup-option #f) | ||
99 | (define preserve-option #f) | ||
100 | |||
101 | (define ellinika-sql-connection '()) | ||
102 | (define verbose-option #f) | ||
103 | (define debug-level 0) | ||
104 | (define input-files '()) | ||
105 | |||
106 | (define sysconf-dir "=SYSCONFDIR=") | ||
107 | (define config-file-name "ellinika.conf") | ||
108 | |||
109 | (define dict-cgi-path #f) | ||
110 | |||
111 | ;;; Load the site defaults | ||
112 | (let ((rc-file (string-append sysconf-dir "/" config-file-name))) | ||
113 | (if (file-exists? rc-file) | ||
114 | (load rc-file))) | ||
115 | |||
116 | (define (debug level . rest) | ||
117 | (if (>= debug-level level) | ||
118 | (begin | ||
119 | (for-each | ||
120 | (lambda (x) | ||
121 | (display x)) | ||
122 | rest) | ||
123 | (newline)))) | ||
124 | |||
125 | (define (add-conn-param key val) | ||
126 | (set! ellinika-sql-connection (cons (cons key val) ellinika-sql-connection))) | ||
127 | |||
128 | |||
129 | (define pos-xlat #f) | ||
130 | |||
131 | ;FIXME | ||
132 | (define (convert-pos pos) pos) | ||
133 | |||
134 | ;FIXME | ||
135 | (define (read-pos conn) | ||
136 | #t) | ||
137 | |||
138 | ;;;; XML definitions | ||
139 | |||
140 | ;;; Set the default handler | ||
141 | (define tag-list '()) | ||
142 | |||
143 | (define (lingua:default-start tag attr) | ||
144 | (xmltrans:set-attr #f "__START__" 1) | ||
145 | #f) | ||
146 | |||
147 | (xmltrans:set-default-start-handler lingua:default-start) | ||
148 | |||
149 | (define (lingua:default-end tag attr text) | ||
150 | (if (xmltrans:attr attr "__START__") | ||
151 | (xmltrans:parse-error #f "Unhandled element " tag)) | ||
152 | (set! tag-list | ||
153 | (cons | ||
154 | (xmltrans:make-tag tag attr text) | ||
155 | tag-list)) | ||
156 | #f) | ||
157 | |||
158 | (xmltrans:set-default-end-handler lingua:default-end) | ||
159 | |||
160 | ;;; Themes class list | ||
161 | (define class-list '()) | ||
162 | |||
163 | ;;; Current node | ||
164 | (define current-node #f) | ||
165 | |||
166 | (define-syntax node-get | ||
167 | (syntax-rules () | ||
168 | ((node-get #:key node) | ||
169 | (vector-ref node 0)) | ||
170 | ((node-get #:forms node) | ||
171 | (vector-ref node 1)) | ||
172 | ((node-get #:xref node) | ||
173 | (vector-ref node 2)) | ||
174 | ((node-get #:p-list node) | ||
175 | (vector-ref node 3)) | ||
176 | ((node-get #:locus node) | ||
177 | (vector-ref node 4)))) | ||
178 | |||
179 | (define-macro (current-node-get key) | ||
180 | `(node-get ,key current-node)) | ||
181 | |||
182 | (define (mark-invalid) | ||
183 | (xmltrans:set-attr "NODE" "__INVALID__" 1)) | ||
184 | |||
185 | (define-syntax node-set | ||
186 | (syntax-rules () | ||
187 | ((node-set #:key node k) | ||
188 | (cond | ||
189 | ((node-get #:key node) => | ||
190 | (lambda (klist) | ||
191 | (vector-set! node 0 (append klist (list k))))) | ||
192 | (else | ||
193 | (vector-set! node 0 (list k))))) | ||
194 | ((node-set #:forms node f) | ||
195 | (begin | ||
196 | (cond | ||
197 | ((node-get #:forms node) | ||
198 | (xmltrans:parse-error #f "Forms already set") | ||
199 | (mark-invalid))) | ||
200 | (vector-set! node 1 f))) | ||
201 | ((node-set #:xref node x) | ||
202 | (vector-set! node 2 (append (node-get #:xref node) (list x)))) | ||
203 | ((node-set #:p-article node p) | ||
204 | (vector-set! node 3 (append (node-get #:p-list node) (list p)))) | ||
205 | ((node-set #:topic node t) | ||
206 | ;; FIXME: Scope of <T> is position-dependent relative to <P> | ||
207 | (let ((pl (node-get #:p-list node))) | ||
208 | (if (null? pl) | ||
209 | (current-article-set #:topic t) | ||
210 | (for-each | ||
211 | (lambda (p) | ||
212 | (p-article-set #:topic p t)) | ||
213 | pl)))) | ||
214 | ((node-set #:locus node loc) | ||
215 | (vector-set! node 4 loc)))) | ||
216 | |||
217 | |||
218 | (define-macro (current-node-set key val) | ||
219 | `(node-set ,key current-node ,val)) | ||
220 | |||
221 | (define p-article #f) | ||
222 | |||
223 | (define-syntax p-article-get | ||
224 | (syntax-rules () | ||
225 | ((p-article-get #:pos article) | ||
226 | (vector-ref article 0)) | ||
227 | ((p-article-get #:article article) | ||
228 | (vector-ref article 1)) | ||
229 | ((p-article-get #:aref article) | ||
230 | (vector-ref article 2)) | ||
231 | ((p-article-get #:xref article) | ||
232 | (vector-ref article 3)) | ||
233 | ((p-article-get #:topic article) | ||
234 | (vector-ref article 4)))) | ||
235 | |||
236 | (define-syntax p-set | ||
237 | (syntax-rules () | ||
238 | ((p-set key article n val) | ||
239 | (vector-set! article n | ||
240 | (cond | ||
241 | ((p-article-get key article) => | ||
242 | (lambda (alst) | ||
243 | (append alst (list val)))) | ||
244 | (else | ||
245 | (list val))))))) | ||
246 | |||
247 | (define-macro (current-article-get key) | ||
248 | `(p-article-get ,key p-article)) | ||
249 | |||
250 | (define-syntax p-article-set | ||