diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-02-13 14:21:02 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-02-13 14:21:02 +0000 |
commit | cf6bfb57a877b35ffae958c2baa11fc4bebd93e5 (patch) | |
tree | 93f0d7b92a513a4b02bb6111675235fa5a8301d4 | |
parent | eb7a03ba9271bf0956686e9e3ecad5b511b1d637 (diff) | |
download | ellinika-cf6bfb57a877b35ffae958c2baa11fc4bebd93e5.tar.gz ellinika-cf6bfb57a877b35ffae958c2baa11fc4bebd93e5.tar.bz2 |
Initial revision
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@2 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rw-r--r-- | .emacs.desktop | 247 | ||||
-rw-r--r-- | .emacsrc | 14 | ||||
-rwxr-xr-x | cgi-bin/dict.cgi | 658 | ||||
-rw-r--r-- | data/db.struct | 49 | ||||
-rw-r--r-- | data/dict.1 | 2160 | ||||
-rw-r--r-- | data/dict.2 | 158 | ||||
-rw-r--r-- | src/.gdbinit | 1 | ||||
-rw-r--r-- | src/Makefile | 20 | ||||
-rw-r--r-- | src/emit.c | 109 | ||||
-rw-r--r-- | src/gram.y | 181 | ||||
-rw-r--r-- | src/input.l | 54 | ||||
-rw-r--r-- | src/list.c | 317 | ||||
-rw-r--r-- | src/list.h | 48 | ||||
-rw-r--r-- | src/main.c | 270 | ||||
-rw-r--r-- | src/mem.h | 2 | ||||
-rw-r--r-- | src/sql.c | 107 | ||||
-rw-r--r-- | src/trans.h | 49 | ||||
-rw-r--r-- | src/xcript.c | 137 |
18 files changed, 4581 insertions, 0 deletions
diff --git a/.emacs.desktop b/.emacs.desktop new file mode 100644 index 0000000..837b5e8 --- /dev/null +++ b/.emacs.desktop @@ -0,0 +1,247 @@ +;; -*- coding: emacs-mule; -*- +;; -------------------------------------------------------------------------- +;; Desktop File for Emacs +;; -------------------------------------------------------------------------- +;; Created Thu Feb 12 22:42:39 2004 +;; Emacs version 21.3.2 + +;; Global section: +(setq desktop-missing-file-warning nil) +(setq tags-file-name nil) +(setq tags-table-list nil) +(setq search-ring '("XREF" "pos" "fuzz" "fuz" "list-re" ";" ";l" "no de" "not f" "" "Ԍ،" "FORMS" "ьތ" "eleu" "./tr" "dict")) +(setq regexp-search-ring nil) +(setq register-alist '((98 . "NODE \nPOS adv\nMEANING \nEND\n\n") (97 . "NODE \nPOS \nTOPIC \nMEANING \nEND\n"))) + +;; Buffer section: +(desktop-create-buffer 205 + "/usr/share/emacs/site-lisp/w3-forms.el" + "w3-forms.el" + 'emacs-lisp-mode + nil + 31624 + '(1713 t) + t + nil + nil) + +(desktop-create-buffer 205 + "/usr/share/emacs/site-lisp/mule-sysdp.el" + "mule-sysdp.el" + 'emacs-lisp-mode + nil + 2176 + '(1 t) + t + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/.emacsrc" + ".emacsrc" + 'emacs-lisp-mode + nil + 1 + '(237 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/emit.c" + "emit.c" + 'c-mode + '(abbrev-mode) + 2347 + '(41 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/cleanup" + "cleanup" + 'fundamental-mode + nil + 185 + '(169 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/gram.y" + "gram.y" + 'c-mode + '(abbrev-mode) + 1222 + '(622 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/list.c" + "list.c" + 'c-mode + '(abbrev-mode) + 4650 + '(nil nil) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/input.l" + "input.l" + 'c-mode + '(abbrev-mode) + 76 + '(86 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/usr/local/info/mysql.info" + "*info*" + 'Info-mode + nil + 1409952 + '(1 t) + t + '("/usr/local/info/mysql" "mysql_real_escape_string") + '((case-fold-search . t))) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/Makefile" + "Makefile" + 'makefile-mode + nil + 71 + '(nil nil) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/main.c" + "main.c" + 'c-mode + '(abbrev-mode) + 1013 + '(1207 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/cgi-bin/1" + "1" + 'fundamental-mode + nil + 481 + '(1 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/trans.h" + "trans.h" + 'c-mode + '(abbrev-mode) + 279 + '(253 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/src/xcript.c" + "xcript.c" + 'c-mode + '(overwrite-mode abbrev-mode) + 452 + '(69 t) + nil + nil + '((overwrite-mode . overwrite-mode-textual))) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/data/dict.2" + "dict.2" + 'fundamental-mode + nil + 3277 + '(3267 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/runasimi/cgi-bin/dict.cgi" + "dict.cgi<2>" + 'scheme-mode + '(nil) + 2022 + '(2324 t) + t + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/trans/el/a2ps-4.13b.el.po" + "a2ps-4.13b.el.po" + 'po-mode + nil + 1979 + '(4807 t) + t + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/trans/el/wget-1.9.1.el.po" + "wget-1.9.1.el.po" + 'po-mode + nil + 13801 + '(1669 t) + t + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/data/db.struct" + "db.struct" + 'fundamental-mode + nil + 601 + '(177 t) + nil + nil + nil) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/data/dict.1" + "dict.1" + 'fundamental-mode + nil + 9471 + '(12231 t) + nil + nil + '((overwrite-mode))) + +(desktop-create-buffer 205 + "/home/gray/linguae/ellinika/cgi-bin/dict.cgi" + "dict.cgi" + 'scheme-mode + '(nil) + 13753 + '(13738 t) + nil + nil + '((overwrite-mode))) + diff --git a/.emacsrc b/.emacsrc new file mode 100644 index 0000000..01ab4d9 --- /dev/null +++ b/.emacsrc @@ -0,0 +1,14 @@ +(defun greek-input (arg) + (interactive "p") + (set-input-method 'greek)) + +(defun russian-input (arg) + (interactive "p") + (set-input-method 'cyrillic-yawerty)) + + +(set-language-environment 'utf-8) + +(global-set-key "\M-g" 'greek-input) +(global-set-key "\M-r" 'russian-input) +(setq w3-default-homepage "http://localhost/cgi-bin/dict.cgi")
\ No newline at end of file diff --git a/cgi-bin/dict.cgi b/cgi-bin/dict.cgi new file mode 100755 index 0000000..6d7457e --- /dev/null +++ b/cgi-bin/dict.cgi @@ -0,0 +1,658 @@ +#!/usr/local/bin/guile -s +!# +;;;; Greek Dictionary Web Engine +;;;; Copyright (C) 2004 Sergey Poznyakoff +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +;;;; + +(set! %load-path (append %load-path (list "/usr/local/share/guile-sql"))) +(use-modules (www cgi)) +(use-modules (sql)) +(cgi:init) + +;;; User-definable variables +(define dict-cgi-path "/cgi-bin/dict.cgi") +(define sql-iface "mysql") +(define sql-host "localhost") +(define sql-port 3306) +(define sql-database "ellinika") +(define sql-username "gray") +(define sql-password "Imbabura") +;;; End of user-definable variables + +;; Τα μέρη του λογου +(define part-of-speech + (list (cons "κανένα μέρος του λογου" #f) + (cons "ρήμα" "(dict.pos=\"μετ.\" OR dict.pos=\"αμετ.\" OR dict.pos=\"μετ.,αμετ.\")") + (cons "μεταβατικό" "dict.pos=\"μετ.\"") + (cons "αμετάβατο" "dict.pos=\"αμετ.\"") + (cons "άρθρο" "dict.pos=\"άρθρο\"") + (cons "αριθμός" "dict.pos=\"αριθ.\"") + (cons "επίθετο" "dict.pos=\"επίθ.\"") + (cons "επίρρημα" "dict.pos=\"επίρρ.\"") + (cons "επιφώνημα" "dict.pos=\"επιφ.\"") + (cons "μετοχή" "dict.pos=\"μετοχή\"") + (cons "πρόθεση" "dict.pos=\"πρόθ.\"") + (cons "σύνδεσμος" "dict.pos=\"σύνδ.\"") + (cons "ουσιαστικό" "(dict.pos=\"ο\" OR dict.pos=\"η\" OR dict.pos=\"το\")"))) + +;; Protect occurences of " in a string. +;; Usual backslash escapes do not work in INPUT widgets, so I +;; change all quotation marks to " +;; Possibly not the better solution, though... +(define (protect string) + (list->string + (apply append + (map + (lambda (x) + (if (eq? x #\") + (list #\& #\# #\3 #\4 #\;) + (list x))) + (string->list string))))) + +(define (get-topic-list) + (let ((conn (sql-connect sql-iface sql-host sql-port sql-database + sql-username sql-password))) + (cond + (conn + (let ((result (sql-query conn "SELECT ident,title FROM topic"))) + (sql-connect-close conn) + result)) + (else + #f)))) + + +(define (dict-html-start) + (display "Content-type: text/html; charset=utf-8\r\n\r\n") + (display " +<HTML> +<HEAD> + <TITLE>Ellinika</TITLE> + <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\"> +</HEAD> +<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\" LINK=\"#1F00FF\" ALINK=\"#FF0000\" VLINK=\"#9900DD\"> +<H2>Ελληνορώσικο λέξικο</H2> +<hr>")) + +(define (dict-html-end) + (display "</BODY></HTML>")) + +(define (main-form) + (display "<FORM ACTION=\"") + (display dict-cgi-path) + (display "\" METHOD=POST> +<TABLE> +<TR> + <TD> + <INPUT size=64 NAME=\"key\" TABINDEX=\"1\"") + (let ((value (cgi:value "key"))) + (if value + (begin + (display (string-append "GOT VALUE " value "\n") + (current-error-port)) + (display "VALUE=\"") + (display (protect value)) + (display "\"")))) + (display "> + </TD> + <TD> + <INPUT TYPE=\"submit\" NAME=\"search\" VALUE=\"Αναζήτηση\" TABINDEX=\"4\"> + </TD> +</TR> +<TR> + <TD>") + + (display "Διαλέξτε το μέρος του λόγου</TD><TD>") + + (let ((selected-choice (or (let ((s (cgi:value "POS"))) + (if s + (string->number s) + #f)) + 0)) + (index 0)) + + (display "<SELECT NAME=\"POS\" TABINDEX=\"2\">") + + (for-each + (lambda (x) + (let ((name (car x))) + (display "<OPTION VALUE=") + (display index) + (if (= index selected-choice) + (display " selected")) + (display ">") + (display name) + (set! index (1+ index)))) + part-of-speech) + (display "</SELECT>")) + + (display " + </TD> +</TR> +<TR> + <TD>") + + (display "Διαλέξτε η θέμα</TD><TD>") + (let ((topic-list (get-topic-list))) + (if topic-list + (let ((selected-choice (or (let ((s (cgi:value "TOPIC"))) + (if s + (string->number s) + #f)) + 0))) + (display "<SELECT NAME=\"TOPIC\" TABINDEX=\"3\">") + (display "<OPTION VALUE=0>καμία θέμα") + (for-each + (lambda (x) + (let ((id (car x)) + (name (car (cdr x)))) + (display "<OPTION VALUE=") + (display id) + (if (eq? (string->number id) selected-choice) + (display " selected")) + (display ">") + (display name))) + topic-list) + (display "</SELECT>")))) + + (display " + </TD> +</TR> +</TABLE> +<P>")) + + +(define greek-postfix-map + (list + (cons #\: (list (cons "ι" "ϊ") (cons "υ" "ϋ") + (cons "ί" "ΐ") (cons "ύ" "ΰ") + (cons "θ" "ϊ") (cons "θ" "ϋ"))) + (cons #\' (list (cons "α" "ά") (cons "Α" "Ά") + (cons "ε" "έ") (cons "Ε" "Έ") + (cons "η" "ή") (cons "Η" "Ή") + (cons "ι" "ί") (cons "Ι" "Ί") + (cons "ϊ" "ΐ") (cons "Ϊ" "Ϊ") + (cons "ο" "ό") (cons "Ο" "Ό") + (cons "υ" "ύ") (cons "Υ" "Ύ") + (cons "θ" "ύ") (cons "Θ" "Ύ") + (cons "ϋ" "ΰ") (cons "Ϋ" "Ϋ") + (cons "ω" "ώ") (cons "Ω" "Ώ"))) + (cons #\s (list (cons "κ" "ξ") (cons "π" "ψ"))))) + +(define greek-kbd-map + (list (cons #\a "α") + (cons #\A "Α") + (cons #\b "β") + (cons #\B "Β") + (cons #\g "γ") + (cons #\G "Γ") + (cons #\d "δ") + (cons #\D "Δ") + (cons #\e "ε") + (cons #\E "Ε") + (cons #\z "ζ") + (cons #\Z "Ζ") + (cons #\h "η") + (cons #\H "Η") + (cons #\u "θ") + (cons #\U "Θ") + (cons #\i "ι") + (cons #\I "Ι") + (cons #\k "κ") + (cons #\K "Κ") + (cons #\l "λ") + (cons #\L "Λ") + (cons #\m "μ") + (cons #\M "Μ") + (cons #\n "ν") + (cons #\M "Ν") + (cons #\j "ξ") + (cons #\J "Ξ") + (cons #\o "ο") + (cons #\O "Ο") + (cons #\p "π") + (cons #\P "Π") + (cons #\r "ρ") + (cons #\R "Ρ") + (cons #\s "σ") + (cons #\S "Σ") + (cons #\w "ς") + (cons #\W "Σ") + (cons #\t "τ") + (cons #\T "Τ") + (cons #\y "υ") + (cons #\Y "Υ") + (cons #\f "φ") + (cons #\F "Φ") + (cons #\x "χ") + (cons #\X "Χ") + (cons #\c "ψ") + (cons #\C "Ψ") + (cons #\v "ω") + (cons #\V "Ω"))) + + +;;; Given input string in Greek transliteration, convert it to +;;; an equivalent Greek work in UTF-8 encoding. The input string is +;;; supposed to follow the traditional Greek keyboard layout: +;;; +;;; +----------------------------------------------------------------+ +;;; | 1! | 2@ | 3# | 4$ | 5% | 6^ | 7& | 8* | 9( | 0) | -_ | =+ | `~ | +;;; +----------------------------------------------------------------+ +;;; | ·― | ςΣ | εΕ | ρΡ | τΤ | υΥ | θΘ | ιΙ | οΟ | πΠ | [{ | ]} | +;;; +------------------------------------------------------------+ +;;; | αΑ | σΣ | δΔ | φΦ | γΓ | ηΗ | ξΞ | κΚ | λΛ | ΄¨ | '" | \| | +;;; +-----------------------------------------------------------+ +;;; | ζΖ | χΧ | ψΨ | ωΩ | βΒ | νΝ | μΜ | ,; | .: | /? | +;;; +-------------------------------------------------+ +;;; +-----------------------------+ +;;; | space bar | +;;; +-----------------------------+ +;;; +;;; Additionally some spell fixing heuristics is applied: +;;; 's' at the end of the word -> 'ς' +;;; 'w' anywhere but at the end of the word -> 'ω' +;;; 'ks' -> 'ξ' +;;; 'ps' -> 'ψ' +;;; "u'" -> 'ύ' +;;; +;;; FIXME: The case of less obvious spelling errors, like e.g. 'ou' -> 'ου' +;;; will be handled by later spelling corrections if fuzzy search is +;;; enabled +(define (translate-kbd str) + (apply + string-append + (do ((sl (string->list str) (cdr sl)) + (l '())) + ((null? sl) (reverse l)) + (letrec ((decode-kbd-map + (lambda () + (let ((g (assoc + (let ((c (car sl))) + (cond + ((and (char=? c #\w) (not (null? (cdr sl)))) + #\v) + ((and (char=? c #\s) (null? (cdr sl))) + #\w) + (else + c))) + greek-kbd-map))) + (if g + (set! l (cons (cdr g) l)) + (set! l (cons (string (car sl)) l))))))) + (if (null? l) + (decode-kbd-map) + (let ((cmap (assoc (car sl) greek-postfix-map))) + (cond + (cmap + (let ((x (assoc (car l) (cdr cmap)))) + (if x + (set-car! l (cdr x)) + (decode-kbd-map)))) + (else + (decode-kbd-map))))))))) + + +;; Translate the input string to UTF-8 if necessary. +;; FIXME: currently does nothing +(define (translate-input input) + (if (< (char->integer (string-ref input 0)) 127) + (translate-kbd input) + input)) + + + +(define transcription-list + (list + (cons "μπ" "b" ) + (cons "γγ" "g" ) + (cons "γκ" "g" ) + (cons "γχ" "g" ) + (cons "ντ" "d" ) + (cons "αι" "e" ) + (cons "αί" "e" ) + (cons "αυ" "au") + (cons "αύ" "au") + (cons "ου" "ou") + (cons "ού" "ou") + (cons "ευ" "eu") + (cons "εύ" "eu") + (cons "οι" "i" ) + (cons "ει" "i" ) + (cons "εί" "i" ) + (cons "υι" "i" ) + + (cons "α" "a" ) + (cons "Α" "a" ) + (cons "Ά" "a" ) + (cons "ά" "a" ) + (cons "β" "b" ) + (cons "Β" "b" ) + (cons "γ" "g" ) + (cons "Γ" "g" ) + (cons "δ" "d" ) + (cons "Δ" "d" ) + (cons "ε" "e" ) + (cons "Ε" "e" ) + (cons "Έ" "e" ) + (cons "έ" "e" ) + (cons "ζ" "z" ) + (cons "Ζ" "z" ) + (cons "η" "i" ) + (cons "Η" "i" ) + (cons "Ή" "i" ) + (cons "ή" "i" ) + (cons "θ" "t" ) + (cons "Θ" "t" ) + (cons "ι" "i" ) + (cons "Ι" "i" ) + (cons "Ί" "i" ) + (cons "ί" "i" ) + (cons "κ" "k" ) + (cons "Κ" "k" ) + (cons "λ" "l" ) + (cons "Λ" "l" ) + (cons "μ" "m" ) + (cons "Μ" "m" ) + (cons "ν" "n" ) + (cons "Ν" "n" ) + (cons "ξ" "x" ) + (cons "Ξ" "x" ) + (cons "ο" "o" ) + (cons "Ο" "o" ) + (cons "Ό" "o" ) + (cons "ό" "o" ) + (cons "π" "p" ) + (cons "Π" "p" ) + (cons "ρ" "r" ) + (cons "Ρ" "r" ) + (cons "σ" "s" ) + (cons "Σ" "s" ) + (cons "ς" "s" ) + (cons "τ" "t" ) + (cons "Τ" "t" ) + (cons "υ" "ι" ) + (cons "Υ" "ι" ) + (cons "Ύ" "ι" ) + (cons "ύ" "ι" ) + (cons "φ" "f" ) + (cons "Φ" "f" ) + (cons "χ" "h" ) + (cons "Χ" "h" ) + (cons "ψ" "P" ) + (cons "Ψ" "P" ) + (cons "ω" "o" ) + (cons "Ω" "o" ) + (cons "Ώ" "o" ) + (cons "ώ" "o" ) + (cons "Ϊ" "i" ) + (cons "ΐ" "i" ) + (cons "Ϋ" "i" ) + (cons "ΰ" "i" ))) + +(define (greek-to-transcription str) + (let ((len (string-length str))) + (do ((i 0) + (sl '())) + ((= i len) (apply string-append (reverse sl))) + (set! sl (cons + (cond + ((and (< (+ i 2) len) + (assoc (substring str i (+ i 4)) transcription-list)) => + (lambda (x) + (set! i (+ i 4)) + (cdr x))) + ((assoc (substring str i (+ i 2)) transcription-list) => + (lambda (x) + (set! i (+ i 2)) + (cdr x))) + (else + (set! i (1+ i)) + (substring str i (+ i 1)))) + sl))))) + + + + +(define (encode-string str) + (apply + string-append + (map + (lambda (x) + (let ((n (char->integer x))) + (if (or (and (> n 97) (< n 122)) + (and (> n 65) (< n 90)) + (and (> n 48) (< n 57))) + (string x) + (let ((s (number->string n 16))) + (string-append "%" + (if (< n 16) + "0" "") + s))))) + (string->list str)))) + +(define (decode-string str) + (do ((i 0) + (sl '())) + ((= i (string-length str)) (list->string (reverse sl))) + (let ((c (string-ref str i))) + (set! sl + (cons + (cond + ((char=? c #\%) + (set! i (+ i 3)) + (integer->char + (string->number (substring str (- i 2) i) 16))) + (else + (set! i (1+ i)) + c)) + sl))))) + + +;; +(define (display-results rlist) + (let ((x (car rlist))) + (display "<TABLE BORDER=0>") + (display "<TR><TD>") + (display (car x)) + (display "</TD>") + (cond + ((list-ref x 3) + (display "<TD>") + (display (list-ref x 3)) + (display "</TD>"))) + (display "<TD>") + (display (list-ref x 2)) + (display "</TD></TR>")) + (for-each + (lambda (x) + (display "<TR><TD>") + (display (1+ (string->number (list-ref x 4)))) + (display "</TD><TD>") + (display (list-ref x 5)) + (display ";</TD></TR>")) + rlist) + (display "</TABLE>") + (newline)) + +(define (display-cross-reference word) + (display "<A HREF=\"") + (display dict-cgi-path) + (display "?IDENT=") + (display (encode-string word)) + (display "\">") + (display word) + (display "</A>")) + +(define (display-xref rlist text) + (display text) + (let ((n 0)) + (for-each + (lambda (x) + (if (> n 0) + (display ", ")) + (set! n (1+ n)) + (display-cross-reference (car x))) + rlist)) + (display ";")) + +(define (sort-result input-list) + (let ((output-list '()) + (current-element '())) + (for-each + (lambda (x) + (cond + ((or (null? current-element) + (= (string->number (cadr x)) + (string->number (cadr (car current-element))))) + (set! current-element (cons x current-element))) + (else + (set! output-list (cons (reverse current-element) output-list)) + (set! current-element (list x))))) + input-list) + (cons (reverse current-element) output-list))) + + +(define (search-failure key) + (display "<H2>Sorry, \"") + (display key) + (display "\" was not found in the dictionary</H2>")) + + +(define (fuzzy-search conn key theme pos) + (let ((result (sql-query conn + (cond + ((> (string->number theme) 0) + (string-append + "SELECT dict.word FROM dict,topic_tab WHERE " + (cond + ((not (string-null? key)) + (string-append "dict.sound LIKE \"" + (greek-to-transcription key) + "%\" AND ")) + (else + "")) + "topic_tab.topic_ident=" + theme + " AND topic_tab.word_ident=dict.ident " + (if (> (string->number pos) 0) + (let ((pos-entry + (list-ref part-of-speech (string->number pos)))) + (string-append "AND " + (cdr pos-entry))) + "") + " order by word")) + (else + (string-append + "SELECT word FROM dict WHERE sound like \"" + (greek-to-transcription key) + "%\" " + (if (> (string->number pos) 0) + (let ((pos-entry (list-ref part-of-speech + (string->number pos)))) + (string-append "AND " + (cdr pos-entry))) + "") + " order by word")))))) + (cond + ((null? result) + (search-failure key)) + (else + (display "<TABLE>") + (for-each + (lambda (x) + (display "<TR><TD>") + (display-cross-reference (car x)) + (display "</TD></TR>")) + result) + (display "</TABLE>"))))) + + +(define (dict-search) + (let ((keyval (if (cgi:value "IDENT") + (decode-string (cgi:value "IDENT")) + (cgi:value "key"))) + (theme (cgi:value "TOPIC")) + (pos (cgi:value "POS"))) + (cond + ((and keyval (not (string-null? keyval))) + (let ((conn (sql-connect + sql-iface sql-host sql-port sql-database + sql-username sql-password))) + (cond + ((not conn) + (display "<H1>ERROR: cannot connect to the dictionary</H1>\n")) + (else + (display "<HR>") + (let* ((key (translate-input keyval)) + (result (sql-query + conn + (string-append + "SELECT dict.word,dict.ident,dict.pos,dict.forms,articles.subindex,articles.meaning from dict,articles where dict.word=\"" + key + "\" and dict.ident=articles.ident order by dict.ident, articles.subindex")))) + + (cond + ((null? result) + (fuzzy-search conn key theme pos)) + (else + (for-each + (lambda (entry) + (display-results entry) + (let ((ant (sql-query + conn + (string-append + "SELECT dict.word FROM dict,antonym WHERE antonym.ident=" + (cadr (car entry)) + " AND dict.ident=antonym.antonym ORDER BY word")))) + (if (and ant (not (null? ant))) + (display-xref ant + (if (= (length ant) 1) + "Антоним: " "Антонимы: ")))) + (display "<P>") + (let ((x (sql-query + conn + (string-append + "SELECT dict.word FROM dict,xref WHERE xref.ident=" + (cadr (car entry)) + " AND dict.ident=xref.xref ORDER BY word")))) + (if (and x (not (null? x))) + (display-xref x "См. также ")))) + (sort-result result)))) + (sql-connect-close conn)))))) + ((or (> (string->number theme) 0) (> (string->number pos) 0)) + (let ((conn (sql-connect + sql-iface sql-host sql-port sql-database + sql-username sql-password))) + (cond + ((not conn) + (display "<H1>ERROR: cannot connect to the dictionary</H1>\n")) + (else + (display "<HR>") + (fuzzy-search conn "" theme pos) + (sql-connect-close conn)))))))) + +;;; Main +(dict-html-start) +(main-form) +(dict-search) +(dict-html-end) + +;;;; Local variables: +;;;; mode: Scheme +;;;; buffer-file-coding-system: utf-8 +;;;; End: + diff --git a/data/db.struct b/data/db.struct new file mode 100644 index 0000000..cdabe16 --- /dev/null +++ b/data/db.struct @@ -0,0 +1,49 @@ +CREATE DATABASE ellinika; +use ellinika + +CREATE TABLE dict( + ident int(32), # REL 1 + word varchar(128) binary, + sound varchar(128) binary, + pos varchar(64), + forms blob, + INDEX (ident), + INDEX (word) +); + +CREATE TABLE articles( + ident int(32) not null, # REL 1 + subindex int(32) not null, + meaning blob, + INDEX (ident), + INDEX (subindex) +); + +CREATE TABLE topic( + ident int(32) not null auto_increment, # REL 2 + title varchar(128) not null, + UNIQUE (ident), + INDEX (title) +); + +CREATE TABLE topic_tab ( + topic_ident int(32) not null, # REL 2 + word_ident int(32) not null, # REL 1 + INDEX (topic_ident), + INDEX (word_ident) +); + +CREATE TABLE antonym( + ident int(32) not null, # REL 1 + antonym int(32) not null, # REL 1 + INDEX (ident), + UNIQUE (ident,antonym) +); + +CREATE TABLE xref( + ident int(32) not null, # REL 1 + xref int(32) not null, # REL 1 + INDEX (ident), + UNIQUE (ident,xref) +); + diff --git a/data/dict.1 b/data/dict.1 new file mode 100644 index 0000000..1800b2e --- /dev/null +++ b/data/dict.1 @@ -0,0 +1,2160 @@ +# -*- buffer-file-coding-system: utf-8 +NODE γαλάζιος +POS επίθ. +TOPIC χρώματα +MEANING голубой +END + +NODE κόκκινος +POS επίθ. +TOPIC χρώματα +MEANING красный +END + +NODE μπεζ +POS επίθ. +TOPIC χρώματα +MEANING бежевый +END + +NODE καστανός +POS επίθ. +TOPIC χρώματα +MEANING коричневый +MEANING карий +END + +NODE περασμένος +POS επίθ. +MEANING прошедший +END + +NODE ροζ +POS επίθ. +TOPIC χρώματα +MEANING розовый +END + +NODE καφέ +ALIAS καφετής +POS επίθ. +TOPIC χρώματα +MEANING коричневый +END + +NODE γκρι +ALIAS γκρίζος +POS επίθ. +TOPIC χρώματα +MEANING серый +END + +NODE διαφανής +POS επίθ. +TOPIC χρώματα +MEANING прозрачный +END + +NODE άχρομος +POS επίθ. +TOPIC χρώματα +MEANING бесцветный +END + +NODE συντανάω +POS επίθ. +TOPIC χρώματα +MEANING встречать +END + +NODE έκπτωση +POS επίθ. +TOPIC χρώματα +MEANING скидка +END + +NODE σοβαρός +POS επίθ. +TOPIC χρώματα +MEANING серьёзный +END + +NODE μαύρος +POS επίθ. +TOPIC χρώματα +MEANING черный +END + +NODE άσπρος +POS επίθ. +TOPIC χρώματα +MEANING белый +END + +NODE αχθοφόρος +POS ο +MEANING носильщик +END + +NODE πλένω +ALIAS πλύνω +POS μετ. +FORMS αόρ. έπλυνα +MEANING мою +END + +NODE κοντός +POS επίθ. +ANT ψηλός +MEANING низкий +END + +NODE έντονος +POS επίθ. +TOPIC χρώματα +ANT σκούρος +ANT βαθύς +MEANING яркий +END + +NODE πλούσιος +POS επίθ. +ANT φτώχος +MEANING богатый +END + +NODE μπουρμπουάρ +POS ο +MEANING чаевые +END + +NODE τσάντα +POS η +MEANING сумка +END + +NODE πράσινος +POS επίθ. +TOPIC χρώματα +MEANING зелёный +END + +NODE κίτρινος +POS επίθ. +TOPIC χρώματα +MEANING желтый +END + +NODE γέρος |