Programming JavaFX in Clojure.

fxml.clj

;;; Namespace for gui detail.
(ns clojure.fxml
  (:import
    (java.io StringWriter)
    (javax.xml.stream XMLOutputFactory)
    (javafx.scene.layout AnchorPane GridPane ColumnConstraints Priority)
    (javafx.scene.control TitledPane)
    (javafx.geometry HPos VPos)))

(def fxdoc
  [AnchorPane
    :id "AnchorPane"
    :maxHeight Double/NEGATIVE_INFINITY
    :maxWidth Double/NEGATIVE_INFINITY
    :minHeight Double/NEGATIVE_INFINITY
    :minWidth Double/NEGATIVE_INFINITY
    :prefHeight 400.0
    :prefWidth 600.0
    :xmlns:fx "http://javafx.com/fxml"
    [:children
      [GridPane
        :layoutX 172.0
        :layoutY 162.0
        :prefHeight 94.0
        :prefWidth 272.0
        :style "-fx-background-color: lightgreen"
        [:children
          [TitledPane
            :animated false
            :contentDisplay HPos/LEFT
            :minHeight 16.0
            :minWidth 78.0
            :prefHeight 59.0
            :prefWidth 130.0
            :text "untitled"
            'GridPane/columnIndex 0
            'GridPane/halignment HPos/CENTER
            'GridPane/hgrow Priority/NEVER
            'GridPane/rowIndex 0
            'GridPane/valignment VPos/CENTER
            'GridPane/vgrow Priority/NEVER
            [:content
              [AnchorPane
                :id "Content"
                :minHeight 0.0
                :minWidth 0.0
                :prefHeight 33.0
                :prefWidth 132.0]]]]
        [:columnConstraints
          [ColumnConstraints
            :fillWidth false
            :halignment HPos/LEFT
            :hgrow Priority/ALWAYS
            :maxWidth -1.0
            :minWidth 10.0
            :prefWidth 100.0]]]]])
        
(defn ^{:private true} write-attributes [writer pairs]
  (doseq [pair pairs]
    (let [aname (nth pair 0)
          uname (if (symbol? aname)
                    (let [nsp (namespace (nth pair 0))
                          sym (symbol nsp)
                          rsv (ns-resolve
                                'clojure.fxml
                                 sym)]
                      (str (.getName rsv) "." (name aname)))
                      (name aname))
          avalu (.toString (nth pair 1))]
      (.writeAttribute writer uname avalu))))
  
(defn ^{:private true} write-tags [writer node]
  (let [tag   (.getName (first node))
        chlds (rest node)
        attr? (complement vector?)
        attrs (filter attr? chlds)
        pairs (partition 2 attrs)
        vecs  (filter vector? chlds)]
    (.writeStartElement writer tag)
    (write-attributes writer pairs)
    (doseq [v vecs]
      (write-tags writer v))
    (.writeEndElement writer)))

(defn tofxml [root]
  (let [factory (XMLOutputFactory/newInstance)
        str-wrt (StringWriter. )
        xml-sw  (.createXMLStreamWriter factory str-wrt)]
    (doto xml-sw
      (.writeStartDocument)
      (write-tags root)
      (.writeEndDocument))
    (println (.toString (.getBuffer str-wrt)))))