aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika
diff options
context:
space:
mode:
Diffstat (limited to 'src/ellinika')
-rw-r--r--src/ellinika/dico.scm66
1 files changed, 59 insertions, 7 deletions
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
@@ -223,4 +223,53 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
-(define (match-basic-regex dbh strat word)
- #f) ;FIXME
+;; Implementation of a Common LISP mapcan function
+(define (mapcan fun list)
+ (apply (lambda ( . slist)
+ (let loop ((elt '())
+ (slist slist))
+ (cond
+ ((null? slist)
+ (reverse elt))
+ ((not (car slist))
+ (loop elt (cdr slist)))
+ (else
+ (loop (cons (car slist) elt) (cdr slist))))))
+ (map fun list)))
+
+;; Convert SLIST, which is a list of strings, into a string of
+;; comma-separated values.
+(define (list->csv slist)
+ (apply string-append
+ (let loop ((elt '())
+ (slist slist))
+ (cond
+ ((null? (cdr slist))
+ (reverse
+ (cons "\"" (cons (car slist) (cons "\"" elt)))))
+ (else
+ (loop (cons "\"," (cons (car slist) (cons "\"" elt)))
+ (cdr slist)))))))
+
+(define (match-selector dbh strat key)
+ (let* ((sound (ellinika:sounds-like key))
+ (dlist (mapcan
+ (lambda (elt)
+ (let ((word (car elt)))
+ (and (dico-strat-select? strat word sound)
+ word)))
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.sound FROM dict,articles "
+ "WHERE dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh)
+ "' ORDER BY 1")))))
+ (if (not (null? dlist))
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict "
+ "WHERE dict.sound IN ("
+ (list->csv dlist)
+ ")"))
+ #f)))
@@ -240,4 +289,3 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(cons "suffix" match-suffix)
- (cons "re" match-extnd-regex)
- (cons "regexp" match-basic-regex)))
+ (cons "re" match-extnd-regex)))
@@ -245,5 +293,9 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(let ((sp (assoc (dico-strat-name strat) strategy-list)))
- (let ((res (if sp
- ((cdr sp) dbh strat word)
- (match-default dbh strat word))))
+ (let ((res (cond
+ (sp
+ ((cdr sp) dbh strat word))
+ ((dico-strat-selector? strat)
+ (match-selector dbh strat word))
+ (else
+ (match-default dbh strat word)))))
(if res

Return to:

Send suggestions and report system problems to the System administrator.