aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2008-06-14 19:47:58 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2008-06-14 19:47:58 +0000
commit4d3f608787f13ece934890bd9341c9a24d563f85 (patch)
tree179323b6d6e7a76c83d733c80d7c6f9fb24e5765
parentaa16df5101636cc3d64da716c824d65559b3615d (diff)
downloadellinika-4d3f608787f13ece934890bd9341c9a24d563f85.tar.gz
ellinika-4d3f608787f13ece934890bd9341c9a24d563f85.tar.bz2
* cgi-bin/dico-ellinika.scm4 (output): Initial support for antonym
and synonym (xref) dictionaries. (close-module, descr, info, define-word, match-word): Remove name argument to synchronize with 7ac6330 of Dico. git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@514 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rw-r--r--ChangeLog7
-rw-r--r--cgi-bin/dico-ellinika.scm4246
2 files changed, 163 insertions, 90 deletions
diff --git a/ChangeLog b/ChangeLog
index fa7665a..ac1aef0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-06-14 Sergey Poznyakoff <gray@gnu.org.ua>
+
+ * cgi-bin/dico-ellinika.scm4 (output): Initial support for antonym
+ and synonym (xref) dictionaries.
+ (close-module, descr, info, define-word, match-word): Remove name
+ argument to synchronize with 7ac6330 of Dico.
+
2008-06-01 Sergey Poznyakoff <gray@gnu.org.ua>
* cgi-bin/dico-ellinika.scm4 (target-language): Remove global.
diff --git a/cgi-bin/dico-ellinika.scm4 b/cgi-bin/dico-ellinika.scm4
index 9bb92e4..763cee1 100644
--- a/cgi-bin/dico-ellinika.scm4
+++ b/cgi-bin/dico-ellinika.scm4
@@ -90,13 +90,23 @@
;; Dico interface
(define (open-module name . rest)
- (let ((target-language "el"))
+ (let ((target-language "el")
+ (type 'dict))
(for-each (lambda (arg)
(let ((av (string-split arg #\=)))
(case (length av)
- ((2) (if (string=? (car av) "lang")
- (set! target-language (cadr av))
- (dico-error "Unknown option " (car av))))
+ ((1) (cond
+ ((string=? (car av) "synonym")
+ (set! type 'synonim))
+ ((string=? (car av) "antonym")
+ (set! type 'antonym))
+ (else
+ (dico-error "Unknown option " (car av)))))
+ ((2) (cond
+ ((string=? (car av) "lang")
+ (set! target-language (cadr av)))
+ (else
+ (dico-error "Unknown option " (car av)))))
(else
(dico-error "Unknown option " (car av))))))
(cdr rest))
@@ -104,12 +114,13 @@
sql-iface sql-host sql-port sql-database
sql-username sql-password)))
(sql-query db-connection "SET NAMES utf8")
- (cons db-connection target-language))))
+ (list db-connection target-language type))))
-(defmacro dbh:conn (dbh) `(car ,dbh))
-(defmacro dbh:lang (dbh) `(cdr ,dbh))
+(defmacro dbh:conn (dbh) `(list-ref ,dbh 0))
+(defmacro dbh:lang (dbh) `(list-ref ,dbh 1))
+(defmacro dbh:type (dbh) `(list-ref ,dbh 2))
-(define (close-module name dbh)
+(define (close-module dbh)
(sql-connect-close (dbh:conn dbh)))
(define descr-list
@@ -117,13 +128,19 @@
("uk" . "Грецько-украЇнський словник")
("ru" . "Греческо-русский словарь")))
-(define (descr name dbh)
- (let ((res (assoc (dbh:lang dbh) descr-list)))
- (if res
- (cdr res)
- "Ellinika (no description available)")))
-
-(define (info name dbh)
+(define (descr dbh)
+ (case (dbh:type dbh)
+ ((dict)
+ (let ((res (assoc (dbh:lang dbh) descr-list)))
+ (if res
+ (cdr res)
+ "Ellinika (no description available)")))
+ ((antonym)
+ "Λέξικο αντωνύμων της Ελληνικής γλώσσας")
+ ((synonym)
+ "a")))
+
+(define (info dbh)
(string-append "Ellinika - A greek dictionary.\n\
See http://ellinika.gnu.org.ua/cgi-bin/dict.cgi?LANG="
(dbh:lang dbh) "\n\
@@ -134,74 +151,110 @@ under the terms of the GNU Free Documentation License, Version 1.2 or\n\
any later version published by the Free Software Foundation; with no\n\
Invariant Sections, no Front-Cover and Back-Cover Texts"))
-(define (define-word name dbh word)
- (let ((key (ellinika:translate-input word)))
- (let ((result '())
- (last-id -1)
- (word '())
- (articles '()))
- (for-each
- (lambda (tuple)
- (cond
- ((not (= last-id (string->number (car tuple))))
- (if (not (null? articles))
- (set! result (cons
- (cons word (reverse articles))
- result)))
- (set! last-id (string->number (car tuple)))
- (set! word (cons (list-ref tuple 1)
- (list-ref tuple 2))); FIXME: forms?
- (set! articles '())))
- (set! articles (cons
- (cons (list-ref tuple 4)
- (list-ref tuple 5))
- articles)))
- (my-sql-query
- (dbh:conn dbh)
- (string-append
- "SELECT dict.ident,dict.word,pos.abbr,dict.forms,articles.subindex,articles.meaning "
- "FROM dict,articles,pos WHERE dict.word=\""
- key
- "\" AND dict.ident=articles.ident "
- "AND articles.lang='" (dbh:lang dbh) "' "
- "AND dict.pos=pos.id AND pos.canonical='Y' ORDER BY dict.ident, articles.subindex")))
- (if (not (null? articles))
- (set! result (cons
- (cons word (reverse articles))
- result)))
- (cons #t (reverse result)))))
+(define (define-word-dict dbh key)
+ (let ((result '())
+ (last-id -1)
+ (word '())
+ (articles '()))
+ (for-each
+ (lambda (tuple)
+ (cond
+ ((not (= last-id (string->number (car tuple))))
+ (if (not (null? articles))
+ (set! result (cons
+ (cons word (reverse articles))
+ result)))
+ (set! last-id (string->number (car tuple)))
+ (set! word (cons (list-ref tuple 1)
+ (list-ref tuple 2))); FIXME: forms?
+ (set! articles '())))
+ (set! articles (cons
+ (cons (list-ref tuple 4)
+ (list-ref tuple 5))
+ articles)))
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT dict.ident,dict.word,pos.abbr,dict.forms,articles.subindex,articles.meaning "
+ "FROM dict,articles,pos WHERE dict.word=\""
+ key
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' "
+ "AND dict.pos=pos.id AND pos.canonical='Y' ORDER BY dict.ident, articles.subindex")))
+ (if (not (null? articles))
+ (set! result (cons
+ (cons word (reverse articles))
+ result)))
+ (cons 'define-word-dict (reverse result))))
+
+(define (define-word-x dbh word link-type)
+ (let ((res (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict,links,articles "
+ "WHERE links.type='" link-type "' AND links.ident IN "
+ "(SELECT ident FROM dict WHERE word=\"" word "\") "
+ "AND dict.ident=links.xref "
+ "AND dict.ident=articles.ident and articles.lang=\""
+ (dbh:lang dbh)
+ "\" ORDER BY word"))))
+ (if (and res (not (null? res)))
+ (cons 'define-word-x (list (cons word (map car res))))
+ #f)))
+
+(define (define-word-antonym dbh word)
+ (define-word-x dbh word "XREF"))
+
+(define (define-word-synonym dbh word)
+ (define-word-x dbh word "ANT"))
+
+(define define-list
+ (list (cons 'dict define-word-dict)
+ (cons 'synonym define-word-synonym)
+ (cons 'antonym define-word-antonym)))
+
+(define (define-word dbh word)
+ (let ((key (ellinika:translate-input word))
+ (x (assoc (dbh:type dbh) define-list)))
+ (if x
+ ((cdr x) dbh key)
+ #f)))
(define (match-exact dbh strat word)
(my-sql-query
(dbh:conn dbh)
- (string-append "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word=\""
- (ellinika:translate-input word)
- "\" AND dict.ident=articles.ident "
- "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word=\""
+ (ellinika:translate-input word)
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
(define (match-prefix dbh strat word)
(my-sql-query
(dbh:conn dbh)
- (string-append "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word LIKE \""
- (ellinika:translate-input word)
- "%\" AND dict.ident=articles.ident "
- "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word LIKE \""
+ (ellinika:translate-input word)
+ "%\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
(define (match-suffix dbh strat word)
(my-sql-query
(dbh:conn dbh)
- (string-append "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word LIKE \"%"
- (ellinika:translate-input word)
- "\" AND dict.ident=articles.ident "
- "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word LIKE \"%"
+ (ellinika:translate-input word)
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
(define (match-extnd-regex dbh strat word)
(my-sql-query
(dbh:conn dbh)
- (string-append "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word regexp \""
- (ellinika:translate-input word)
- "\" AND dict.ident=articles.ident "
- "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word regexp \""
+ (ellinika:translate-input word)
+ "\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
(define (match-basic-regex dbh strat word)
#f) ;FIXME
@@ -209,10 +262,11 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(define (match-default dbh strat word)
(my-sql-query
(dbh:conn dbh)
- (string-append "SELECT DISTINCT dict.word FROM dict,articles WHERE dict.sound LIKE \""
- (ellinika:sounds-like word)
- "%\" AND dict.ident=articles.ident "
- "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict,articles WHERE dict.sound LIKE \""
+ (ellinika:sounds-like word)
+ "%\" AND dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
(define strategy-list
@@ -222,7 +276,7 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(cons "re" match-extnd-regex)
(cons "regexp" match-basic-regex)))
-(define (match-word name dbh strat word)
+(define (match-word dbh strat word)
(let ((sp (assoc (dico-strat-name strat) strategy-list)))
(let ((res (if sp
((cdr sp) dbh strat word)
@@ -234,24 +288,36 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(define (output res n)
(let ((type (car res))
(contents (list-ref (cdr res) n)))
- (cond
- (type
- (let ((word-pair (car contents))
- (defn (cdr contents)))
- (display (car word-pair))
- (display ", <")
- (display (cdr word-pair))
- (display ">")
- (for-each
- (lambda (article)
- (newline)
- (display (1+ (string->number (car article))))
- (display ". ")
- (display (cdr article))
- (display ";"))
- defn)))
- (else
- (display contents)))))
+ (case type
+ ((define-word-dict)
+ (let ((word-pair (car contents))
+ (defn (cdr contents)))
+ (display (car word-pair))
+ (display ", <")
+ (display (cdr word-pair))
+ (display ">")
+ (for-each
+ (lambda (article)
+ (newline)
+ (display (1+ (string->number (car article))))
+ (display ". ")
+ (display (cdr article))
+ (display ";"))
+ defn)))
+ ((define-word-x)
+ (let ((word (car contents))
+ (defn (cdr contents)))
+ (display word)
+ (display " -- ")
+ (display (car defn))
+ (if (cdr defn)
+ (for-each
+ (lambda (elt)
+ (display ", ")
+ (display elt))
+ (cdr defn)))))
+ (else
+ (display contents)))))
(define (result-count res)
(length (cdr res)))

Return to:

Send suggestions and report system problems to the System administrator.