diff options
Diffstat (limited to 'scm')
-rw-r--r-- | scm/dictrans.scm | 78 |
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) |