diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-15 10:05:10 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-15 10:24:46 +0300 |
commit | bb9dd8a54a96307aad7bf976f1736d20c70d43e3 (patch) | |
tree | df632e2c76facc932c4c34978eba4b9ae4cb0354 /src/cgi-bin | |
parent | a27881a1c5bd7d8f8f42cd6526adf80815acfe63 (diff) | |
download | ellinika-bb9dd8a54a96307aad7bf976f1736d20c70d43e3.tar.gz ellinika-bb9dd8a54a96307aad7bf976f1736d20c70d43e3.tar.bz2 |
Implement web conjugator.
* src/cgi-bin/.gitignore: Update.
* src/cgi-bin/Makefile.am: Build conj,cgi
* src/cgi-bin/conj.scm4: New file.
* src/cgi-bin/dict.scm4 (protect): Move to cgi.scm, function
cgi-protect-quotes. All uses updated.
* src/ellinika/cgi.scm4 (cgi-protect-quotes): New function.
* src/ellinika/Makefile.am (guile_DATA): Add conjugator.scm
* src/ellinika/conjugator.scm: Minor fixes.
* src/ellinika/sql.scm (->string): Fix typo.
* src/ellinika/tenses.scm (ellinika-conjugation-term-transtab): New var.
(ellinika-conjugation-term): New function.
* src/ellinika/test-conjugation.scm: Use ellinika-conjugation-term instead
of (term).
* xml/lingua.conf.in (install-conj): New macro.
* xml/pl/ellinika.xml (GUILE): Call install-conj.
* xml/pl/rhmata.xml: Define conjugator template page.
Diffstat (limited to 'src/cgi-bin')
-rw-r--r-- | src/cgi-bin/.gitignore | 2 | ||||
-rw-r--r-- | src/cgi-bin/Makefile.am | 5 | ||||
-rw-r--r-- | src/cgi-bin/conj.scm4 | 235 | ||||
-rw-r--r-- | src/cgi-bin/dict.scm4 | 16 |
4 files changed, 240 insertions, 18 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 "&") + (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 " -;; 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> |