diff options
Diffstat (limited to 'lib/feedback.ml')
| -rw-r--r-- | lib/feedback.ml | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/lib/feedback.ml b/lib/feedback.ml index 74a18df6f..12b8b27ff 100644 --- a/lib/feedback.ml +++ b/lib/feedback.ml @@ -51,7 +51,7 @@ let default_route = 0 open Pp open Pp_control -type logger = level -> std_ppcmds -> unit +type logger = ?loc:Loc.t -> level -> std_ppcmds -> unit let msgnl_with fmt strm = msg_with fmt (strm ++ fnl ()) let msgnl strm = msgnl_with !std_ft strm @@ -84,7 +84,7 @@ let err_str = str "Error:" ++ spc () let make_body quoter info s = quoter (hov 0 (info ++ s)) (* Generic logger *) -let gen_logger dbg err level msg = match level with +let gen_logger dbg err ?loc level msg = match level with | Debug -> msgnl (make_body dbg dbg_str msg) | Info -> msgnl (make_body dbg info_str msg) | Notice -> msgnl msg @@ -93,10 +93,10 @@ let gen_logger dbg err level msg = match level with | Error -> msgnl_with !err_ft (make_body err err_str msg) (** Standard loggers *) -let std_logger = gen_logger (fun x -> x) (fun x -> x) +let std_logger = gen_logger (fun x -> x) (fun x -> x) (* Color logger *) -let color_terminal_logger level strm = +let color_terminal_logger ?loc level strm = let msg = Ppstyle.color_msg in match level with | Debug -> msg ~header:("Debug", Ppstyle.debug_tag) !std_ft strm @@ -117,11 +117,11 @@ let emacs_logger = gen_logger emacs_quote_info emacs_quote_err let logger = ref std_logger let set_logger l = logger := l -let msg_info x = !logger Info x -let msg_notice x = !logger Notice x -let msg_warning x = !logger Warning x -let msg_error x = !logger Error x -let msg_debug x = !logger Debug x +let msg_info ?loc x = !logger Info x +let msg_notice ?loc x = !logger Notice x +let msg_warning ?loc x = !logger Warning x +let msg_error ?loc x = !logger Error x +let msg_debug ?loc x = !logger Debug x (** Feeders *) let feeder = ref ignore @@ -140,19 +140,19 @@ let feedback ?id ?route what = id = Option.default !feedback_id id; } -let feedback_logger lvl msg = +let feedback_logger ?loc lvl msg = feedback ~route:!feedback_route ~id:!feedback_id (Message (lvl, Richpp.richpp_of_pp msg)) (* Output to file *) -let ft_logger old_logger ft level mesg = +let ft_logger old_logger ft ?loc level mesg = let id x = x in match level with | Debug -> msgnl_with ft (make_body id dbg_str mesg) | Info -> msgnl_with ft (make_body id info_str mesg) | Notice -> msgnl_with ft mesg - | Warning -> old_logger level mesg - | Error -> old_logger level mesg + | Warning -> old_logger ?loc level mesg + | Error -> old_logger ?loc level mesg let with_output_to_file fname func input = let old_logger = !logger in |