YAML: expose libyaml's emitter options, use unicode mode by default

extra/yaml/config/authors.txt

@@ -0,0 +1 @@
+Jon Harper

extra/yaml/config/config-docs.factor

@@ -0,0 +1,44 @@
+! Copyright (C) 2014 Jon Harper.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax yaml.ffi ;
+IN: yaml.config
+
+HELP: +libyaml-default+
+{ $var-description "Setting a variable in the following list to " { $link +libyaml-default+ } " leaves libyaml's default options:" }
+{ $subsections
+  emitter-canonical
+  emitter-indent
+  emitter-line-break
+  emitter-unicode
+  emitter-width
+} ;
+
+
+HELP: emitter-canonical
+{ $var-description "If set, " { $link yaml_emitter_set_canonical } " is called with the value of this variable at the beginning of each document." } ;
+
+HELP: emitter-indent
+{ $var-description "If set, " { $link yaml_emitter_set_indent } " is called with the value of this variable at the beginning of each document." } ;
+
+HELP: emitter-line-break
+{ $var-description "If set, " { $link yaml_emitter_set_break } " is called with the value of this variable at the beginning of each document." } ;
+
+HELP: emitter-unicode
+{ $var-description "If set, " { $link yaml_emitter_set_unicode } " is called with the value of this variable at the beginning of each document." } ;
+
+HELP: emitter-width
+{ $var-description "If set, " { $link yaml_emitter_set_width } " is called with the value of this variable at the beginning of each document." } ;
+
+ARTICLE: "yaml-config" "YAML control variables"
+"The following variables control the YAML serialization/deserialization: "
+{ $subsections
+  emitter-canonical
+  emitter-indent
+  emitter-line-break
+  emitter-unicode
+  emitter-width
+}
+"Using libyaml's default values: " { $link +libyaml-default+ }
+;
+
+ABOUT: "yaml-config"

extra/yaml/config/config.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2014 Jon Harper.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces sequences ;
+IN: yaml.config
+
+! Configuration
+! The following are libyaml's emitter configuration options
+SYMBOL: emitter-canonical
+SYMBOL: emitter-indent
+SYMBOL: emitter-width
+SYMBOL: emitter-unicode
+SYMBOL: emitter-line-break
+
+! Set this value to keep libyaml's default
+SYMBOL: +libyaml-default+
+
+{ 
+    emitter-canonical
+    emitter-indent
+    emitter-width
+    emitter-line-break
+} [ +libyaml-default+ swap set-global ] each
+! But Factor is unicode-friendly by default
+t emitter-unicode set-global

extra/yaml/yaml-docs.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs byte-arrays hash-sets hashtables
 help.markup help.syntax kernel linked-assocs math sequences sets
-strings yaml.ffi ;
+strings yaml.ffi yaml.config ;
 IN: yaml
 
 HELP: >yaml
@@ -154,6 +154,7 @@ ARTICLE: "yaml" "YAML serialization"
 "yaml-output"
 "yaml-input"
 "yaml-errors"
+"yaml-config"
 }
 { $examples
   { $example "USING: prettyprint yaml ;"

extra/yaml/yaml.factor

@@ -5,8 +5,8 @@ classes.struct combinators combinators.extras
 combinators.short-circuit destructors fry generalizations
 hashtables hashtables.identity io.encodings.string
 io.encodings.utf8 kernel libc linked-assocs locals make math
-math.parser namespaces sequences sets strings yaml.conversion
+math.parser namespaces sequences sets strings yaml.config
-yaml.ffi ;
+yaml.conversion yaml.ffi ;
 FROM: sets => set ;
 IN: yaml
 
@@ -417,11 +417,25 @@ M: set emit-value ( emitter event anchor set -- )
     [ nip emit-set-body ]
     [ 2drop emit-assoc-end ] 4tri ;
 
+: unless-libyaml-default ( variable quot -- )
+    [ get dup +libyaml-default+ = not ] dip
+    [ 2drop ] if ; inline
+
+: init-emitter-options ( emitter -- )
+    {
+        [ emitter-canonical [ yaml_emitter_set_canonical ] unless-libyaml-default ]
+        [ emitter-indent [ yaml_emitter_set_indent ] unless-libyaml-default ]
+        [ emitter-width [ yaml_emitter_set_width ] unless-libyaml-default ]
+        [ emitter-unicode [ yaml_emitter_set_unicode ] unless-libyaml-default ]
+        [ emitter-line-break [ yaml_emitter_set_break ] unless-libyaml-default ]
+    } cleave ;
+
 ! registers destructors (use with with-destructors)
 :: init-emitter ( -- emitter event )
     yaml_emitter_t (malloc-struct) &free :> emitter
     emitter yaml_emitter_initialize yaml-initialize-assert-ok
     emitter &yaml_emitter_delete drop
+    emitter init-emitter-options
 
     BV{ } clone :> output
     output yaml-write-buffer set-global