Source file `indicator.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
(*********************************************************************************)
(*                OCaml-Stk                                                      *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the               *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Indicators, change aspect according to property value of an object. *)

(** {2 Properties} *)

(** The single-char text used by {!class-indicator#connect_to_active} when
  [active] property is [true].*)
let prop_active_char = Props.uchar_prop
  ~after:[Props.Resize] ~inherited:false ~default:(Uchar.of_int 9724)
  "indicator_active_char"

let css_prop_active_char = Theme.uchar_prop prop_active_char

(** The single-char text used by {!class-indicator#connect_to_active} when
  [active] property is [false].*)
let prop_inactive_char = Props.uchar_prop
  ~after:[Props.Resize] ~inherited:false ~default:(Uchar.of_int 9723)
  "indicator_inactive_char"

let css_prop_inactive_char = Theme.uchar_prop prop_inactive_char

(** {2 Widget} *)

(**/**)

let map_active self = function
| true -> (Utf8.string_of_uchar self#active_char, Props.empty ())
| false -> (Utf8.string_of_uchar self#inactive_char, Props.empty ())

(**/**)

(** The indicator widget. *)
class indicator ?classes ?name ?props ?wdata () =
  object(self)
    inherit Text.label ?classes ?name ?props ?wdata () as super

    (**/**)

    val mutable cb_id = None
    val mutable cb_id_destroy = None
    val mutable update__ = fun () -> ()
    method! kind = "indicator"

    (**/**)

    method active_char = self#get_p prop_active_char
    method set_active_char = self#set_p prop_active_char
    method inactive_char = self#get_p prop_inactive_char
    method set_inactive_char = self#set_p prop_inactive_char

    (**/**)

    method! do_apply_theme ~root ~parent parent_path rules =
      (* we need to update the label after theming, since
         theming does not trigger callbacks for property changes *)
      super#do_apply_theme ~root ~parent parent_path rules;
      update__ ()

    method private set__ : 'a. ('a -> string * Props.props) -> 'a -> unit =
      fun map v ->
        update__ <- (fun () ->
           let text, props = map v in
           self#set_text text;
           self#set_props props);
        update__ ()

    (**/**)

    (** [#connect_to obj prop f] adds a handler to [obj] so that when its [prop]
        changes, [f] is called. The result [text, props] of the call to [f]
        is used to set the text in the indicator label, and apply [props] to the label.*)
    method connect_to : 'a. Object.o -> 'a Props.prop -> ('a -> string * Props.props) -> unit =
      fun obj prop map ->
        (match obj#opt_p prop with
         | Some v -> self#set__ map v
         | None ->
             match Props.default_value prop with
             | Some v -> self#set__ map v
             | None -> ()
        );
        Option.iter Events.unregister cb_id ;
        Option.iter Events.unregister cb_id_destroy ;
        let id = obj#connect (Object.Prop_changed prop)
          (fun ~prev:_ ~now -> self#set__ map now)
        in
        let id_destroy = obj#connect Widget.Destroy (fun () -> self#set_text ""; false) in
        cb_id <- Some id;
        cb_id_destroy <- Some id_destroy

    (** Same as [#connect_to] but the property is always {!Props.active}
      and the indicator properties {!prop_active_char} and {!prop_inactive_char}
      to set the label text. *)
    method connect_to_active obj =
      self#connect_to obj Props.active (map_active self)

    initializer
      ignore(self#connect (Object.Prop_changed prop_active_char)
       (fun ~prev:_ ~now:_ -> update__()));
      ignore(self#connect (Object.Prop_changed prop_inactive_char)
       (fun ~prev:_ ~now:_ -> update__()));
  end

type Widget.widget_type += Indicator of indicator

(** Convenient function to create a {!class-indicator}.
  See {!Widget.widget_arguments} for arguments. *)
let indicator ?classes ?name ?props ?wdata ?group ?pack () =
  let w = new indicator ?classes ?name ?props ?wdata () in
  w#set_typ (Indicator w);
  Widget.may_pack ?pack w#coerce ;
  w