Commits

Paweł Wieczorek committed 57f07f5

added Label and Special categories

  • Participants
  • Parent commits 25b5cf3
  • Branches separator-mechanism

Comments (0)

Files changed (5)

File src/Basic.mli

 
 val sp_word : string -> painter
 
+val sp_label : string -> painter
+
+val sp_special : string -> painter
+
 val sp_keyword : string -> painter
 
 val sp_value_keyword : string -> painter

File src/ColorScheme.ml

     ; cs_value_keyword  : attribute list
     ; cs_operator       : attribute list
     ; cs_syntax         : attribute list
+    ; cs_label          : attribute list
+    ; cs_special        : attribute list
     }
 
 let dummy_color_scheme =
     ; cs_value_keyword  = []
     ; cs_operator       = []
     ; cs_syntax         = []
+    ; cs_label          = []
+    ; cs_special        = []
     }
 
 let default_color_scheme =
     ; cs_value_keyword  = [Bright; Foreground Cyan]
     ; cs_operator       = [Foreground Yellow]
     ; cs_syntax         = [Bright; Foreground Black]
+    ; cs_label          = [Foreground Green]
+    ; cs_special        = [Foreground Magenta]
     }
 
+(* TODO: remove, escape function should be used directly *)
 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
+    ; fcs_label         : string -> string
+    ; fcs_special       : string -> string
     }
 
 let functionalize cs = 
     ; fcs_value_keyword = escape cs.cs_value_keyword
     ; fcs_operator      = escape cs.cs_operator
     ; fcs_syntax        = escape cs.cs_syntax
+    ; fcs_label         = escape cs.cs_label
+    ; fcs_special       = escape cs.cs_special
     }
 

File src/Engine.ml

 
 module Core = struct
 
-    type attribute
-        = A_None
-        | A_Keyword
-        | A_Value
-        | A_ValueKeyword
-        | A_Oper
-        | A_Syntax
+    type category
+        = C_None
+        | C_Keyword
+        | C_Value
+        | C_ValueKeyword
+        | C_Operator
+        | C_Syntax
+        | C_Label
+        | C_Special
 
     type simple
         = S_Text of string
-        | S_TextA of string * attribute
+        | S_TextC of string * category
         | S_Break
         | S_NewLine
 
         | Operator of string
         | Label of string
         | Syntax of string
+        | Special of string
 
         (* Line break *)
         | Break
                 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
+            let apply_category internal = function
+                | C_None            -> fun x -> x
+                | C_Keyword         -> internal.color_scheme.fcs_keyword
+                | C_Value           -> internal.color_scheme.fcs_value
+                | C_ValueKeyword    -> internal.color_scheme.fcs_value_keyword
+                | C_Operator        -> internal.color_scheme.fcs_operator
+                | C_Syntax          -> internal.color_scheme.fcs_syntax
+                | C_Label           -> internal.color_scheme.fcs_label
+                | C_Special         -> internal.color_scheme.fcs_special
 
 
         end
             ; decrement_indent  : unit -> unit
             ; set_weak_break    : unit -> unit
             ; flush_weak_break  : unit -> unit
-            ; apply_attribute   : attribute -> string -> string
+            ; apply_category   : category -> string -> string
             }
 
         let empty_driver () =
             ; 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
+            ; apply_category   = Internal.apply_category internal
             }
 
 
                 driver.add_text s;
                 process cont driver (rest :: stack)
 
-            | (S_TextA (s, a) :: rest) :: stack ->
-                driver.add_text (driver.apply_attribute a s);
+            | (S_TextC (s, a) :: rest) :: stack ->
+                driver.add_text (driver.apply_category a s);
                 process cont driver (rest :: stack)
 
             (* Breaking lines *)
                     [ S_Text txt
                     ]
 
-            | Word txt :: rest
+            | Word txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextC (txt, C_None)
+                    ; S_Text " "
+                    ]
+
             | Label txt :: rest ->
                 process_text multiline rest 
-                    [ S_Text txt
+                    [ S_TextC (txt, C_Label)
                     ; S_Text " "
                     ]
 
             | Operator txt :: rest ->
                 process_text multiline rest 
-                    [ S_TextA (txt, A_Oper)
+                    [ S_TextC (txt, C_Operator)
                     ; S_Text " "
                     ]
 
             | Keyword txt :: rest ->
                 process_text multiline rest 
-                    [ S_TextA (txt, A_Keyword)
+                    [ S_TextC (txt, C_Keyword)
                     ; S_Text " "
                     ]
 
             | Syntax txt :: rest ->
                 process_text multiline rest 
-                    [ S_TextA (txt, A_Syntax)
+                    [ S_TextC (txt, C_Syntax)
                     ; S_Text " "
                     ]
 
             | Value txt :: rest ->
                 process_text multiline rest 
-                    [ S_TextA (txt, A_Value)
+                    [ S_TextC (txt, C_Value)
                     ; S_Text " "
                     ]
 
             | ValueKeyword txt :: rest ->
                 process_text multiline rest 
-                    [ S_TextA (txt, A_ValueKeyword)
+                    [ S_TextC (txt, C_ValueKeyword)
+                    ; S_Text " "
+                    ]
+
+            | Special txt :: rest ->
+                process_text multiline rest 
+                    [ S_TextC (txt, C_Special)
                     ; S_Text " "
                     ]
 
     [ Word txt
     ]
 
+let sp_label txt = preprocess
+    [ Label txt
+    ]
+
+let sp_special txt = preprocess
+    [ Special txt
+    ]
+
 let sp_keyword txt = preprocess
     [ Keyword txt
     ]

File src/Prioritized.ml

 let psp_value_keyword   = embed_sp1 psp_max_priority Basic.sp_value_keyword
 let psp_operator        = embed_sp1 psp_max_priority Basic.sp_operator
 let psp_syntax          = embed_sp1 psp_max_priority Basic.sp_syntax
+let psp_label           = embed_sp1 psp_max_priority Basic.sp_label
+let psp_special         = embed_sp1 psp_max_priority Basic.sp_special
 
 let psp_value_int       = embed_sp1 psp_max_priority Basic.sp_value_int
 let psp_value_bool      = embed_sp1 psp_max_priority Basic.sp_value_bool

File src/Prioritized.mli

 (** Paints a word. *)
 val psp_word : string -> painter
 
+val psp_label : string -> painter
+
+val psp_special : string -> painter
+
 (** Paints a keyword. *)
 val psp_keyword : string -> painter