aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/cgi-bin/.gitignore2
-rw-r--r--src/cgi-bin/Makefile.am5
-rw-r--r--src/cgi-bin/conj.scm4235
-rw-r--r--src/cgi-bin/dict.scm416
-rw-r--r--src/ellinika/Makefile.am3
-rw-r--r--src/ellinika/cgi.scm415
-rw-r--r--src/ellinika/conjugator.scm36
-rw-r--r--src/ellinika/sql.scm2
-rw-r--r--src/ellinika/tenses.scm13
-rw-r--r--src/ellinika/test-conjugation.scm14
-rw-r--r--xml/lingua.conf.in10
-rw-r--r--xml/pl/ellinika.xml3
-rw-r--r--xml/pl/rhmata.xml6
13 files changed, 309 insertions, 51 deletions
diff --git a/src/cgi-bin/.gitignore b/src/cgi-bin/.gitignore
index 1ae9efa..a2d76a3 100644
--- a/src/cgi-bin/.gitignore
+++ b/src/cgi-bin/.gitignore
@@ -4,4 +4,4 @@ dict.scm
dict.sed
nea.cgi
nea.scm
-
+conj.scm
diff --git a/src/cgi-bin/Makefile.am b/src/cgi-bin/Makefile.am
index bb90eed..16fc3d2 100644
--- a/src/cgi-bin/Makefile.am
+++ b/src/cgi-bin/Makefile.am
@@ -16,8 +16,8 @@
cgidir=@CGIDIR@
cgi_SCRIPTS=$(EXTRA_DIST:.scm4=.@SCRIPT_SUFFIX@)
-EXTRA_DIST=dict.scm4 nea.scm4
-CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi
+EXTRA_DIST=dict.scm4 nea.scm4 conj.scm4
+CLEANFILES=dict.m4 dict.scm nea.scm dict.cgi nea.cgi conj.cgi
dict.m4: Makefile
echo 'divert(-1)' > $@
@@ -50,6 +50,7 @@ SUFFIXES = .scm4 .scm .cgi
dict.scm: dict.scm4 dict.m4
nea.scm: nea.scm4 dict.m4
+conj.scm: conj.scm4 dict.m4
dict.cgi: dict.scm
nea.cgi: nea.scm
diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4
new file mode 100644
index 0000000..b48b225
--- /dev/null
+++ b/src/cgi-bin/conj.scm4
@@ -0,0 +1,235 @@
+;;;; Greek Dictionary Web Engine
+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2010, 2011 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 3 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, see <http://www.gnu.org/licenses/>.
+;;;;
+
+;;; Tailor this statement to your needs if necessary.
+(set! %load-path (cons "GUILE_SITE" %load-path))
+
+(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
+ (srfi srfi-1)
+ (ice-9 rdelim)
+ (xmltools dict)
+ (ellinika elmorph)
+ (ellinika tenses)
+ (ellinika conjugator)
+ (ellinika sql)
+ (ellinika i18n)
+ (ellinika xlat)
+ (ellinika cgi))
+
+ifelse(IFACE,[CGI],(cgi:init))
+
+(define conj-template-file-name "conj_08.html")
+
+(ellinika-cgi-init conj-template-file-name)
+
+(define (sql-error-handler key func fmt fmtargs data)
+ (format #t "<h1 class=\"error\">~A</h1>\n"
+ (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
+ (apply format (current-error-port) fmt fmtargs))
+
+;;;
+(define (dict-connect)
+ (if (not ellinika:sql-conn)
+ (ellinika:sql-connect ellinika-sql-connection)))
+
+
+(define (main-form)
+ (format #t "<form action=\"~A\" method=\"post\">"
+ (make-cgi-name cgi-script-name))
+ (display "\
+<table class=\"noframe\">
+<tr>
+ <td>")
+ (display (_"Εισάγετε τον ρήμα"))
+ (display "
+ </td>
+ <td>
+ <input size=\"36\" name=\"key\" tabindex=\"1\"")
+ (let ((value (cgi:value "key")))
+ (if value
+ (begin
+ (display " value=\"")
+ (display (cgi-protect-quotes value))
+ (display "\""))))
+ (display " />
+ </td>
+ <td>
+ <input type=\"submit\" name=\"conjugate\" value=\"")
+ (display (_"Κλίση"))
+ (display "\" tabindex=\"2\" />
+ </td>
+</tr>
+</table>
+</form>
+"))
+
+(define tense-driver-list
+ '(("ind" 3 5)
+ ("sub" 3)
+ ("imp" 3)))
+
+(define (show-conjugation:tense verb voice mood tense)
+
+ #t)
+
+(define (table-header count tense-names)
+ (display "\
+ <table class=\"frame align-center\">
+ <thead class=\"std\">
+ <tr>")
+ (for-each
+ (lambda (tense)
+ (format #t "<th>~A</th>~%" tense))
+ tense-names)
+ (display "</tr></thead>"))
+
+(define (table-footer)
+ (display "</table>"))
+
+(define (transpose mtx)
+ (let* ((w (length (car mtx)))
+ (res (make-list w)))
+ (do ((i 0 (1+ i)))
+ ((= i w))
+ (list-set! res i (map
+ (lambda (row)
+ (list-ref row i))
+ mtx)))
+ res))
+
+(define (compact-conj-list conj)
+ (map
+ (lambda (x)
+ (fold-right
+ (lambda (elt prev)
+ (if (member elt prev)
+ prev
+ (cons elt prev)))
+ '()
+ x))
+ conj))
+
+(define (concat-unique lst)
+ (fold
+ (lambda (elt prev)
+ (if prev
+ (string-append prev "," elt)
+ elt))
+ #f
+ lst))
+
+
+(define (format-tenses count tense-names voice mood verb)
+ (let ((prosopa (if (string=? mood "imp")
+ '(2 5)
+ '(1 2 3 4 5 6))))
+ (for-each
+ (lambda (row pers class)
+ (cond
+ ((member pers prosopa)
+ (format #t "<tr class=\"~A\">" class)
+ (for-each
+ (lambda (x)
+ (let ((val (concat-unique x)))
+ (format #t "<td>~A</td>" (if val val "--"))))
+ row)
+ (display "</tr>"))))
+ (transpose
+ (map
+ (lambda (tense)
+ (let ((conj (conjugator verb voice mood tense)))
+ (compact-conj-list (transpose (map conjugation:table conj)))))
+ tense-names))
+ '(1 2 3 4 5 6)
+ '("odd" "even" "odd" "even" "odd" "even"))))
+
+(define (show-conjugation:mood voice mood tense-list verb)
+ (format #t "<div class=\"subsection\"><h3>~A</h3>"
+ (ellinika-conjugation-term mood))
+ (for-each
+ (lambda (count)
+ (let ((tenses (list-head tense-list count)))
+ (table-header count tenses)
+ (format-tenses count tenses voice mood verb)
+ (table-footer)
+ (set! tense-list (list-tail tense-list count))
+ (if (not (null? tense-list))
+ (display "<br/><br/>"))))
+ (assoc-ref tense-driver-list mood))
+ (display "</div>"))
+
+(define (show-conjugation:voice voice verb)
+ (format #t "<div class=\"section\"><h2>~A</h2>"
+ (ellinika-conjugation-term voice))
+ (for-each
+ (lambda (mood-tenses)
+ (show-conjugation:mood voice (car mood-tenses) (cdr mood-tenses) verb))
+ ellinika-tense-list)
+
+ (display "</div>"))
+
+(define (show-conjugation verb)
+ (show-conjugation:voice "act" verb)
+ (show-conjugation:voice "pas" verb))
+
+(define (do-conj)
+ (let ((keyval (cgi:value "key")))
+ (if keyval
+ (show-conjugation keyval))))
+
+(define (conj-html)
+ (sql-catch-failure
+ (let ((explist (list
+ (cons "@@args@@"
+ (lambda ()
+ (for-each
+ (lambda (name)
+ (cond
+ ((string=? name "LANG"))
+ (else
+ (let ((v (cgi:value name)))
+ (cond ((and v (not (string-null? v)))
+ (display "&amp;")
+ (display name)
+ (display "=")
+ (display v)))))))
+ (cgi:names))))
+ (cons "@@conj@@"
+ (lambda ()
+ (dict-connect)
+ (main-form)
+ (do-conj))))))
+
+ (do ((line (read-line) (read-line)))
+ ((eof-object? line) #f)
+ (expand-template explist line)
+ (newline))
+ (ellinika:sql-disconnect))))
+
+;;; Main
+ifelse(IFACE,[CGI],(display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
+
+(with-input-from-file
+ (template-file target-language conj-template-file-name)
+ conj-html)
+
+
+;;;; Local variables:
+;;;; mode: Scheme
+;;;; buffer-file-coding-system: utf-8
+;;;; End:
+
diff --git a/src/cgi-bin/dict.scm4 b/src/cgi-bin/dict.scm4
index 1440454..c3429e9 100644
--- a/src/cgi-bin/dict.scm4
+++ b/src/cgi-bin/dict.scm4
@@ -52,20 +52,6 @@ ifelse(IFACE,[CGI],(cgi:init))
(cons (car x) (cadr x)))
plist))))))
-;; 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 ((categories #f))
(letrec ((getcat
@@ -130,7 +116,7 @@ ifelse(IFACE,[CGI],(cgi:init))
(if value
(begin
(display " value=\"")
- (display (protect value))
+ (display (cgi-protect-quotes value))
(display "\""))))
(display " />
</td>
diff --git a/src/ellinika/Makefile.am b/src/ellinika/Makefile.am
index 581a537..01534c0 100644
--- a/src/ellinika/Makefile.am
+++ b/src/ellinika/Makefile.am
@@ -23,7 +23,8 @@ guile_DATA=\
dico.scm\
elmorph.scm\
tenses.scm\
- sql.scm
+ sql.scm\
+ conjugator.scm
cgi.m4: Makefile
echo 'divert(-1)' > $@
diff --git a/src/ellinika/cgi.scm4 b/src/ellinika/cgi.scm4
index c7fbdb6..8cbfeca 100644
--- a/src/ellinika/cgi.scm4
+++ b/src/ellinika/cgi.scm4
@@ -165,4 +165,19 @@ THUNK.
(if x
(set! target-language x))))
+;; 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-public (cgi-protect-quotes string)
+ (list->string
+ (apply append
+ (map
+ (lambda (x)
+ (if (eq? x #\")
+ (list #\& #\# #\3 #\4 #\;)
+ (list x)))
+ (string->list string)))))
+
+
;;; End of cgi.scmi
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index 0079d12..41575c2 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -77,23 +77,23 @@
(define (create-basic-verb-info verb proplist . rest)
; (format #t "PROPLIST ~A~%" proplist)
- (let ((class (if (null? rest)
- ""
- (string-append
- " AND conj=\"" (utf8-escape (car rest)) "\""))))
- (let ((vdb (ellinika:sql-query
- "SELECT conj FROM verbclass WHERE verb=\"~A\"~A"
- verb class)))
- (cond
- ((and vdb (not (null? vdb)))
- (list (caar vdb) verb proplist '(class)))
- ((elstr-suffix? verb "άω")
- (create-basic-verb-info (elstr-append
- (elstr-trim verb -2) "ώ") "B1"))
- ((null? rest)
- (list (guess-verb-class verb) verb proplist '()))
- (else
- (list (car rest) verb '() '()))))))
+ (let ((vdb (if (null? rest)
+ (ellinika:sql-query
+ "SELECT conj FROM verbclass WHERE verb=\"~A\""
+ verb)
+ (ellinika:sql-query
+ "SELECT conj FROM verbclass WHERE verb=\"~A\" AND conj=~Q"
+ verb (car rest)))))
+ (cond
+ ((and vdb (not (null? vdb)))
+ (list (caar vdb) verb proplist '(class)))
+ ((elstr-suffix? verb "άω")
+ (create-basic-verb-info (elstr-append
+ (elstr-trim verb -2) "ώ") proplist "B1"))
+ ((null? rest)
+ (list (guess-verb-class verb) verb proplist '()))
+ (else
+ (list (car rest) verb '() '())))))
(define (load-verb-info verb voice mood tense)
; (format #t "LOAD ~A~%" verb)
@@ -181,7 +181,7 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
(error "cannot handle ~A~%" verb))))
(define (complement-verb-info vinfo verb voice thema)
-; (format #t "COMPLEMENT ~A~%" thema)
+; (format #t "COMPLEMENT ~A~%" vinfo)
(let ((elverb (string->elstr verb))
(result (let ((tmpres (lookup-verb-info verb voice thema)))
(if (and (null? tmpres) (string=? thema "sub"))
diff --git a/src/ellinika/sql.scm b/src/ellinika/sql.scm
index f49ddf1..5867d28 100644
--- a/src/ellinika/sql.scm
+++ b/src/ellinika/sql.scm
@@ -42,7 +42,7 @@
(define (->string arg)
(cond
((string? arg) arg)
- ((elstr? arg) (elstr->string? arg))
+ ((elstr? arg) (elstr->string arg))
((number? arg) (number->string arg))
((bool? arg) (if arg "true" "false"))
(else
diff --git a/src/ellinika/tenses.scm b/src/ellinika/tenses.scm
index f830870..137cfff 100644
--- a/src/ellinika/tenses.scm
+++ b/src/ellinika/tenses.scm
@@ -35,4 +35,15 @@
(list "Ενεστώτας"
"Αόριστος"
"Παρακείμενος"))))
- \ No newline at end of file
+
+(define-public ellinika-conjugation-term-transtab
+ '(("act" . "Ενεργητηκή φωνή")
+ ("pas" . "Μεσοπαθητική φωνή")
+ ("ind" . "Οριστική")
+ ("sub" . "Υποτακτική")
+ ("imp" . "Προστακτική")))
+
+(define-public (ellinika-conjugation-term x)
+ (or (assoc-ref ellinika-conjugation-term-transtab x) x))
+
+
diff --git a/src/ellinika/test-conjugation.scm b/src/ellinika/test-conjugation.scm
index 055138b..1504553 100644
--- a/src/ellinika/test-conjugation.scm
+++ b/src/ellinika/test-conjugation.scm
@@ -27,20 +27,12 @@
(ellinika-cgi-init dict-template-file-name)
(ellinika:sql-connect ellinika-sql-connection)
-(define transtab
- '(("act" . "Ενεργητηκή φωνή")
- ("pas" . "Μεσοπαθητική φωνή")
- ("ind" . "Οριστική")
- ("sub" . "Υποτακτική")
- ("imp" . "Προστακτική")))
-
-(define (term x)
- (or (assoc-ref transtab x) x))
-
(define-public (test-conjugation:tense verb voice mood tense)
(for-each
(lambda (result)
- (format #t "~A ~A/~A/~A: " verb (term voice) (term mood) tense)
+ (format #t "~A ~A/~A/~A: " verb
+ (ellinika-conjugation-term voice)
+ (ellinika-conjugation-term mood) tense)
(let ((conj (conjugation:table result)))
(cond
((empty-conjugation? conj)
diff --git a/xml/lingua.conf.in b/xml/lingua.conf.in
index 22570b8..3b86202 100644
--- a/xml/lingua.conf.in
+++ b/xml/lingua.conf.in
@@ -43,6 +43,16 @@
(lingua:LANG args)))))
(xmltrans:set-attr "LINGUA" "NEA" nea)))
+(define-macro (install-conj)
+ `(use-modules (xmltrans lingua)
+ (xmltools dict))
+ (letrec ((conj (lambda (. args)
+ (string-append
+ (lingua:get-cgi-bin)
+ "/conj.=SCRIPT_SUFFIX=?LANG="
+ (lingua:LANG args)))))
+ (xmltrans:set-attr "LINGUA" "CONJ" conj)))
+
(xmltrans:end-tag
"FOOTER"
(tag attr text)
diff --git a/xml/pl/ellinika.xml b/xml/pl/ellinika.xml
index 8dcd1f3..f2d7f15 100644
--- a/xml/pl/ellinika.xml
+++ b/xml/pl/ellinika.xml
@@ -33,12 +33,13 @@
<COPYRIGHT>
<FOOTER VCS-ID="$Id$">
-Copyright <![CDATA[&copy;]]> 2004, 2005, 2006, 2007, 2010 Sergey Poznyakoff
+Copyright <![CDATA[&copy;]]> 2004-2011 Sergey Poznyakoff
</FOOTER>
</COPYRIGHT>
<GUILE>
(install-nea)
+ (install-conj)
#f
</GUILE>
diff --git a/xml/pl/rhmata.xml b/xml/pl/rhmata.xml
index 10b9978..42d5caa 100644
--- a/xml/pl/rhmata.xml
+++ b/xml/pl/rhmata.xml
@@ -2492,6 +2492,12 @@ równy drugiej osobie czasu przeszłego dokonanego trybu łączącego:
</TABULAR>
</PAGE>
+<PAGE PREFIX="conj" HEADER="Koniugator" REF="CONJ">
+
+@@conj@@
+
+</PAGE>
+
</CHAPTER>
<!-- Local Variables: -->

Return to:

Send suggestions and report system problems to the System administrator.