Mercurial > lasercutter

     1 ;;; xml.clj -- a pretty print dispatch version of prxml.clj -- a compact syntax for generating XML

     2 

     3 ;; by Tom Faulhaber, based on the original by Stuart Sierra, http://stuartsierra.com/

     4 ;; May 13, 2009

     5 

     6 ;; Copyright (c) 2009 Tom Faulhaber/Stuart Sierra. All rights reserved.  The use and

     7 ;; distribution terms for this software are covered by the Eclipse

     8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     9 ;; which can be found in the file epl-v10.html at the root of this

    10 ;; distribution.  By using this software in any fashion, you are

    11 ;; agreeing to be bound by the terms of this license.  You must not

    12 ;; remove this notice, or any other, from this software.

    13 

    14 

    15 ;; See function "prxml" at the bottom of this file for documentation.

    16 

    17 

    18 (ns 

    19   #^{:author "Tom Faulhaber, based on the original by Stuart Sierra",

    20      :doc "A version of prxml that uses a pretty print dispatch function."}

    21   clojure.contrib.pprint.examples.xml

    22   (:use [clojure.contrib.string :only (as-str escape)]

    23         [clojure.contrib.pprint :only (formatter-out write)]

    24         [clojure.contrib.pprint.utilities :only (prlabel)]))

    25 

    26 (def

    27  #^{:doc "If true, empty tags will have a space before the closing />"}

    28  *html-compatible* false)

    29 

    30 (def

    31  #^{:doc "The number of spaces to indent sub-tags."}

    32  *prxml-indent* 2)

    33 

    34 (defmulti #^{:private true} print-xml-tag (fn [tag attrs content] tag))

    35 

    36 (defmethod print-xml-tag :raw! [tag attrs contents]

    37   (doseq [c contents] (print c)))

    38 

    39 (defmethod print-xml-tag :comment! [tag attrs contents]

    40   (print "<!-- ")

    41   (doseq [c contents] (print c))

    42   (print " -->"))

    43 

    44 (defmethod print-xml-tag :decl! [tag attrs contents]

    45   (let [attrs (merge {:version "1.0" :encoding "UTF-8"}

    46                      attrs)]

    47     ;; Must enforce ordering of pseudo-attributes:

    48     ((formatter-out "<?xml version=\"~a\" encoding=\"~a\"~@[ standalone=\"~a\"~]?>") 

    49      (:version attrs) (:encoding attrs) (:standalone attrs))))

    50 

    51 (defmethod print-xml-tag :cdata! [tag attrs contents]

    52   ((formatter-out "<[!CDATA[~{~a~}]]>") contents))

    53 

    54 (defmethod print-xml-tag :doctype! [tag attrs contents]

    55   ((formatter-out "<[!DOCTYPE [~{~a~}]]>") contents))

    56 

    57 (defmethod print-xml-tag :default [tag attrs contents]

    58   (let [tag-name (as-str tag)

    59         xlated-attrs (map #(vector (as-str (key %)) (as-str (val %))) attrs)]

    60     (if (seq contents)

    61       ((formatter-out "~<~<<~a~1:i~{ ~:_~{~a=\"~a\"~}~}>~:>~vi~{~_~w~}~0i~_</~a>~:>")

    62        [[tag-name xlated-attrs] *prxml-indent* contents tag-name])

    63       ((formatter-out "~<<~a~1:i~{~:_ ~{~a=\"~a\"~}~}/>~:>") [tag-name xlated-attrs]))))

    64 

    65 

    66 (defmulti xml-dispatch class)

    67 

    68 (defmethod xml-dispatch clojure.lang.IPersistentVector [x]

    69   (let [[tag & contents] x

    70         [attrs content] (if (map? (first contents))

    71                           [(first contents) (rest contents)]

    72                           [{} contents])]

    73     (print-xml-tag tag attrs content)))

    74 

    75 (defmethod xml-dispatch clojure.lang.ISeq [x]

    76   ;; Recurse into sequences, so we can use (map ...) inside prxml.

    77   (doseq [c x] (xml-dispatch c)))

    78 

    79 (defmethod xml-dispatch clojure.lang.Keyword [x]

    80   (print-xml-tag x {} nil))

    81 

    82 

    83 (defmethod xml-dispatch String [x]

    84   (print (escape {\< "&lt;"

    85                   \> "&gt;"

    86                   \& "&amp;"

    87                   \' "&apos;"

    88                   \" "&quot;"} x)))

    89 

    90 (defmethod xml-dispatch nil [x])

    91 

    92 (defmethod xml-dispatch :default [x]

    93   (print x))

    94 

    95 

    96 (defn prxml

    97   "Print XML to *out*.  Vectors become XML tags: the first item is the

    98   tag name; optional second item is a map of attributes.

    99 

   100   Sequences are processed recursively, so you can use map and other

   101   sequence functions inside prxml.

   102 

   103     (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]])

   104     ; => <p class=\"greet\"><i>Ladies &amp; gentlemen</i></p>

   105 

   106   PSEUDO-TAGS: some keywords have special meaning:

   107 

   108     :raw!      do not XML-escape contents

   109     :comment!  create an XML comment

   110     :decl!     create an XML declaration, with attributes

   111     :cdata!    create a CDATA section

   112     :doctype!  create a DOCTYPE!

   113 

   114     (prxml [:p [:raw! \"<i>here & gone</i>\"]])

   115     ; => <p><i>here & gone</i></p>

   116 

   117     (prxml [:decl! {:version \"1.1\"}])

   118     ; => <?xml version=\"1.1\" encoding=\"UTF-8\"?>"

   119   [& args]

   120   (doseq [arg args] (write arg :dispatch xml-dispatch))

   121   (when (pos? (count args)) (newline)))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children