summaryrefslogtreecommitdiffabout
path: root/src
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-15 14:30:48 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2011-06-15 14:30:48 (GMT)
commitd688c9630db459ec13e5311adaee05e651b3789d (patch) (side-by-side diff)
tree760cad87ebfec5b42344cbd635e90b12c9f2e2fa /src
parent516f479a1ddb3bb783a01e9ffb20ba051243ffd0 (diff)
downloadellinika-d688c9630db459ec13e5311adaee05e651b3789d.tar.gz
ellinika-d688c9630db459ec13e5311adaee05e651b3789d.tar.bz2
Minor changes
* src/cgi-bin/conj.scm4: Mark unattested stems and verb classes. * src/ellinika/conjugator.scm (conjugate): Fix empty conjugation return. * xml/pl/rhmata.xml: Update.
Diffstat (limited to 'src') (more/less context) (ignore whitespace changes)
-rw-r--r--src/cgi-bin/conj.scm466
-rw-r--r--src/ellinika/conjugator.scm2
2 files changed, 58 insertions, 10 deletions
diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4
index 253de1d..8fca3f0 100644
--- a/src/cgi-bin/conj.scm4
+++ b/src/cgi-bin/conj.scm4
@@ -83,25 +83,47 @@ ifelse(IFACE,[CGI],(cgi:init))
("sub" 3)
("imp" 3)))
-(define (show-conjugation:tense verb voice mood tense)
-
- #t)
-(define (table-header count tense-names)
+(define unattested '()) ; List of unattested flags
+
+(define (table-header count tenses)
(display "\
<table class=\"frame align-center\">
<thead class=\"std\">
<tr>")
(for-each
(lambda (tense)
- (format #t "<th>~A</th>~%" tense))
- tense-names)
+ (let ((tense-name (car tense))
+ (att (fold
+ (lambda (conj prev)
+ (let ((att (conjugation:attested conj)))
+ (if att
+ (append att prev)
+ prev)))
+ '()
+ (cdr tense))))
+ (display "<th>")
+ (cond
+ ((not (member 'class att))
+ (display "<a href=\"#class-na\">*</a>&nbsp;")
+ (if (not (member 'class unattested))
+ (set! unattested (cons 'class unattested)))))
+ (cond
+ ((not (member 'root att))
+ (display "<a href=\"#root-na\">?</a>&nbsp;")
+ (if (not (member 'root unattested))
+ (set! unattested (cons 'root unattested)))))
+ (display tense-name)
+ (display "</th>")
+ (newline)))
+ tenses)
(display "</tr></thead>"))
(define (table-footer)
(display "</table>"))
(define (transpose mtx)
+ (display "<!--\n")(write mtx)(display "\n-->")
(let* ((w (length (car mtx)))
(res (make-list w)))
(do ((i 0 (1+ i)))
@@ -163,7 +185,7 @@ ifelse(IFACE,[CGI],(cgi:init))
(for-each
(lambda (count)
(let ((tenses (list-head tense-list count)))
- (table-header count (map car tenses))
+ (table-header count tenses)
(format-tenses count (map cdr tenses) voice mood)
(table-footer)
(set! tense-list (list-tail tense-list count))
@@ -237,12 +259,36 @@ ifelse(IFACE,[CGI],(cgi:init))
(map force-string fmtargs)))))
(else
(error-message "OTHER ERROR: ~S ~S" key args))))))
-
+
+(define (show-conjugation-simple verb)
+ (for-each
+ (lambda (voice)
+ (show-conjugation:voice voice))
+ (conjugate-all verb)))
+
(define (do-conj)
(let ((keyval (cgi:value "key")))
(if (and keyval (not (string-null? keyval)))
(show-conjugation (ellinika:translate-input keyval)))))
+(define (print-footnote id sign text)
+ (format #t "<p><a name=\"~A\">~A</a>&nbsp;&nbsp;~A</p>~%"
+ id sign text))
+
+(define (footnotes)
+ (display "<div class=\"footnote\">")
+ (for-each
+ (lambda (flag)
+ (case flag
+ ((class)
+ (print-footnote "class-na" "*"
+ "Conjugation class of this verb is not attested"))
+ ((root)
+ (print-footnote "root-na" "?"
+ "Stem of this verb is not attested"))))
+ unattested)
+ (display "</div>"))
+
(define (conj-html)
(sql-catch-failure
(let ((explist (list
@@ -264,7 +310,9 @@ ifelse(IFACE,[CGI],(cgi:init))
(lambda ()
(dict-connect)
(main-form)
- (do-conj))))))
+ (do-conj)
+ (if (not (null? unattested))
+ (footnotes)))))))
(do ((line (read-line) (read-line)))
((eof-object? line) #f)
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index 8172686..069d641 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -461,7 +461,7 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(conj-list (get-conj-info (verb-get vinfo #:conj)
voice mood tense)))
(if (not conj-list)
- (list (list #f #f #f #f #f #f) #f #f)
+ (list (list #f #f #f #f #f #f #f #f))
(map car
(fold-right
(lambda (elt prev)

Return to:

Send suggestions and report system problems to the System administrator.