Commits

Paweł Wieczorek committed 4f7757c

Moving out code from Engine

Comments (0)

Files changed (8)

-open StringPainter
+open StringPainter.Basic
 
 
 module ArithmeticExpressions = struct

src/ANSI_Colors.ml

+(*********************************************************************************************************************
+ * Copyrights (C) by
+ *  Pawel Wieczorek <wieczyk gmail>
+ *
+ * http://bitbucket.org/wieczyk/ocaml-stringpainter
+ ********************************************************************************************************************)
+
+
+(*********************************************************************************************************************
+ * ANSI escapes codes
+ ********************************************************************************************************************)
+
+type color
+    = Black
+    | Red
+    | Green
+    | Yellow
+    | Blue
+    | Magenta
+    | Cyan
+    | White
+
+let code_of_color = function
+    | Black ->   0
+    | Red ->     1
+    | Green ->   2
+    | Yellow ->  3
+    | Blue ->    4
+    | Magenta -> 5
+    | Cyan ->    6
+    | White ->   7
+
+type attribute
+    = Bright
+    | Reverse
+    | Underline
+    | Blink
+    | Background of color
+    | Foreground of color
+
+let code_of_attribute = function
+    | Bright -> 1
+    | Reverse -> 7
+    | Underline -> 4
+    | Blink     -> 5
+    | Background color -> 40 + code_of_color color
+    | Foreground color -> 30 + code_of_color color
+
+let escape codes str =
+    let f = fun str c -> str ^ ";" ^ string_of_int (code_of_attribute c)
+    in
+
+(List.fold_left f "\027[" codes) ^ "m" ^ str ^ "\027[0m"
+
+(*********************************************************************************************************************
+ * Copyrights (C) by
+ *  Pawel Wieczorek <wieczyk gmail>
+ *
+ * http://bitbucket.org/wieczyk/ocaml-stringpainter
+ ********************************************************************************************************************)
+
+
+include Engine
+
+let sp_indent_when_multiline sp =
+    if any_multiline sp
+    then sp_indent sp
+    else sp_nested sp
+
+let sp_value_int x = sp_value (string_of_int x)
+
+
+let sp_list opening closing separator = function
+    | [] -> sp_nested
+        [ opening
+        ; closing
+        ]
+
+    | [x] -> sp_nested
+        [ opening
+        ; x
+        ; closing
+        ]
+
+    | x::xs -> sp_nested
+        [ opening
+        ; x
+        ; sp_nested (List.map (fun y -> sp_nested [separator; y]) xs)
+        ; closing
+        ]
+
+let sp_opening_square_bracket = sp_syntax "["
+let sp_closing_square_bracket = sp_syntax "]"
+
+let sp_opening_bracket  = sp_syntax "("
+let sp_coma             = sp_syntax ","
+let sp_semicolon        = sp_syntax ";"
+let sp_closing_bracket  = sp_syntax ")"
+
+let sp_std_list = sp_list sp_opening_bracket sp_closing_bracket sp_coma
+let sp_ml_list  = sp_list sp_opening_square_bracket sp_closing_square_bracket sp_semicolon
+
+

src/ColorScheme.ml

+(*********************************************************************************************************************
+ * Copyrights (C) by
+ *  Pawel Wieczorek <wieczyk gmail>
+ *
+ * http://bitbucket.org/wieczyk/ocaml-stringpainter
+ ********************************************************************************************************************)
+
+
+open ANSI_Colors
+
+type color_scheme =
+    { cs_keyword        : attribute list
+    ; cs_value          : attribute list
+    ; cs_value_keyword  : attribute list
+    ; cs_operator       : attribute list
+    ; cs_syntax         : attribute list
+    }
+
+let dummy_color_scheme =
+    { cs_keyword        = []
+    ; cs_value          = []
+    ; cs_value_keyword  = []
+    ; cs_operator       = []
+    ; cs_syntax         = []
+    }
+
+let default_color_scheme =
+    { cs_keyword        = [Bright; Underline]
+    ; cs_value          = [Foreground Cyan]
+    ; cs_value_keyword  = [Bright; Foreground Cyan]
+    ; cs_operator       = [Foreground Yellow]
+    ; cs_syntax         = [Bright; Foreground Black]
+    }
+
+type color_scheme_functionalized =
+    { fcs_keyword       : string -> string
+    ; fcs_value         : string -> string
+    ; fcs_value_keyword : string -> string
+    ; fcs_operator      : string -> string
+    ; fcs_syntax        : string -> string
+    }
+
+let functionalize cs = 
+    { fcs_keyword       = escape cs.cs_keyword
+    ; fcs_value         = escape cs.cs_value
+    ; fcs_value_keyword = escape cs.cs_value_keyword
+    ; fcs_operator      = escape cs.cs_operator
+    ; fcs_syntax        = escape cs.cs_syntax
+    }
+
+(*********************************************************************************************************************
+ * Copyrights (C) by
+ *  Pawel Wieczorek <wieczyk gmail>
+ *
+ * http://bitbucket.org/wieczyk/ocaml-stringpainter
+ ********************************************************************************************************************)
+
+(*********************************************************************************************************************
+ * The core of whole system
+ *   
+ * +--LIBRARY--+           +---CORE---+               +---CORE---+  
+ * |  various  |  encode   |   real   |  preprocess   |  simple  |  render
+ * | painters  | ========> | painters | ============> | painters | =======> string
+ * +-----------+           +----------+               +----------+
+ *
+ ********************************************************************************************************************)
+
+module Core = struct
+
+    type attribute
+        = A_None
+        | A_Keyword
+        | A_Value
+        | A_ValueKeyword
+        | A_Oper
+        | A_Syntax
+
+    type simple
+        = S_Text of string
+        | S_TextA of string * attribute
+        | S_Break
+        | S_NewLine
+
+        (* nested *)
+        | S_Nested of simple list
+        | S_Indent of simple list
+
+    type painter = simple list * bool
+
+    type t
+        (* Syntactical categories, they are distinct due to color scheme *)
+        = Text of string
+        | Word of string
+        | Keyword of string
+        | Value of string
+        | ValueKeyword of string
+        | Operator of string
+        | Label of string
+        | Syntax of string
+
+        (* Line break *)
+        | Break
+        | NewLine
+
+        (* Nested *)
+        | Nested of t list
+        | Indent of t list
+        | Painter of painter
+
+    (*----------------------------------------------------------------------------------------------------------------
+     * Renderer
+     *)
+
+    module Renderer = struct
+
+        open ColorScheme
+
+        module Internal = struct 
+
+            let eol = "\n"
+            let tab = "    "
+
+            type t =
+                { buffer        : Buffer.t
+                ; line          : Buffer.t
+                ; indent        : int ref
+                ; weak_break    : bool ref
+                ; color_scheme  : color_scheme_functionalized
+                }
+
+            let empty_context cs =
+                { buffer        = Buffer.create 1024
+                ; line          = Buffer.create 120
+                ; indent        = ref 0
+                ; weak_break    = ref false
+                ; color_scheme  = functionalize cs
+                }
+
+            let buffer_empty b = Buffer.length b == 0
+
+            let indent internal = 
+                for i = 1 to !(internal.indent) do
+                    Buffer.add_string internal.buffer tab
+                done
+
+            let _break_line internal forced add_eol =
+                if not (buffer_empty internal.line) || forced
+                then begin
+                    indent internal;
+                    Buffer.add_string internal.buffer (Buffer.contents internal.line);
+                    if add_eol then Buffer.add_string internal.buffer eol;
+                    Buffer.reset internal.line
+                end
+
+            let break_line internal forced = _break_line internal forced true
+
+            let add_text internal text =
+                Buffer.add_string internal.line text
+
+            let finalize internal cont =
+                _break_line internal false false;
+                cont internal.buffer
+
+            let increment_indent internal =
+                incr internal.indent
+
+            let decrement_indent internal =
+                decr internal.indent
+
+            let set_weak_break internal =
+                internal.weak_break := true
+
+            let flush_weak_break internal =
+                internal.weak_break := false;
+                Buffer.add_string internal.buffer eol
+
+            let apply_attribute internal = function
+                | A_None            -> fun x -> x
+                | A_Keyword         -> internal.color_scheme.fcs_keyword
+                | A_Value           -> internal.color_scheme.fcs_value
+                | A_ValueKeyword    -> internal.color_scheme.fcs_value_keyword
+                | A_Oper            -> internal.color_scheme.fcs_operator
+                | A_Syntax          -> internal.color_scheme.fcs_syntax
+
+
+        end
+
+        type driver =
+            { internal          : Internal.t
+            ; break_line        : bool -> unit 
+            ; add_text          : string -> unit
+            ; increment_indent  : unit -> unit
+            ; decrement_indent  : unit -> unit
+            ; set_weak_break    : unit -> unit
+            ; flush_weak_break  : unit -> unit
+            ; apply_attribute   : attribute -> string -> string
+            }
+
+        let empty_driver () =
+            let internal = Internal.empty_context default_color_scheme in
+
+            { internal          = internal
+            ; break_line        = Internal.break_line internal
+            ; add_text          = Internal.add_text internal
+            ; increment_indent  = (fun () -> Internal.increment_indent internal)
+            ; decrement_indent  = (fun () -> Internal.decrement_indent internal)
+            ; set_weak_break    = (fun () -> Internal.set_weak_break internal)
+            ; flush_weak_break  = (fun () -> Internal.flush_weak_break internal)
+            ; apply_attribute   = Internal.apply_attribute internal
+            }
+
+
+        let rec process cont driver = function
+            (* Text *)
+            | (S_Text s :: rest) :: stack ->
+                driver.add_text s;
+                process cont driver (rest :: stack)
+
+            | (S_TextA (s, a) :: rest) :: stack ->
+                driver.add_text (driver.apply_attribute a s);
+                process cont driver (rest :: stack)
+
+            (* Breaking lines *)
+            | (S_Break :: rest) :: stack ->
+                driver.break_line false;
+                process cont driver (rest :: stack)
+
+            | (S_NewLine :: rest) :: stack ->
+                driver.break_line true;
+                process cont driver (rest :: stack)
+
+            (* Nesting *)
+            | (S_Nested xs :: rest) :: stack ->
+                process cont driver (xs :: rest :: stack)
+
+            | (S_Indent xs :: rest) :: stack ->
+                indent_process cont driver xs (rest :: stack) 
+
+            (* Rest *)
+            | [] :: stack ->
+                process cont driver stack
+
+            | [] ->
+                cont ()
+
+        and indent_process cont driver xs stack =
+            let subcont () =
+                driver.break_line false;
+                driver.decrement_indent (); 
+                process cont driver stack
+                in
+            driver.break_line false;
+            driver.increment_indent (); 
+            process subcont driver [xs]
+
+
+        let render_painters final_cont xs = 
+            let driver  = empty_driver () in
+            let cont () = Internal.finalize driver.internal final_cont in
+            process cont driver [xs]
+
+    end
+
+    (*----------------------------------------------------------------------------------------------------------------
+     * Preprocessor
+     *)
+
+    module Preprocessor = struct
+
+        let nested multiline xs = (xs, multiline)
+
+        let rec process multiline = function
+            | Text txt :: rest ->
+                process_text multiline rest 
+                    [ S_Text txt
+                    ]
+
+            | Word txt :: rest
+            | Label txt :: rest ->
+                process_text multiline rest 
+                    [ S_Text txt
+                    ; S_Text " "
+                    ]
+
+            | Operator txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextA (txt, A_Oper)
+                    ; S_Text " "
+                    ]
+
+            | Keyword txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextA (txt, A_Keyword)
+                    ; S_Text " "
+                    ]
+
+            | Syntax txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextA (txt, A_Syntax)
+                    ; S_Text " "
+                    ]
+
+            | Value txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextA (txt, A_Value)
+                    ; S_Text " "
+                    ]
+
+            | ValueKeyword txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextA (txt, A_ValueKeyword)
+                    ; S_Text " "
+                    ]
+
+            | Indent xs :: rest ->
+                let (simple', multiline')   = process multiline rest in
+                let (simple'', multiline'') = process false xs in
+                nested true
+                    [ S_Indent simple''
+                    ; S_Nested simple'
+                    ]
+
+            | Nested xs :: rest ->
+                let (simple', multiline')   = process multiline rest in
+                let (simple'', multiline'') = process false xs in
+                nested (multiline' || multiline'')
+                    [ S_Nested simple'
+                    ; S_Nested simple''
+                    ]
+
+            | Break :: rest ->
+                nested true [S_Break]
+
+            | NewLine :: rest ->
+                nested true [S_NewLine]
+
+            | Painter (c_simple, c_multiline) :: rest ->
+                let (simple', multiline') = process multiline rest in
+                nested (multiline' || c_multiline)
+                    [ S_Nested c_simple
+                    ; S_Nested simple'
+                    ]
+
+            | [] ->
+                ([], multiline)
+
+        and process_text multiline rest res =
+                let (simple', multiline') = process multiline rest in
+                nested (multiline' || multiline)
+                    [ S_Nested res
+                    ; S_Nested simple'
+                    ]
+
+        let preprocess_painters finalcont xs =
+            finalcont (process false xs)
+
+    end
+
+
+    (*----------------------------------------------------------------------------------------------------------------
+     * Interface
+     *)
+
+    let preprocess xs = 
+        let cont (simple, multiline) = (simple, multiline) in
+        Preprocessor.preprocess_painters cont xs
+
+    let from_painter p = Painter p
+
+    let is_multiline (_, multiline) = multiline
+
+    let any_multiline xs = List.exists is_multiline xs
+
+    let render_painter (sp, _) = 
+        let cont = Buffer.contents in
+        Renderer.render_painters cont sp
+        
+
+end
+
+open Core
+
+type painter = Core.painter
+
+let mk_painter xs = preprocess
+    (List.map from_painter xs)
+
+let is_multiline  = Core.is_multiline
+let any_multiline = Core.any_multiline
+
+let render_painter sp = Core.render_painter sp
+
+let print_painter sp = print_string (render_painter sp)
+    
+let print_painter_nl sp = print_endline (render_painter sp)
+
+(*********************************************************************************************************************
+ * Basic painters
+ ********************************************************************************************************************)
+
+let sp_text txt = preprocess
+    [ Text txt
+    ]
+
+let sp_word txt = preprocess
+    [ Word txt
+    ]
+
+let sp_keyword txt = preprocess
+    [ Keyword txt
+    ]
+
+let sp_value_keyword txt = preprocess
+    [ ValueKeyword txt
+    ]
+
+let sp_value txt = preprocess
+    [ Value txt
+    ]
+
+let sp_operator txt = preprocess
+    [ Operator txt
+    ]
+
+let sp_syntax txt = preprocess
+    [ Syntax txt
+    ]
+
+let sp_nested xs = mk_painter
+    xs
+
+let sp_indent xs = preprocess
+    [ Indent (List.map from_painter xs)
+    ]
+
+let sp_break = preprocess
+    [ Break
+    ]
+
+let sp_newline = preprocess
+    [ NewLine
+    ]
+

src/StringPainter.ml

-(*********************************************************************************************************************
- * Copyrights (C) by
- *  Pawel Wieczorek <wieczyk gmail>
- *
- * http://bitbucket.org/wieczyk/ocaml-stringpainter
- ********************************************************************************************************************)
-
-
-(*********************************************************************************************************************
- * Imports
- ********************************************************************************************************************)
-
-module ANSI_Colors = StringPainter_ANSI_Colors
-module ColorScheme = StringPainter_ColorScheme
-
-(*********************************************************************************************************************
- * The core of whole system
- *   
- * +--LIBRARY--+           +---CORE---+               +---CORE---+  
- * |  various  |  encode   |   real   |  preprocess   |  simple  |  render
- * | painters  | ========> | painters | ============> | painters | =======> string
- * +-----------+           +----------+               +----------+
- *
- ********************************************************************************************************************)
-
-module Core = struct
-
-    type attribute
-        = A_None
-        | A_Keyword
-        | A_Value
-        | A_ValueKeyword
-        | A_Oper
-        | A_Syntax
-
-    type simple
-        = S_Text of string
-        | S_TextA of string * attribute
-        | S_Break
-        | S_NewLine
-
-        (* nested *)
-        | S_Nested of simple list
-        | S_Indent of simple list
-
-    type painter = simple list * bool
-
-    type t
-        (* Syntactical categories, they are distinct due to color scheme *)
-        = Text of string
-        | Word of string
-        | Keyword of string
-        | Value of string
-        | ValueKeyword of string
-        | Operator of string
-        | Label of string
-        | Syntax of string
-
-        (* Line break *)
-        | Break
-        | NewLine
-
-        (* Nested *)
-        | Nested of t list
-        | Indent of t list
-        | Painter of painter
-
-    (*----------------------------------------------------------------------------------------------------------------
-     * Renderer
-     *)
-
-    module Renderer = struct
-
-        open ColorScheme
-
-        module Internal = struct 
-
-            let eol = "\n"
-            let tab = "    "
-
-            type t =
-                { buffer        : Buffer.t
-                ; line          : Buffer.t
-                ; indent        : int ref
-                ; weak_break    : bool ref
-                ; color_scheme  : color_scheme_functionalized
-                }
-
-            let empty_context cs =
-                { buffer        = Buffer.create 1024
-                ; line          = Buffer.create 120
-                ; indent        = ref 0
-                ; weak_break    = ref false
-                ; color_scheme  = functionalize cs
-                }
-
-            let buffer_empty b = Buffer.length b == 0
-
-            let indent internal = 
-                for i = 1 to !(internal.indent) do
-                    Buffer.add_string internal.buffer tab
-                done
-
-            let _break_line internal forced add_eol =
-                if not (buffer_empty internal.line) || forced
-                then begin
-                    indent internal;
-                    Buffer.add_string internal.buffer (Buffer.contents internal.line);
-                    if add_eol then Buffer.add_string internal.buffer eol;
-                    Buffer.reset internal.line
-                end
-
-            let break_line internal forced = _break_line internal forced true
-
-            let add_text internal text =
-                Buffer.add_string internal.line text
-
-            let finalize internal cont =
-                _break_line internal false false;
-                cont internal.buffer
-
-            let increment_indent internal =
-                incr internal.indent
-
-            let decrement_indent internal =
-                decr internal.indent
-
-            let set_weak_break internal =
-                internal.weak_break := true
-
-            let flush_weak_break internal =
-                internal.weak_break := false;
-                Buffer.add_string internal.buffer eol
-
-            let apply_attribute internal = function
-                | A_None            -> fun x -> x
-                | A_Keyword         -> internal.color_scheme.fcs_keyword
-                | A_Value           -> internal.color_scheme.fcs_value
-                | A_ValueKeyword    -> internal.color_scheme.fcs_value_keyword
-                | A_Oper            -> internal.color_scheme.fcs_operator
-                | A_Syntax          -> internal.color_scheme.fcs_syntax
-
-
-        end
-
-        type driver =
-            { internal          : Internal.t
-            ; break_line        : bool -> unit 
-            ; add_text          : string -> unit
-            ; increment_indent  : unit -> unit
-            ; decrement_indent  : unit -> unit
-            ; set_weak_break    : unit -> unit
-            ; flush_weak_break  : unit -> unit
-            ; apply_attribute   : attribute -> string -> string
-            }
-
-        let empty_driver () =
-            let internal = Internal.empty_context default_color_scheme in
-
-            { internal          = internal
-            ; break_line        = Internal.break_line internal
-            ; add_text          = Internal.add_text internal
-            ; increment_indent  = (fun () -> Internal.increment_indent internal)
-            ; decrement_indent  = (fun () -> Internal.decrement_indent internal)
-            ; set_weak_break    = (fun () -> Internal.set_weak_break internal)
-            ; flush_weak_break  = (fun () -> Internal.flush_weak_break internal)
-            ; apply_attribute   = Internal.apply_attribute internal
-            }
-
-
-        let rec process cont driver = function
-            (* Text *)
-            | (S_Text s :: rest) :: stack ->
-                driver.add_text s;
-                process cont driver (rest :: stack)
-
-            | (S_TextA (s, a) :: rest) :: stack ->
-                driver.add_text (driver.apply_attribute a s);
-                process cont driver (rest :: stack)
-
-            (* Breaking lines *)
-            | (S_Break :: rest) :: stack ->
-                driver.break_line false;
-                process cont driver (rest :: stack)
-
-            | (S_NewLine :: rest) :: stack ->
-                driver.break_line true;
-                process cont driver (rest :: stack)
-
-            (* Nesting *)
-            | (S_Nested xs :: rest) :: stack ->
-                process cont driver (xs :: rest :: stack)
-
-            | (S_Indent xs :: rest) :: stack ->
-                indent_process cont driver xs (rest :: stack) 
-
-            (* Rest *)
-            | [] :: stack ->
-                process cont driver stack
-
-            | [] ->
-                cont ()
-
-        and indent_process cont driver xs stack =
-            let subcont () =
-                driver.break_line false;
-                driver.decrement_indent (); 
-                process cont driver stack
-                in
-            driver.break_line false;
-            driver.increment_indent (); 
-            process subcont driver [xs]
-
-
-        let render_painters final_cont xs = 
-            let driver  = empty_driver () in
-            let cont () = Internal.finalize driver.internal final_cont in
-            process cont driver [xs]
-
-    end
-
-    (*----------------------------------------------------------------------------------------------------------------
-     * Preprocessor
-     *)
-
-    module Preprocessor = struct
-
-        let nested multiline xs = (xs, multiline)
-
-        let rec process multiline = function
-            | Text txt :: rest ->
-                process_text multiline rest 
-                    [ S_Text txt
-                    ]
-
-            | Word txt :: rest
-            | Label txt :: rest ->
-                process_text multiline rest 
-                    [ S_Text txt
-                    ; S_Text " "
-                    ]
-
-            | Operator txt :: rest ->
-                process_text multiline rest 
-                    [ S_TextA (txt, A_Oper)
-                    ; S_Text " "
-                    ]
-
-            | Keyword txt :: rest ->
-                process_text multiline rest 
-                    [ S_TextA (txt, A_Keyword)
-                    ; S_Text " "
-                    ]
-
-            | Syntax txt :: rest ->
-                process_text multiline rest 
-                    [ S_TextA (txt, A_Syntax)
-                    ; S_Text " "
-                    ]
-
-            | Value txt :: rest ->
-                process_text multiline rest 
-                    [ S_TextA (txt, A_Value)
-                    ; S_Text " "
-                    ]
-
-            | ValueKeyword txt :: rest ->
-                process_text multiline rest 
-                    [ S_TextA (txt, A_ValueKeyword)
-                    ; S_Text " "
-                    ]
-
-            | Indent xs :: rest ->
-                let (simple', multiline')   = process multiline rest in
-                let (simple'', multiline'') = process false xs in
-                nested true
-                    [ S_Indent simple''
-                    ; S_Nested simple'
-                    ]
-
-            | Nested xs :: rest ->
-                let (simple', multiline')   = process multiline rest in
-                let (simple'', multiline'') = process false xs in
-                nested (multiline' || multiline'')
-                    [ S_Nested simple'
-                    ; S_Nested simple''
-                    ]
-
-            | Break :: rest ->
-                nested true [S_Break]
-
-            | NewLine :: rest ->
-                nested true [S_NewLine]
-
-            | Painter (c_simple, c_multiline) :: rest ->
-                let (simple', multiline') = process multiline rest in
-                nested (multiline' || c_multiline)
-                    [ S_Nested c_simple
-                    ; S_Nested simple'
-                    ]
-
-            | [] ->
-                ([], multiline)
-
-        and process_text multiline rest res =
-                let (simple', multiline') = process multiline rest in
-                nested (multiline' || multiline)
-                    [ S_Nested res
-                    ; S_Nested simple'
-                    ]
-
-        let preprocess_painters finalcont xs =
-            finalcont (process false xs)
-
-    end
-
-
-    (*----------------------------------------------------------------------------------------------------------------
-     * Interface
-     *)
-
-    let preprocess xs = 
-        let cont (simple, multiline) = (simple, multiline) in
-        Preprocessor.preprocess_painters cont xs
-
-    let from_painter p = Painter p
-
-    let is_multiline (_, multiline) = multiline
-
-    let any_multiline xs = List.exists is_multiline xs
-
-    let render_painter (sp, _) = 
-        let cont = Buffer.contents in
-        Renderer.render_painters cont sp
-        
-
-end
-
-open Core
-
-type painter = Core.painter
-
-let mk_painter xs = preprocess
-    (List.map from_painter xs)
-
-let is_multiline  = Core.is_multiline
-let any_multiline = Core.any_multiline
-
-let render_painter sp = Core.render_painter sp
-
-let print_painter sp = print_string (render_painter sp)
-    
-let print_painter_nl sp = print_endline (render_painter sp)
-
-(*********************************************************************************************************************
- * Basic painters
- ********************************************************************************************************************)
-
-module CoreWrap = struct
-
-    let sp_text txt = preprocess
-        [ Text txt
-        ]
-
-    let sp_word txt = preprocess
-        [ Word txt
-        ]
-
-    let sp_keyword txt = preprocess
-        [ Keyword txt
-        ]
-
-    let sp_value_keyword txt = preprocess
-        [ ValueKeyword txt
-        ]
-
-    let sp_value txt = preprocess
-        [ Value txt
-        ]
-
-    let sp_operator txt = preprocess
-        [ Operator txt
-        ]
-
-    let sp_syntax txt = preprocess
-        [ Syntax txt
-        ]
-
-    let sp_nested xs = mk_painter
-        xs
-
-    let sp_indent xs = preprocess
-        [ Indent (List.map from_painter xs)
-        ]
-
-    let sp_break = preprocess
-        [ Break
-        ]
-
-    let sp_newline = preprocess
-        [ NewLine
-        ]
-
-end
-
-include CoreWrap
-
-module BasicPainters = struct
-
-    let sp_indent_when_multiline sp =
-        if any_multiline sp
-        then sp_indent sp
-        else sp_nested sp
-
-    let sp_value_int x = sp_value (string_of_int x)
-
-
-    let sp_list opening closing separator = function
-        | [] -> sp_nested
-            [ opening
-            ; closing
-            ]
-
-        | [x] -> sp_nested
-            [ opening
-            ; x
-            ; closing
-            ]
-
-        | x::xs -> sp_nested
-            [ opening
-            ; x
-            ; sp_nested (List.map (fun y -> sp_nested [separator; y]) xs)
-            ; closing
-            ]
-
-    let sp_opening_square_bracket = sp_syntax "["
-    let sp_closing_square_bracket = sp_syntax "]"
-
-    let sp_opening_bracket  = sp_syntax "("
-    let sp_coma             = sp_syntax ","
-    let sp_semicolon        = sp_syntax ";"
-    let sp_closing_bracket  = sp_syntax ")"
-
-    let sp_std_list = sp_list sp_opening_bracket sp_closing_bracket sp_coma
-
-    let sp_ml_list  = sp_list sp_opening_square_bracket sp_closing_square_bracket sp_semicolon
-
-end
-
-include BasicPainters

src/StringPainter_ANSI_Colors.ml

-(*********************************************************************************************************************
- * Copyrights (C) by
- *  Pawel Wieczorek <wieczyk gmail>
- *
- * http://bitbucket.org/wieczyk/ocaml-stringpainter
- ********************************************************************************************************************)
-
-
-(*********************************************************************************************************************
- * ANSI escapes codes
- ********************************************************************************************************************)
-
-type color
-    = Black
-    | Red
-    | Green
-    | Yellow
-    | Blue
-    | Magenta
-    | Cyan
-    | White
-
-let code_of_color = function
-    | Black ->   0
-    | Red ->     1
-    | Green ->   2
-    | Yellow ->  3
-    | Blue ->    4
-    | Magenta -> 5
-    | Cyan ->    6
-    | White ->   7
-
-type attribute
-    = Bright
-    | Reverse
-    | Underline
-    | Blink
-    | Background of color
-    | Foreground of color
-
-let code_of_attribute = function
-    | Bright -> 1
-    | Reverse -> 7
-    | Underline -> 4
-    | Blink     -> 5
-    | Background color -> 40 + code_of_color color
-    | Foreground color -> 30 + code_of_color color
-
-let escape codes str =
-    let f = fun str c -> str ^ ";" ^ string_of_int (code_of_attribute c)
-    in
-
-(List.fold_left f "\027[" codes) ^ "m" ^ str ^ "\027[0m"
-

src/StringPainter_ColorScheme.ml

-(*********************************************************************************************************************
- * Copyrights (C) by
- *  Pawel Wieczorek <wieczyk gmail>
- *
- * http://bitbucket.org/wieczyk/ocaml-stringpainter
- ********************************************************************************************************************)
-
-
-open StringPainter_ANSI_Colors
-
-type color_scheme =
-    { cs_keyword        : attribute list
-    ; cs_value          : attribute list
-    ; cs_value_keyword  : attribute list
-    ; cs_operator       : attribute list
-    ; cs_syntax         : attribute list
-    }
-
-let dummy_color_scheme =
-    { cs_keyword        = []
-    ; cs_value          = []
-    ; cs_value_keyword  = []
-    ; cs_operator       = []
-    ; cs_syntax         = []
-    }
-
-let default_color_scheme =
-    { cs_keyword        = [Bright; Underline]
-    ; cs_value          = [Foreground Cyan]
-    ; cs_value_keyword  = [Bright; Foreground Cyan]
-    ; cs_operator       = [Foreground Yellow]
-    ; cs_syntax         = [Bright; Foreground Black]
-    }
-
-type color_scheme_functionalized =
-    { fcs_keyword       : string -> string
-    ; fcs_value         : string -> string
-    ; fcs_value_keyword : string -> string
-    ; fcs_operator      : string -> string
-    ; fcs_syntax        : string -> string
-    }
-
-let functionalize cs = 
-    { fcs_keyword       = escape cs.cs_keyword
-    ; fcs_value         = escape cs.cs_value
-    ; fcs_value_keyword = escape cs.cs_value_keyword
-    ; fcs_operator      = escape cs.cs_operator
-    ; fcs_syntax        = escape cs.cs_syntax
-    }
-
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.