diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-10-08 19:54:13 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-10-08 19:54:13 +0000 |
commit | bf5572318eb24013888643a59f116d1536bd228a (patch) | |
tree | f3680e70b84ab44c99d9d3cb44db8a7c9becaa95 /cgi-bin | |
parent | b98a35c47d57415d1b67490688b13d1cf126d594 (diff) | |
download | ellinika-bf5572318eb24013888643a59f116d1536bd228a.tar.gz ellinika-bf5572318eb24013888643a59f116d1536bd228a.tar.bz2 |
Use (xmltools dict) and (ellinika xlat)
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@203 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'cgi-bin')
-rw-r--r-- | cgi-bin/dict.cgi.in | 345 |
1 files changed, 11 insertions, 334 deletions
diff --git a/cgi-bin/dict.cgi.in b/cgi-bin/dict.cgi.in index 5531c1c..c48f39f 100644 --- a/cgi-bin/dict.cgi.in +++ b/cgi-bin/dict.cgi.in @@ -21,9 +21,11 @@ ;; FIXME: These should be set by configure (set! %load-path (append %load-path (list "/usr/local/share/guile-sql"))) (set! %load-path (append %load-path (list "/usr/local/share/guile-gettext"))) -(use-modules (www cgi)) -(use-modules (sql)) -(use-modules (gettext)) +(use-modules (www cgi) + (sql) + (gettext) + (xmltools dict) + (ellinika xlat)) (cgi:init) ;;; User-definable variables @@ -261,331 +263,6 @@ </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 "Ω"))) - - -(define (after-thita? c) - (member c (list #\a #\e #\i #\o #\y #\v))) - -;;; Given input string in Greek transliteration, convert it to -;;; an equivalent Greek word 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 | -;;; +-----------------------------+ -;;; -;;; -;;; The followin escape sequences are recognized: -;;; -;;; '\ks' -> 'ξ' -;;; '\ps' -> 'ψ' -;;; '\th' -> 'θ' -;;; -;;; 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' -> 'ψ' -;;; "th" -> 'θ' unless followed by a consonant -;;; "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)) - (if (char=? (car sl) #\\) - (cond - ((> (length sl) 2) - (cond - ((char=? (car (cdr (cdr sl))) #\s) - (let ((c (car (cdr sl)))) - (cond - ((char=? c #\k) - (set! sl (cdr (cdr sl))) - (set! l (cons "ξ" l))) - ((char=? c #\p) - (set! sl (cdr (cdr sl))) - (set! l (cons "ψ" l))) - (else - (set! sl (cdr sl)))))) - ((and (char=? (car (cdr sl))) - (char=? (car (cdr (cdr sl))) #\h)) - (set! sl (cdr (cdr sl))) - (set! l (cons "θ" l))))) - - (else - (set! l (cons (string (car sl)) l)))))))))) - (if (null? l) - (decode-kbd-map) - (cond - ((char=? (car sl) #\h) - (if (and (not (null? (cdr sl))) - (after-thita? (car (cdr sl)))) - (set-car! l "θ") - (decode-kbd-map))) - ((assoc (car sl) greek-postfix-map) => - (lambda (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. -(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 "υ" "i" ) - (cons "Υ" "i" ) - (cons "Ύ" "i" ) - (cons "ύ" "i" ) - (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 (replace-tilde word sentence) (apply @@ -624,7 +301,7 @@ (display (language-code target-language)) (display "/") (display (cdr href)) - (display (encode-string (car x))) + (display (dict:encode-string (car x))) (display "\">") (display (list-ref x 3)) (display "</A>")) @@ -647,7 +324,7 @@ (define (display-cross-reference word) (display "<A HREF=\"") - (display (make-cgi-name "IDENT" (encode-string word))) + (display (make-cgi-name "IDENT" (dict:encode-string word))) (display "\">") (display word) (display "</A>")) @@ -695,7 +372,7 @@ (cond ((not (string-null? key)) (string-append "dict.sound LIKE \"" - (greek-to-transcription key) + (ellinika:sounds-like key) "%\" AND ")) (else "")) @@ -712,7 +389,7 @@ (else (string-append "SELECT DISTINCT word FROM dict WHERE sound like \"" - (greek-to-transcription key) + (ellinika:sounds-like key) "%\" " (if (> (string->number pos) 0) (let ((pos-entry (list-ref part-of-speech @@ -742,7 +419,7 @@ (define (dict-search) (let ((keyval (if (cgi:value "IDENT") - (decode-string (cgi:value "IDENT")) + (dict:decode-string (cgi:value "IDENT")) (cgi:value "key"))) (theme (or (cgi:value "TOPIC") "0")) (pos (or (cgi:value "POS") "0"))) @@ -760,7 +437,7 @@ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")) (else (display "<HR>") - (let* ((key (translate-input keyval)) + (let* ((key (ellinika:translate-input keyval)) (result (sql-query conn (string-append |