(** * color_out_toplevel.ml * ColorML_v2 project * (C) Lilian Besson, 2014 *) (** Color Out in toplevel Compile with : ocamlc -a -o ~/color_out_toplevel.cma ~/.mocaml/ColorML/colorml.cma color_out_toplevel.ml ============== Use with add those lines in your ~/.ocamlinit : ================================================ #load "/home/[YOUR HOME PATH]/color_out_toplevel.cma";; open Color_out_toplevel;; Warnings: ========= Don't delete ~/color_out_toplevel.cma neither ~/color_out_toplevel.ml. Dependancies: ============= My module for MOcaml : print. ColorML can be downloaded on line. *) (** Dependances : *) module PColor = Print;; (** Module PrintfColor, pour plus de détails voir la doc du module. *) let autoreset = ref true let set_autoreset b = autoreset := b type color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default type style = | Reset | Bold | Underlined | Blink | Inverse | Hidden | Foreground of color | Background of color let black = Foreground Black let red = Foreground Red let green = Foreground Green let yellow = Foreground Yellow let blue = Foreground Blue let magenta = Foreground Magenta let cyan = Foreground Cyan let white = Foreground White let default = Foreground Default let on_black = Background Black let on_red = Background Red let on_green = Background Green let on_yellow = Background Yellow let on_blue = Background Blue let on_magenta = Background Magenta let on_cyan = Background Cyan let on_white = Background White let on_default = Background Default open Printf open Scanf let style_to_string = function | Reset -> "0" | Bold -> "1" | Underlined -> "4" | Blink -> "5" | Inverse -> "7" | Hidden -> "8" | Foreground Black -> "30" | Foreground Red -> "31" | Foreground Green -> "32" | Foreground Yellow -> "33" | Foreground Blue -> "34" | Foreground Magenta -> "35" | Foreground Cyan -> "36" | Foreground White -> "37" | Foreground Default -> "39" | Background Black -> "40" | Background Red -> "41" | Background Green -> "42" | Background Yellow -> "43" | Background Blue -> "44" | Background Magenta -> "45" | Background Cyan -> "46" | Background White -> "47" | Background Default -> "49" let ( ^= ) s f = s := (!s) ^ (f);; let print_to_string style txt = let ss = ref "" in ss ^= "\027["; let s = String.concat ";" (List.map style_to_string style) in ss ^= s; ss ^= "m"; ss ^= txt; if !autoreset then ss ^= "\027[0m"; !ss let print_string_style style txt = print_string "\027["; let s = String.concat ";" (List.map style_to_string style) in print_string s; print_string "m"; print_string txt; if !autoreset then print_string "\027[0m" (*let print_string = print_string_style*) let prerr_string_style style txt = prerr_string "\027["; let s = String.concat ";" (List.map style_to_string style) in prerr_string s; prerr_string "m"; prerr_string txt; if !autoreset then prerr_string "\027[0m" (*let prerr_string = prerr_string_style*) let printf style = ksprintf (print_string_style style) (** FIN du module PrintfColor *) (** ************************************************************ *) let print_code_ml s = PColor.affiche_string ~color:true ~stat:false s ();; (** {6 Quelques fonctions supplémentaires.} *) (** Fonction ecrire_sortie : plus pratique que output. *) let ecrire_sortie monoutchanel machaine = output monoutchanel machaine 0 (String.length machaine); flush monoutchanel;; (** Fonction in_list : tail recursive plus pratique que List.exists (fun x -> x=a) l. *) let rec in_list element = function |[] -> false; |el :: ssl -> if (element = el) then true else (in_list element ssl);; (** Pour extraire une sous-string, plus pratique que String.sub. *) let monsub mastr idebut taille = let res = ref "" in if taille >= 0 then res := (String.sub mastr idebut taille); !res;; (** Decoupe_custom ~e: : découpe la chaine d'entree en morceau, en commancant un nouveau morceau pour chaque "e" trouvé. *) let rec decoupe_custom ?(e = [',']) ma_string = let n = (String.length ma_string); and result = ref []; and i = ref 0; in if (n > 0) then begin while ( (!i < (n - 1)) && not(in_list ma_string.[!i] e)) do incr i; done; if (!i = (n - 1)) then result := [ma_string]; if (!i <= (n - 2)) then result := [(monsub ma_string 0 !i)]@(decoupe_custom ~e (monsub ma_string (!i + 1) (n - !i - 1) )); end; !result;; (** Deux conversions non présentes dans Pervasives. *) let char_of_string s = s.[0] and string_of_char = String.make 1;; (* ************************************************ *) (** {6 Manipulations haut-niveau du module Format.} *) let __fichier_out_mocaml__ = ref "mocaml_history_OUT.ml";; let __channel_out_mocaml__ = ref (Pervasives.open_out_gen [Pervasives.Open_text; Pervasives.Open_creat; Pervasives.Open_append] 511 !__fichier_out_mocaml__);; let _nanoout ?(addresse_out = (!__fichier_out_mocaml__)) ?(b = false) () = if (b) then ( __fichier_out_mocaml__ := addresse_out; close_out !__channel_out_mocaml__; __channel_out_mocaml__ := (open_out !__fichier_out_mocaml__); Format.set_formatter_out_channel !__channel_out_mocaml__; ) else Format.set_formatter_out_channel stdout;; at_exit (fun () -> close_out !__channel_out_mocaml__);; (** Pas en couleurs *) let (__out , __flush , __newline , __spaces) = Format.get_all_formatter_output_functions ();; let __output_is_colored = ref false;; (** En couleurs *) let __outColor s i k = (* __channel_out_mocaml__ := (stdout);*) output !__channel_out_mocaml__ s i k; print_code_ml (monsub s i k);; let __outColornano ?(out = stdout) s i k = __channel_out_mocaml__ := out; output !__channel_out_mocaml__ s i k; print_code_ml (monsub s i k);; let __flushColor () = ();; (*Pervasives.flush stdout;;*) let __newlineColor () = __outColor "\n" 0 1;; let __spacesColor n = __outColor (String.make n ' ') 0 n;; let _colorout ?(b = false) () = __output_is_colored := b; if (b) then ( __output_is_colored := b; print_string "La sortie standard du pretty-printer du toplevel va être modifiée ==> en couleurs !!\n"; Format.set_all_formatter_output_functions ~out:__outColor ~flush:__flushColor ~newline:__newlineColor ~spaces:__spacesColor; ) else ( print_string "La sortie standard du pretty-printer du toplevel va être modifiée ==> sans couleurs ...\n"; Format.set_all_formatter_output_functions ~out:__out ~flush:__flush ~newline:__newline ~spaces:__spaces; );; let _nanoin ?(addresse_out = (!__fichier_out_mocaml__)) ?(b = false) () = __output_is_colored := b; if (b) then ( __fichier_out_mocaml__ := addresse_out; close_out !__channel_out_mocaml__; __channel_out_mocaml__ := (open_out !__fichier_out_mocaml__); print_string "La sortie standard du pretty-printer du toplevel va être modifiée ==> en couleurs !!\n"; Format.set_all_formatter_output_functions ~out:(__outColornano ~out:!__channel_out_mocaml__) ~flush:__flushColor ~newline:__newlineColor ~spaces:__spacesColor; ) else ( print_string "La sortie standard du pretty-printer du toplevel va être modifiée ==> sans couleurs ...\n"; Format.set_all_formatter_output_functions ~out:__out ~flush:__flush ~newline:__newline ~spaces:__spaces; );; (** Run coloration of output ! *) if !Sys.interactive then _colorout ~b:true ();; (* ************************************************ *)