Anonymous avatar Anonymous committed 414fdc2

New interface requires out_channel

Comments (0)

Files changed (8)

-<src/**.cmx>: for-pack(StringPainter)
+<src/**.cmx>: for-pack(StringPainter), unix
 <demo/*>: package(stringpainter)
             psp_infix assoc prio (psp_binop op) (psp_expr e1) (psp_expr e2)
                 
 
-        | Unop (op, e1) -> psp_nested 0
+        | Unop (op, e1) -> psp_group
             [ psp_unop op
             ; psp_expr e1
             ]
 
     
     let test () = List.iter
-        (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl (psp_expr x); print_newline ())
+        (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl stdout (psp_expr x); print_newline ())
         exprs
 end
 
         | App (e1, e2) -> psp_infix
             LeftAssociative
             app_priority
-            (psp_nested 0 [])
+            psp_empty
             (psp_expr e1) (psp_expr e2)
 
-        | Abs (x,e) -> psp_nested 0
+        | Abs (x,e) -> psp_group
             [ psp_keyword "fun"
             ; psp_word x
             ; psp_operator "->"
             ; psp_expr e
             ]
 
-        | Let (x, e1, e2) -> psp_nested 0
+        | Let (x, e1, e2) -> psp_group
             [ psp_keyword "let"
             ; psp_word x
             ; psp_operator "="
 
     
     let test () = List.iter
-        (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl (psp_expr x); print_newline ())
+        (fun (s,x) -> print_string ">> "; print_endline s; print_painter_nl stdout (psp_expr x); print_newline ())
         exprs
 
 end
 all: ${DEMO}
 
 ${DEMO}: Demo.ml
-	${OCAMLC} -I ../_build/src -o ${DEMO} StringPainter.cma Demo.ml
+	${OCAMLC} -I ../_build/src -o ${DEMO} unix.cma StringPainter.cma Demo.ml
 
 clean:
 	rm -f ${DEMO} Demo.cmo Demo.cmi 
 
 val any_multiline : painter list -> bool
 
-val render_painter : painter -> string
+val render_painter : out_channel -> painter -> string
 
-val print_painter : painter -> unit
+val print_painter : out_channel -> painter -> unit
 
-val print_painter_nl : painter -> unit
+val print_painter_nl : out_channel -> painter -> unit
 
 val sp_text : string -> painter
 

src/ColorScheme.ml

     ; cs_special        = [Foreground Magenta]
     }
 
+let select_color_scheme_for_out_channel out_channel = 
+    let fdescr = Unix.descr_of_out_channel out_channel in
+    if Unix.isatty fdescr then
+        default_color_scheme
+    else
+        dummy_color_scheme
+
 (* TODO: remove, escape function should be used directly *)
 type color_scheme_functionalized =
     { fcs_keyword       : string -> string
             ; apply_category   : category -> string -> string
             }
 
-        let empty_driver () =
-            let internal = Internal.empty_context default_color_scheme in
+        let empty_driver color_scheme =
+            let internal = Internal.empty_context color_scheme in
 
             { internal          = internal
             ; break_line        = Internal.break_line internal
             process subcont driver [xs]
 
 
-        let render_painters final_cont xs = 
-            let driver  = empty_driver () in
+        let render_painters out_channel final_cont xs = 
+            let driver  = empty_driver (ColorScheme.select_color_scheme_for_out_channel out_channel) in
             let cont () = Internal.finalize driver.internal final_cont in
             process cont driver [xs]
 
 
     let any_multiline xs = List.exists is_multiline xs
 
-    let render_painter (sp, _) = 
+    let render_painter out_channel (sp, _) = 
         let cont = Buffer.contents in
-        Renderer.render_painters cont sp
-        
+        Renderer.render_painters out_channel cont sp
 
 end
 
 let is_multiline  = Core.is_multiline
 let any_multiline = Core.any_multiline
 
-let render_painter sp = Core.render_painter sp
+(*********************************************************************************************************************
+ * Output
+ ********************************************************************************************************************)
 
-let print_painter sp = print_string (render_painter sp)
-    
-let print_painter_nl sp = print_endline (render_painter sp)
+let render_painter out_channel sp = Core.render_painter out_channel sp
+
+let print_painter out_channel sp = print_string (render_painter out_channel sp)
+
+let print_painter_nl out_channel sp = print_endline (render_painter out_channel sp)
 
 (*********************************************************************************************************************
  * Basic painters

src/Prioritized.ml

  * Output
  *)
 
-let print_painter_nl psp   = Basic.print_painter_nl (get_painter psp)
-let print_painter psp      = Basic.print_painter (get_painter psp)
-let render_painter psp     = Basic.render_painter (get_painter psp)
+let print_painter_nl output_channel psp   = Basic.print_painter_nl output_channel (get_painter psp)
+let print_painter output_channel psp      = Basic.print_painter output_channel (get_painter psp)
+let render_painter output_channel psp     = Basic.render_painter output_channel (get_painter psp)
 
-let print_painters_nl psps = print_painter_nl (psp_group psps)
-let print_painters psps    = print_painter (psp_group psps)
-let render_painters psps   = render_painter (psp_group psps)
+let print_painters_nl output_channel psps = print_painter_nl output_channel (psp_group psps)
+let print_painters output_channel psps    = print_painter output_channel (psp_group psps)
+let render_painters output_channel psps   = render_painter output_channel (psp_group psps)
 

src/Prioritized.mli

 (**
    Prints on standard output with newline.
  *)
-val print_painter_nl  : painter -> unit
+val print_painter_nl  : out_channel -> painter -> unit
 
 (**
    Prints on standard output..
  *)
-val print_painter     : painter -> unit
+val print_painter     : out_channel -> painter -> unit
 
 (**
     Renders painter into string.
  *)
-val render_painter    : painter -> string
+val render_painter    : out_channel -> painter -> string
 
 (**
    Prints on standard output with newline.
  *)
-val print_painters_nl  : painter list -> unit
+val print_painters_nl  : out_channel -> painter list -> unit
 
 (**
    Prints on standard output..
  *)
-val print_painters    : painter list -> unit
+val print_painters    : out_channel -> painter list -> unit
 
 (**
     Renders painter into string.
  *)
-val render_painters   : painter list -> string
+val render_painters   : out_channel -> painter list -> string
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.