summaryrefslogtreecommitdiffabout
path: root/scm/dictrans.scm
authorSergey Poznyakoff <gray@gnu.org.ua>2004-10-13 12:39:00 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2004-10-13 12:39:00 (GMT)
commit8f01c7329a5457c0e5e65267e936144b6d77a461 (patch) (side-by-side diff)
tree8620989e2ec22df1dd6d8cbae2392316bcae4a25 /scm/dictrans.scm
parent3db1451f587869006f3c1aee564a23cc1774e6fe (diff)
downloadellinika-8f01c7329a5457c0e5e65267e936144b6d77a461.tar.gz
ellinika-8f01c7329a5457c0e5e65267e936144b6d77a461.tar.bz2
Added INCLUDE support.
Diagnose duplicate entries. Fixed bug in NODE. git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@234 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'scm/dictrans.scm') (more/less context) (ignore whitespace changes)
-rw-r--r--scm/dictrans.scm78
1 files changed, 71 insertions, 7 deletions
diff --git a/scm/dictrans.scm b/scm/dictrans.scm
index 4c365c2..fb4064f 100644
--- a/scm/dictrans.scm
+++ b/scm/dictrans.scm
@@ -23,7 +23,7 @@
;;;;
;;;; * Each dictionary entry is represented as a vector:
;;;;
-;;;; #(KEY FORMS XREF P-LIST)
+;;;; #(KEY FORMS XREF P-LIST LOC)
;;;;
;;;; KEY is list of strings
;;;;
@@ -43,6 +43,7 @@
;;;; XREF list(string) List of cross-references
;;;; TOPIC list(string) List of topics this item pertains to
;;;;
+;;;; * LOC is source location where the entry was defined (cons FILE LINE).
;;;;
;;;; External representation (XML):
;;;;
@@ -184,7 +185,9 @@
((node-get #:xref node)
(vector-ref node 2))
((node-get #:p-list node)
- (vector-ref node 3))))
+ (vector-ref node 3))
+ ((node-get #:locus node)
+ (vector-ref node 4))))
(define-macro (current-node-get key)
`(node-get ,key current-node))
@@ -227,7 +230,9 @@
(for-each
(lambda (p)
(p-article-set #:topic p t))
- (node-get #:p-list node)))))
+ (node-get #:p-list node)))
+ ((node-set #:locus node loc)
+ (vector-set! node 4 loc))))
(define-macro (current-node-set key val)
`(node-set ,key current-node ,val))
@@ -341,12 +346,26 @@
(xmltrans:start-tag
"NODE"
(tag attr)
- (set! current-node (vector #f #f '() '()))
+ (set! current-node (vector #f #f '() '() (xmltrans:get-input-location)))
(set! p-article #f)
(set! expected-k #t)
(xmltrans:expect-next-tag "K" k-expect)
#f)
+;;;; INCLUDE
+(xmltrans:end-tag
+ "INCLUDE"
+ (tag attr text)
+ (let ((fname (xmltrans:attr attr "FILE")))
+ (cond
+ ((not fname)
+ (xmltrans:parse-error #f "File name not specified"))
+ ((string? fname)
+ (xmltrans:parse-file fname))
+ (else
+ (xmltrans:parse-error #f "FILE must be a valid string"))))
+ #f)
+
(xmltrans:end-tag
"NODE"
(tag attr text)
@@ -362,7 +381,7 @@
((xmltrans:attr attr "__INVALID__")) ; Ignore
((not (current-node-get #:key))
(xmltrans:parse-error #f "K element is missing"))
- ((or (null? (current-node-get #:p-list)) (null? (null? (current-node-get #:xref))))
+ ((and (null? (current-node-get #:p-list)) (null? (current-node-get #:xref)))
(xmltrans:parse-error #f "No articles and no cross references for the node"))
(else
(push-node current-node)))
@@ -502,7 +521,12 @@
"M"
(tag attr text)
(expect-context tag "P" "NODE")
- (current-article-set #:article text)
+ (cond
+ ((and (not p-article) (null? (current-node-get #:p-list)))
+ (xmltrans:parse-error #f "P element not defined")
+ (mark-invalid))
+ (else
+ (current-article-set #:article text)))
#f)
;;; Formatting elements
@@ -630,6 +654,35 @@
(define dict-index 0)
+(define (check-node conn node)
+ (call-with-current-continuation
+ (lambda (return)
+ (for-each
+ (lambda (p-article)
+ (for-each
+ (lambda (key)
+ (let ((res (run-query
+ conn
+ (string-append
+ "SELECT locus.file,locus.line FROM dict, locus WHERE dict.word='"
+ key
+ "' AND pos="
+ (number->string (p-article-get #:pos p-article))
+ " AND dict.ident=locus.ident"))))
+ (if (not (null? res))
+ (begin
+ (xmltrans:parse-error
+ (node-get #:locus node)
+ "Key " key "," (p-article-get #:pos p-article)
+ " is already in the database")
+ (xmltrans:parse-error
+ (cons (caar res) (cadar res))
+ "This is the location of previous definition")
+ (return #f)))))
+ (node-get #:key node)))
+ (node-get #:p-list node))
+ #t)))
+
(define (insert-node conn node)
(letrec ((insert-link (lambda (type value)
(run-query
@@ -671,6 +724,16 @@
sound
(p-article-get #:pos p-article)))))
+ ;;; Insert source information
+ (let ((loc (node-get #:locus node)))
+ (run-query
+ conn
+ (format #f
+ "INSERT INTO locus (ident,file,line) VALUES(~A,\"~A\",~A)"
+ dict-index
+ (car loc)
+ (cdr loc))))
+
;;; Insert cross-references
(for-each
(lambda (x)
@@ -823,7 +886,8 @@
(for-each
(lambda (node)
- (insert-node conn node))
+ (and (check-node conn node)
+ (insert-node conn node)))
(reverse node-list))
(pending-fixup conn)

Return to:

Send suggestions and report system problems to the System administrator.