diff options
Diffstat (limited to 'examples/xml-struct.scm')
-rw-r--r-- | examples/xml-struct.scm | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/examples/xml-struct.scm b/examples/xml-struct.scm new file mode 100644 index 0000000..dd2b662 --- /dev/null +++ b/examples/xml-struct.scm @@ -0,0 +1,63 @@ +;;;; This file is part of Gamma. +;;;; Copyright (C) 2010 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/>. +;;;; +(use-modules (gamma expat)) + +(let ((level 0)) + (letrec ((elt-start (lambda (name attrs) + (display (make-string (* 2 level) #\space)) + (display name) + (for-each + (lambda (x) + (display " ") + (display (car x)) + (display "=") + (display (cdr x))) + attrs) + (newline) + (set! level (1+ level)))) + (elt-end (lambda (name) + (set! level (1- level))))) + (catch 'gamma-xml-error + (lambda () + (xml-parse (xml-make-parser + #:start-element-handler elt-start + #:end-element-handler elt-end))) + (lambda (key func fmt args ctx) + (with-output-to-port + (current-error-port) + (lambda () + (cond + ((not ctx) + (apply format #t fmt args) + (newline)) + (else + (format #t + "~A:~A: ~A~%" + (xml-error-descr ctx #:line) + (xml-error-descr ctx #:column) + (xml-error-string (xml-error-descr ctx #:error-code))) + (if (xml-error-descr ctx #:has-context?) + (let ((ctx-text (xml-error-descr ctx #:context)) + (ctx-pos (xml-error-descr ctx #:error-offset))) + (format #t + "Context (^ marks the point): ~A^~A~%" + (substring ctx-text 0 ctx-pos) + (substring ctx-text ctx-pos)))) + (exit 1))))))))) + + + |