diff options
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | cgi-bin/dico-ellinika.scm4 | 246 |
2 files changed, 163 insertions, 90 deletions
@@ -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))) |