~ubuntu-branches/ubuntu/trusty/librep/trusty

« back to all changes in this revision

Viewing changes to lisp/rep/xml/printer.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2005-01-14 14:18:11 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050114141811-k2x3wczuc17qai2v
Tags: 0.17-7
Build with -Oo for amd64

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#| rep.xml.printer -- companion XML printer to rep.xml.reader
 
2
 
 
3
   $Id: printer.jl,v 1.1 2002/06/21 05:11:50 jsh Exp $
 
4
 
 
5
   Copyright (C) 2002 John Harper <jsh@unfactored.org>
 
6
 
 
7
   This file is part of librep.
 
8
 
 
9
   librep is free software; you can redistribute it and/or modify it
 
10
   under the terms of the GNU General Public License as published by
 
11
   the Free Software Foundation; either version 2, or (at your option)
 
12
   any later version.
 
13
 
 
14
   librep is distributed in the hope that it will be useful, but
 
15
   WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
   GNU General Public License for more details.
 
18
 
 
19
   You should have received a copy of the GNU General Public License
 
20
   along with librep; see the file COPYING.  If not, write to
 
21
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
|#
 
23
 
 
24
(define-structure rep.xml.printer
 
25
 
 
26
    (export make-xml-output
 
27
            print-xml-item)
 
28
 
 
29
    (open rep
 
30
          rep.regexp)
 
31
 
 
32
  (define make-xml-output identity)
 
33
 
 
34
  (define (substitute-entities string)
 
35
    (string-replace "[<&'\"]"
 
36
                    (lambda ()
 
37
                      (car (rassoc (expand-last-match "\\0")
 
38
                                   '(("lt" . "<")
 
39
                                     ("amp" . "&")
 
40
                                     ("apos" . "'")
 
41
                                     ("quot" . "\"")))))
 
42
                    string))
 
43
 
 
44
  (define (print-params stream params)
 
45
    (mapc (lambda (cell)
 
46
            (format stream " %s=\"%s\""
 
47
                    (car cell) (substitute-entities (cdr cell))))
 
48
          params))
 
49
 
 
50
  (define (print-xml-item stream item)
 
51
    (cond ((stringp item)
 
52
           (write stream (substitute-entities item)))
 
53
 
 
54
          ((eq (car item) '!)
 
55
           (format stream "<!%s>" (nth 1 stream)))
 
56
 
 
57
          ((symbolp (car item))
 
58
           (format stream "<%s" (car item))
 
59
           (print-params stream (nth 1 item))
 
60
           (cond ((string-match "^\\?" (symbol-name (car item)))
 
61
                  (write stream "?>"))
 
62
                 ((null (nthcdr 2 item))
 
63
                  (write stream "/>"))
 
64
                 (t
 
65
                  (write stream #\>)
 
66
                  (mapc (lambda (x)
 
67
                          (print-xml-item stream x)) (nthcdr 2 item))
 
68
                  (format stream "</%s>" (car item)))))
 
69
 
 
70
          (t (error "Unknown item type: %s" item)))))