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
open Widget
class tool ?label ?tooltip ?content () =
let status = new Widget.image `None in
let toggle = new Widget.toggle ~align:`Left ?label ?tooltip ~border:false () in
let action = new Widget.button ~icon:`MEDIA_PLAY ?tooltip () in
object(self)
initializer
begin
let color = `NAME "orange" in
toggle#coerce#misc#modify_bg [ `PRELIGHT , color ; `ACTIVE , color ] ;
toggle#connect self#toggle ;
action#connect self#action ;
self#toggle false ;
action#set_border false ;
Wutil.on content self#set_content ;
end
val mutable details = None
val mutable tooltip = None
val mutable callback = None
val mutable view = None
method private toggle a =
match details with
| None -> ()
| Some w -> Wutil.set_visible w a
method private action () =
match callback with
| None -> ()
| Some f -> f ()
method private render =
let hbox = GPack.hbox ~show:true () in
hbox#pack ~expand:false status#coerce ;
hbox#pack ~expand:true ~fill:true ~padding:1 toggle#coerce ;
hbox#pack ~expand:false action#coerce ;
match details with
| None -> hbox#coerce
| Some w ->
let vbox = GPack.vbox ~show:true () in
vbox#pack ~expand:false hbox#coerce ;
vbox#pack ~expand:true ~fill:false w#coerce ;
vbox#coerce
method tool = (self :> tool)
method widget =
match view with Some w -> w | None ->
let w = new Wutil.gobj_widget self#render in
view <- Some w ; w
method coerce = self#widget#coerce
method on_active = toggle#connect
method is_active = toggle#get
method set_active = toggle#set
method has_action = callback != None
method set_enabled e = self#widget#set_enabled e
method set_visible v = self#widget#set_visible v
method set_label = toggle#set_label
method set_tooltip txt = toggle#set_tooltip txt
method set_status = status#set_icon
method clear_action =
callback <- None ;
action#set_visible false
method set_action ?icon ?tooltip ?callback:cb () =
begin
callback <- cb ;
action#set_visible true ;
action#set_enabled (cb != None) ;
Wutil.on icon action#set_icon ;
Wutil.on tooltip action#set_tooltip ;
end
method set_content (w : widget) =
assert ( details == None ) ;
let frame = GBin.frame ~show:false () in
let padds = GBin.alignment ~padding:(4,4,4,4) () in
padds#add w#coerce ;
frame#add padds#coerce ;
details <- Some frame
end
class panel () =
let box = GPack.vbox ~show:true () in
object(self)
inherit Wutil.gobj_widget box
val mutable lock = false
val mutable tools = []
method add_widget (w : GObj.widget) =
box#pack ~expand:false w
method add_tool (w : tool) =
begin
self#add_widget w#coerce ;
w#on_active (self#active w) ;
tools <- w :: tools ;
end
method private active w a =
if a && not lock then
try
lock <- true ;
List.iter (fun w0 -> if w0 <> w then w0#set_active false) tools ;
lock <- false ;
with e ->
lock <- false ; raise e
end