aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2004-03-08 17:48:41 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2004-03-08 17:48:41 +0000
commitdaf55756e5011206ab00c46fde8af7757e0294ec (patch)
tree7d1f1566ef7573f4e7b2e9c680fe328bdac0bf1a
parent8fbbd8be6ee668f664a008489ab0fb89ccbc8576 (diff)
downloadellinika-daf55756e5011206ab00c46fde8af7757e0294ec.tar.gz
ellinika-daf55756e5011206ab00c46fde8af7757e0294ec.tar.bz2
Removed
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@25 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rwxr-xr-xcgi-bin/dict.cgi728
1 files changed, 0 insertions, 728 deletions
diff --git a/cgi-bin/dict.cgi b/cgi-bin/dict.cgi
deleted file mode 100755
index 637ab98..0000000
--- a/cgi-bin/dict.cgi
+++ /dev/null
@@ -1,728 +0,0 @@
-#!/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 rc-file-name "/home/gray/linguae/ellinika/etc/ellinika.conf")
-(define base-href "http://localhost/") ;; Base HREF
-(define home-page "http://cvs.farlep.net/~gray") ;; Author home page
-(define dict-cgi-path "cgi-bin/dict.cgi") ;; Path to the cgi (relative
- ;; to the Base )
-(define admin-email "gray@mirddin.farlep.net") ;; Administrator email address
-(define admin-email-text "gray at mirddin.farlep.net") ;; Textual representation
- ;; thereof
-
-(define sql-iface "mysql") ;; SQL interface ("mysql" or "postgres")
-(define sql-host "localhost") ;; SQL server hostname or a path to the UNIX
- ;; socket
-(define sql-port 3306) ;; SQL port number (0 for sockaddr_un
- ;; connection)
-(define sql-database "ellinika") ;; Name of the database
-(define sql-username "gray") ;; Database user name
-(define sql-password "") ;; Password for that user name
-
-(define match-list-columns 4) ;; Number of colums in fuzzy search output
-;;; End of user-definable variables
-
-;;; Load the site defaults
-(if (file-exists? rc-file-name)
- (load rc-file-name))
-
-;; Τα μέρη του λογου
-(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 &#34;
-;; 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 "
-<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
-<HTML>
-<HEAD>
- <TITLE>Ellinorosiko lexiko</TITLE>
- <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
- <BASE HREF=\"")
- (display base-href)
- (display "\">
-</HEAD>
-<BODY BGCOLOR=\"#000080\" TEXT=\"#000000\" LINK=\"#1F00FF\" ALINK=\"#FF0000\" VLINK=\"#9900DD\">
-<TABLE WIDTH=\"99%\" ALIGN=\"CENTER\" CELLSPACING=\"0\" CELLPADDING=\"10%\" BORDER=\"0\" BGCOLOR=\"#FFFFFF\">
-<TR>
- <TD VALIGN=TOP width=\"20%\">
- <IMG SRC=\"graphics/gnu-head-sm.jpg\" ALIGN=\"top\" ALT=\" [A GNU head] \"><P>
- <TABLE WIDTH=\"100%\" ALIGN=\"LEFT\" CELLSPACING=\"0\" CELLPADDING=\"10%\" BORDER=\"0\" BGCOLOR=\"#FFFFFF\">
- <TR><TD BGCOLOR=\"#0063C1\"><CENTER><STRONG><FONT color=\"white\">Γραμματική</FONT></STRONG></CENTER></TD></TR>
- <TR><TD><A HREF=\"ellinika/gram.html\">Γραμματική</A></TD></TR>
- <TR><TD><A HREF=\"ellinika/arthra.html\">Τα άρθρα</A></TD></TR>
- <TR><TD><A HREF=\"ellinika/oysiastika.html\">Τα ουσιαστικά</A></TD></TR>
- <TR><TD><A HREF=\"ellinika/epitheta.html\">Τα επίθετα</A></TD></TR>
- <TR><TD><A HREF=\"ellinika/antonimies.html\">Αντωνυμίες</A></TD></TR>
- <TR><TD><A HREF=\"ellinika/rhmata.html\">Ρήματα</A></TD></TR>
- <TR><TD><A HREF=\"")
- (display home-page)
- (display "\">Αρχική σελίδα</A></TD></TR>
-
- <TR><TD BGCOLOR=\"#0063C1\"><CENTER><STRONG><FONT color=\"white\">Πληροφορίες</FONT></STRONG></CENTER></TD></TR>
- <TR><TD><A HREF=\"http://validator.w3.org/check/referer\">
- <img border=\"0\" src=\"graphics/valid-html401.png\"
- alt=\"[ Valid HTML 4.01! ]\" height=\"31\" width=\"88\"></A></TD></TR>
-
- </TABLE>
- </TD>
- <TD VALIGN=top>
- <H1 ALIGN=CENTER>Ελληνορωσικό λέξικο</H1>
-<HR>"))
-
-(define (dict-html-end)
- (display "
- </TD>
-</TR>
-<TR>
- <TD colspan=\"2\">
- <hr>
-Για προτάσεις ή απορίες σχετικά με αυτήν τη σελίδα επικοινωνήστε στο
-&lt;<A HREF=\"mailto:")
- (display admin-email)
- (display "\">")
- (display admin-email-text)
- (display "</A>&gt;
-
- </TD>
-</TR>
-</TABLE>
-</BODY></HTML>"))
-
-(define (main-form)
- (display "<FORM ACTION=\"")
- (display dict-cgi-path)
- (display "\" METHOD=POST>
-<TABLE BORDER=0>
-<TR>
- <TD>
- Εισάγετε τη λέξη
- </TD>
- <TD>
- <INPUT size=36 NAME=\"key\" TABINDEX=\"1\"")
- (let ((value (cgi:value "key")))
- (if value
- (begin
- (display "VALUE=\"")
- (display (protect value))
- (display "\""))))
- (display ">
- </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>
-<TR>
- <TD colspan=\"2\" align=center>
- <INPUT TYPE=\"submit\" NAME=\"search\" VALUE=\"Αναζήτηση\" TABINDEX=\"4\">
- </TD>
-</TR>
-</TABLE>
-</FORM>
-<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 4) len)
- (assoc (substring str i (+ i 4)) transcription-list)) =>
- (lambda (x)
- (set! i (+ i 4))
- (cdr x)))
- ((and (<= (+ i 2) len)
- (assoc (substring str i (+ i 2)) transcription-list)) =>
- (lambda (x)
- (set! i (+ i 2))
- (cdr x)))
- (else
- (set! i (1+ i))
- (substring str (- i 1) i)))
- 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>Συγγνώμη, η λέξη \"")
- (display key)
- (display "\" δεν βρέθηκε στο λέξικο.</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 WIDTH=\"100%\">")
- (let* ((result-length (length result))
- (lim (1+ (inexact->exact (/ result-length match-list-columns)))))
- (do ((i 0 (1+ i)))
- ((= i lim) #f)
- (display "<TR>")
- (do ((j i (+ j lim)))
- ((>= j result-length) #f)
- (display "<TD>")
- (display-cross-reference (car (list-ref result j)))
- (display "</TD>"))
- (display "</TR>")))
- (display "</TABLE>")))))
-
-
-(define (dict-search)
- (let ((keyval (if (cgi:value "IDENT")
- (decode-string (cgi:value "IDENT"))
- (cgi:value "key")))
- (theme (or (cgi:value "TOPIC") "0"))
- (pos (or (cgi:value "POS") "0")))
- (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>ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.</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>ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.</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:
-

Return to:

Send suggestions and report system problems to the System administrator.