aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--src/ellinika/dico.scm66
2 files changed, 66 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index ee82c7e..dc20799 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
12008-06-22 Sergey Poznyakoff <gray@gnu.org.ua> 12008-06-22 Sergey Poznyakoff <gray@gnu.org.ua>
2 2
3 Implement levenshtein, basic regex, and general-purpose selector
4 matches.
5
6 * src/ellinika/dico.scm: Implement matching using strategy selectors.
7
8 Rearrange the directory structure.
9
3 * src: New dir 10 * src: New dir
4 * src/Makefile.am: New file. 11 * src/Makefile.am: New file.
5 * cgi-bin, ellinika: Move to src. 12 * cgi-bin, ellinika: Move to src.
diff --git a/src/ellinika/dico.scm b/src/ellinika/dico.scm
index 9383d1f..c156862 100644
--- a/src/ellinika/dico.scm
+++ b/src/ellinika/dico.scm
@@ -221,8 +221,57 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
221 "\" AND dict.ident=articles.ident " 221 "\" AND dict.ident=articles.ident "
222 "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1"))) 222 "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
223 223
224(define (match-basic-regex dbh strat word) 224;; Implementation of a Common LISP mapcan function
225 #f) ;FIXME 225(define (mapcan fun list)
226 (apply (lambda ( . slist)
227 (let loop ((elt '())
228 (slist slist))
229 (cond
230 ((null? slist)
231 (reverse elt))
232 ((not (car slist))
233 (loop elt (cdr slist)))
234 (else
235 (loop (cons (car slist) elt) (cdr slist))))))
236 (map fun list)))
237
238;; Convert SLIST, which is a list of strings, into a string of
239;; comma-separated values.
240(define (list->csv slist)
241 (apply string-append
242 (let loop ((elt '())
243 (slist slist))
244 (cond
245 ((null? (cdr slist))
246 (reverse
247 (cons "\"" (cons (car slist) (cons "\"" elt)))))
248 (else
249 (loop (cons "\"," (cons (car slist) (cons "\"" elt)))
250 (cdr slist)))))))
251
252(define (match-selector dbh strat key)
253 (let* ((sound (ellinika:sounds-like key))
254 (dlist (mapcan
255 (lambda (elt)
256 (let ((word (car elt)))
257 (and (dico-strat-select? strat word sound)
258 word)))
259 (my-sql-query
260 (dbh:conn dbh)
261 (string-append
262 "SELECT DISTINCT dict.sound FROM dict,articles "
263 "WHERE dict.ident=articles.ident "
264 "AND articles.lang='" (dbh:lang dbh)
265 "' ORDER BY 1")))))
266 (if (not (null? dlist))
267 (my-sql-query
268 (dbh:conn dbh)
269 (string-append
270 "SELECT DISTINCT dict.word FROM dict "
271 "WHERE dict.sound IN ("
272 (list->csv dlist)
273 ")"))
274 #f)))
226 275
227(define (match-default dbh strat word) 276(define (match-default dbh strat word)
228 (my-sql-query 277 (my-sql-query
@@ -238,14 +287,17 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
238 (list (cons "exact" match-exact) 287 (list (cons "exact" match-exact)
239 (cons "prefix" match-prefix) 288 (cons "prefix" match-prefix)
240 (cons "suffix" match-suffix) 289 (cons "suffix" match-suffix)
241 (cons "re" match-extnd-regex) 290 (cons "re" match-extnd-regex)))
242 (cons "regexp" match-basic-regex)))
243 291
244(define (match-word dbh strat word) 292(define (match-word dbh strat word)
245 (let ((sp (assoc (dico-strat-name strat) strategy-list))) 293 (let ((sp (assoc (dico-strat-name strat) strategy-list)))
246 (let ((res (if sp 294 (let ((res (cond
247 ((cdr sp) dbh strat word) 295 (sp
248 (match-default dbh strat word)))) 296 ((cdr sp) dbh strat word))
297 ((dico-strat-selector? strat)
298 (match-selector dbh strat word))
299 (else
300 (match-default dbh strat word)))))
249 (if res 301 (if res
250 (cons #f (map car res)) 302 (cons #f (map car res))
251 #f)))) 303 #f))))

Return to:

Send suggestions and report system problems to the System administrator.