From e17bba7b9c8da60e2e8cd90b04803f7367b2c540 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Tue, 6 Oct 2020 15:36:31 +0200
Subject: [PATCH] [gui] use global hook
---
src/kernel_internals/runtime/messages.ml | 9 +++++++--
src/kernel_internals/runtime/messages.mli | 4 ++--
src/plugins/gui/design.ml | 12 ++++++------
3 files changed, 15 insertions(+), 10 deletions(-)
diff --git a/src/kernel_internals/runtime/messages.ml b/src/kernel_internals/runtime/messages.ml
index 6d90a920321..1cc0e9342ec 100644
--- a/src/kernel_internals/runtime/messages.ml
+++ b/src/kernel_internals/runtime/messages.ml
@@ -48,7 +48,12 @@ module Messages =
end)
let () = Ast.add_monotonic_state Messages.self
-let add_message m = Messages.set (m :: Messages.get ())
+let demons = ref []
+let add_message m =
+ begin
+ Messages.set (m :: Messages.get ()) ;
+ List.iter (fun fn -> fn()) !demons ;
+ end
let nb_errors () =
Messages.fold_left
@@ -95,7 +100,7 @@ let () = Log.check_not_yet := check_not_yet
let reset_once_flag () = OnceTable.clear ()
-let add_update_hook fn = Messages.add_hook_on_update (fun _ -> fn ())
+let add_global_hook fn = demons := !demons @ [fn]
(*
Local Variables:
diff --git a/src/kernel_internals/runtime/messages.mli b/src/kernel_internals/runtime/messages.mli
index 8843af988fa..11f26cc5bf1 100644
--- a/src/kernel_internals/runtime/messages.mli
+++ b/src/kernel_internals/runtime/messages.mli
@@ -44,8 +44,8 @@ val nb_messages: unit -> int
(** Number of stored warning messages, error messages, or all
messages.*)
-val add_update_hook: (unit -> unit) -> unit
-(** Register a hook on message addition *)
+val add_global_hook: (unit -> unit) -> unit
+(** Register a global hook (not projectified) on message addition. *)
(*
Local Variables:
diff --git a/src/plugins/gui/design.ml b/src/plugins/gui/design.ml
index 786c738ee9e..03048c9f2ac 100644
--- a/src/plugins/gui/design.ml
+++ b/src/plugins/gui/design.ml
@@ -1718,12 +1718,12 @@ class main_window () : main_window_extension_points =
GtkMisc.Label.set_text label text
in
register_reset_extension (fun _ -> display_warnings ());
- Messages.add_update_hook (fun () ->
- if not !outdated_warnings then
- begin
- outdated_warnings := true ;
- Wutil.later display_warnings
- end
+ Messages.add_global_hook (fun () ->
+ if not !outdated_warnings then
+ begin
+ outdated_warnings := true ;
+ Wutil.later display_warnings
+ end
);
Messages.reset_once_flag ();
display_warnings ();
--
GitLab