aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--scm/freedict.scm847
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