aboutsummaryrefslogtreecommitdiff
path: root/src/expat.sci
blob: 19e48fe9919ddbed961639066fb1fa26f623b023 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
;;;; This file is part of Gamma.                           -*- scheme -*-
;;;; Copyright (C) 2010, 2015 Sergey Poznyakoff
;;;; 
;;;; Gamma 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, or (at your option)
;;;; any later version.
;;;;
;;;; Gamma 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 Gamma.  If not, see <http://www.gnu.org/licenses/>.

changequote([,])dnl

(define-module (gamma expat)
  :use-module (ice-9 rdelim)
  :use-module (gamma documentation)
  :use-module (srfi srfi-1)
  :export (xml-make-parser
	   xml-parse-more
	   xml-parse
	   xml-set-handler)
  :export-syntax (xml-error-descr))

(if (= (string->number (major-version)) 1)
    (use-syntax (ice-9 syncase)))

(let ((lib-path "LIBDIR/"))
  (load-extension (string-append
		   lib-path "libgamma-expat-v-VERSION") "gamma_expat_init"))

(define (xml-make-parser . rest)
  (if (null? rest)
      (xml-primitive-make-parser)
      (letrec ((parser-setup (lambda (setup handler-args)
			       (let ((p
				      (apply xml-primitive-make-parser setup)))
				 (if (not (null? handler-args))
				     (apply xml-set-handler p handler-args))
				 p))))
	(if (string? (car rest))
	    (let ((encoding (car rest))
		  (rest (cdr rest)))
	      (if (and (not (null? rest)) (char? (car rest)))
		  (parser-setup (list encoding (car rest))
				(cdr rest))

		  (parser-setup (list encoding) rest)))

	    (parser-setup '() rest)))))
	       
(define (xml-parse-more parser input)
  (cond
   ((eof-object? input)
    (xml-primitive-parse parser "" #t))
   (else
    (xml-primitive-parse parser input #f))))

(define (xml-parse parser . args)
  (let ((port (if (null? args)
		  (current-input-port)
		  (car args))))
    (let loop ((line (read-line port 'concat)))
      (xml-parse-more parser line)
      (if (not (eof-object? line))
	  (loop (read-line port 'concat))))))

(define (xml-set-handler parser . rest)
  (if (odd? (length rest))
      (scm-error 'wrong-number-of-args
		 "xml-set-handler"
		 "Wrong number of arguments to ~A"
		 (list "xml-set-handler")
		 #f))

  (for-each
   (lambda (elt)
     (xml-primitive-set-handler parser (car elt) (cdr elt)))
   
   (let ((prev-elem #f))
     (fold-right 
      (lambda (elem prev)
	(cond
	 (prev-elem
	  (let ((ret (cons (cons elem prev-elem) prev)))
	    (set! prev-elem #f)
	    ret))
	 (else
	  (set! prev-elem elem)
	  prev)))
      '()
      rest))))

(define-syntax xml-error-descr
  (syntax-rules ()
    ((xml-error-descr ctx #:error-code)
     (list-ref ctx 0))
    ((xml-error-descr ctx #:line)
     (list-ref ctx 1))
    ((xml-error-descr ctx #:column)
     (list-ref ctx 2))
    ((xml-error-descr ctx #:context)
     (list-ref ctx 3))
    ((xml-error-descr ctx #:error-offset)
     (list-ref ctx 4))
    ((xml-error-descr ctx #:has-context?)
     (= (length ctx) 5))))

;;;; End of expat.scm

Return to:

Send suggestions and report system problems to the System administrator.