terminal user interface to jujutsu. Focused on speed and clarity
add signal lib for events. event to reset selection after commands
+702
-529
+34
-9
flake.nix
+34
-9
flake.nix
···
130
130
version = "0.5.0";
131
131
duneVersion = "3";
132
132
src = picos_src;
133
-
buildInputs = with ocamlPackages;picos_io.buildInputs ++[
134
-
picos
135
-
picos_aux
136
-
picos_std
137
-
picos_io
138
-
backoff
139
-
multicore-magic
140
-
thread-local-storage
141
-
];
133
+
buildInputs =
134
+
with ocamlPackages;
135
+
picos_io.buildInputs
136
+
++ [
137
+
picos
138
+
picos_aux
139
+
picos_std
140
+
picos_io
141
+
backoff
142
+
multicore-magic
143
+
thread-local-storage
144
+
];
142
145
143
146
strictDeps = true;
144
147
};
···
168
171
];
169
172
170
173
strictDeps = true;
174
+
171
175
};
176
+
177
+
signal = ocamlPackages.buildDunePackage {
178
+
pname = "signal";
179
+
version = "0.4.2";
180
+
duneVersion = "3";
181
+
src = pkgs.fetchFromGitHub {
182
+
owner = "rizo";
183
+
repo = "signal";
184
+
rev = "704fefe7cd7b59e234a51bb470c7a3254468b5a8";
185
+
sha256 = "sha256-AcphzD/4rrWnsVB5ebXzdthQ1Rrw3xXkv4n5ZHosoz0=";
186
+
};
187
+
buildInputs = with ocamlPackages; [
188
+
189
+
];
190
+
strictDeps = true;
191
+
};
192
+
172
193
lwd = ocamlPackages.buildDunePackage {
173
194
pname = "lwd";
174
195
version = "0.1.0";
···
195
216
duneVersion = "3";
196
217
src = ./forks/nottui/.;
197
218
buildInputs = with ocamlPackages; [
219
+
signal
198
220
lwd
199
221
notty-mine
200
222
seq
···
218
240
219
241
strictDeps = true;
220
242
};
243
+
221
244
jj_tui_build_pkgs =
222
245
223
246
picos.buildInputs
···
234
257
picos_mux_with_io
235
258
236
259
picos_aux
260
+
261
+
signal
237
262
238
263
ocamlPackages.logs
239
264
ocamlPackages.logs-ppx
+1
-1
forks/nottui/lib/nottui/dune
+1
-1
forks/nottui/lib/nottui/dune
+599
-502
forks/nottui/lib/nottui/nottui_main.ml
+599
-502
forks/nottui/lib/nottui/nottui_main.ml
···
1
1
open Notty
2
2
open Lwd_utils
3
3
4
-
module Focus :
5
-
sig
4
+
module Focus : sig
6
5
type var = int Lwd.var
7
6
type handle
7
+
8
8
val make : unit -> handle
9
9
val request : handle -> unit
10
10
val request_var : var -> unit
11
11
val release : handle -> unit
12
12
13
+
(** Request the focus and add to the focus stack *)
13
14
val request_reversable : handle -> unit
14
-
(** Request the focus and add to the focus stack *)
15
15
16
+
(** Release the focus (if the handle has it) and restore the last focus on the stack *)
16
17
val release_reversable : handle -> unit
17
-
(** Release the focus (if the handle has it) and restore the last focus on the stack *)
18
18
19
19
type status =
20
20
| Empty
21
21
| Handle of int * var
22
22
| Conflict of int
23
-
val peek_has_focus:handle->bool
24
23
24
+
val peek_has_focus : handle -> bool
25
25
val empty : status
26
+
26
27
(*val is_empty : status -> bool*)
27
28
val status : handle -> status Lwd.t
28
29
val has_focus : status -> bool
29
30
val merge : status -> status -> status
30
31
end = struct
31
32
(*The focus system works by having a clock which changes each time the focus changes. An item has focus so long as its `var` is greater than 0
32
-
When we render the UI we go through and set anything with a focus value not matching that of the clock to 0 *)
33
+
When we render the UI we go through and set anything with a focus value not matching that of the clock to 0 *)
33
34
34
35
type var = int Lwd.var
35
36
···
40
41
41
42
type handle = var * status Lwd.t
42
43
43
-
let make ():handle =
44
+
let make () : handle =
44
45
let v = Lwd.var 0 in
45
-
(v,
46
-
(Lwd.get v)|> Lwd.map ~f:(fun i -> Handle (i, v))
47
-
)
46
+
v, Lwd.get v |> Lwd.map ~f:(fun i -> Handle (i, v))
47
+
;;
48
48
49
49
let empty : status = Empty
50
-
51
50
let status (h : handle) : status Lwd.t = snd h
52
51
53
52
let has_focus = function
54
53
| Empty -> false
55
54
| Handle (i, _) | Conflict i -> i > 0
55
+
;;
56
56
57
-
let peek_has_focus (h : handle) : bool= fst h|>Lwd.peek>0
58
-
57
+
let peek_has_focus (h : handle) : bool = fst h |> Lwd.peek > 0
59
58
let clock = ref 0
60
-
61
-
let currently_focused:var ref= ref (make()|>fst)
62
-
63
-
let focus_stack:var Stack.t= Stack.create()
59
+
let currently_focused : var ref = ref (make () |> fst)
60
+
let focus_stack : var Stack.t = Stack.create ()
64
61
65
62
let request_var (v : var) =
66
63
incr clock;
67
64
Lwd.set v !clock;
68
-
currently_focused := v;
69
-
;;
70
-
let request ((v, _ ): handle) =
71
-
request_var v;
72
-
;;
73
-
let release (v, _ : handle) = incr clock; Lwd.set v 0
65
+
currently_focused := v
66
+
;;
67
+
68
+
let request ((v, _) : handle) = request_var v
74
69
70
+
let release ((v, _) : handle) =
71
+
incr clock;
72
+
Lwd.set v 0
73
+
;;
75
74
76
-
let request_reversable (v, _ : handle)=
77
-
focus_stack|>Stack.push !currently_focused;
78
-
request_var v ;
75
+
let request_reversable ((v, _) : handle) =
76
+
focus_stack |> Stack.push !currently_focused;
77
+
request_var v
79
78
;;
80
79
81
-
let release_reversable (v, _ : handle)=
80
+
let release_reversable ((v, _) : handle) =
82
81
(* we should only release if we actually have the focus*)
83
-
if (Lwd.peek v)>0 then
84
-
focus_stack|>Stack.pop |>request_var;
85
-
82
+
if Lwd.peek v > 0 then focus_stack |> Stack.pop_opt |> Option.iter request_var
86
83
;;
87
84
88
-
89
-
let merge s1 s2 : status = match s1, s2 with
85
+
let merge s1 s2 : status =
86
+
match s1, s2 with
90
87
| Empty, x | x, Empty -> x
91
88
| _, Handle (0, _) -> s1
92
89
| Handle (0, _), _ -> s2
93
90
| Handle (i1, _), Handle (i2, _) when i1 = i2 -> s1
94
91
| (Handle (i1, _) | Conflict i1), Conflict i2 when i1 < i2 -> s2
95
-
| (Handle (i1, _) | Conflict i1), Handle (i2, _) when i1 < i2 ->
96
-
Conflict i2
92
+
| (Handle (i1, _) | Conflict i1), Handle (i2, _) when i1 < i2 -> Conflict i2
97
93
| Conflict _, (Handle (_, _) | Conflict _) -> s1
98
94
| Handle (i1, _), (Handle (_, _) | Conflict _) -> Conflict i1
99
-
100
-
(*
101
-
Can i get the currently focused focus handle??
102
-
103
-
I could modify the focus handle so that it stores the last focused thing. That way when i call focus release on it it can return us to that. In a sense this would be almost like a linked list.
104
-
I have an issue that if the focus isn't stored in the UI somewhere if i have two concurrent UIs their focus control will collide. Is this a real concern? Could I store the current focus in the root node, or as part of the UI rendering?
95
+
;;
105
96
106
-
The renderer could store the currently focused item.
107
-
When we walk the focus tree, if the items are focused we keep walking untill we hit the end and then we assign that as the focused item.
108
-
When switching focus we use that focused item.
109
-
110
-
111
-
Would could have a FocusManager module. It stores the most recently focused item and also has the focus heap. When you request focus it can either be a queue adding request or a non queue adding request. When i release focus it will always release back to the last item in the heap
112
-
*)
97
+
(*
98
+
Can i get the currently focused focus handle??
113
99
100
+
I could modify the focus handle so that it stores the last focused thing. That way when i call focus release on it it can return us to that. In a sense this would be almost like a linked list.
101
+
I have an issue that if the focus isn't stored in the UI somewhere if i have two concurrent UIs their focus control will collide. Is this a real concern? Could I store the current focus in the root node, or as part of the UI rendering?
114
102
103
+
The renderer could store the currently focused item.
104
+
When we walk the focus tree, if the items are focused we keep walking untill we hit the end and then we assign that as the focused item.
105
+
When switching focus we use that focused item.
115
106
116
-
107
+
Would could have a FocusManager module. It stores the most recently focused item and also has the focus heap. When you request focus it can either be a queue adding request or a non queue adding request. When i release focus it will always release back to the last item in the heap
108
+
*)
117
109
end
118
110
119
-
120
-
module Gravity :
121
-
sig
122
-
type direction = [
123
-
| `Negative
111
+
module Gravity : sig
112
+
type direction =
113
+
[ `Negative
124
114
| `Neutral
125
115
| `Positive
126
-
]
116
+
]
117
+
127
118
val pp_direction : Format.formatter -> direction -> unit
119
+
128
120
type t
121
+
129
122
val pp : Format.formatter -> t -> unit
130
123
val make : h:direction -> v:direction -> t
131
124
val default : t
···
133
126
val v : t -> direction
134
127
135
128
type t2
129
+
136
130
val pair : t -> t -> t2
137
131
val p1 : t2 -> t
138
132
val p2 : t2 -> t
139
-
end =
140
-
struct
141
-
type direction = [ `Negative | `Neutral | `Positive ]
133
+
end = struct
134
+
type direction =
135
+
[ `Negative
136
+
| `Neutral
137
+
| `Positive
138
+
]
139
+
142
140
type t = int
143
141
type t2 = int
144
142
···
146
144
147
145
let pack = function
148
146
| `Negative -> 0
149
-
| `Neutral -> 1
147
+
| `Neutral -> 1
150
148
| `Positive -> 2
149
+
;;
151
150
152
151
let unpack = function
153
152
| 0 -> `Negative
154
153
| 1 -> `Neutral
155
154
| _ -> `Positive
156
-
157
-
let make ~h ~v =
158
-
(pack h lsl 2) lor pack v
155
+
;;
159
156
157
+
let make ~h ~v = (pack h lsl 2) lor pack v
160
158
let h x = unpack (x lsr 2)
161
159
let v x = unpack (x land 3)
162
160
163
161
let pp_direction ppf dir =
164
-
let text = match dir with
162
+
let text =
163
+
match dir with
165
164
| `Negative -> "`Negative"
166
-
| `Neutral -> "`Neutral"
165
+
| `Neutral -> "`Neutral"
167
166
| `Positive -> "`Positive"
168
167
in
169
168
Format.pp_print_string ppf text
169
+
;;
170
170
171
171
let pp ppf g =
172
172
Format.fprintf ppf "{ h = %a; v = %a }" pp_direction (h g) pp_direction (v g)
173
+
;;
173
174
174
-
let pair t1 t2 =
175
-
(t1 lsl 4) lor t2
176
-
175
+
let pair t1 t2 = (t1 lsl 4) lor t2
177
176
let p1 t = (t lsr 4) land 15
178
177
let p2 t = t land 15
179
178
end
179
+
180
180
type gravity = Gravity.t
181
181
182
182
module Interval : sig
183
183
type t = private int
184
+
184
185
val make : int -> int -> t
185
186
val shift : t -> int -> t
186
187
val fst : t -> int
187
188
val snd : t -> int
189
+
188
190
(*val size : t -> int*)
189
191
val zero : t
190
192
end = struct
···
197
199
let size = y - x in
198
200
(*assert (size >= 0);*)
199
201
(x lsl half) lor (size land mask)
200
-
201
-
let shift t d =
202
-
t + d lsl half
202
+
;;
203
203
204
+
let shift t d = t + (d lsl half)
204
205
let fst t = t asr half
205
206
let size t = t land mask
206
207
let snd t = fst t + size t
207
-
208
208
let zero = 0
209
209
end
210
210
211
-
module Ui =
212
-
struct
211
+
module Ui = struct
212
+
type mouse_handler =
213
+
x:int
214
+
-> y:int
215
+
-> Unescape.button
216
+
-> [ `Unhandled
217
+
| `Handled
218
+
| `Grab of (x:int -> y:int -> unit) * (x:int -> y:int -> unit)
219
+
]
213
220
214
-
type mouse_handler = x:int -> y:int -> Unescape.button -> [
215
-
| `Unhandled
216
-
| `Handled
217
-
| `Grab of (x:int -> y:int -> unit) * (x:int -> y:int -> unit)
221
+
type semantic_key =
222
+
[ (* Clipboard *)
223
+
`Copy
224
+
| `Paste
225
+
| (* Focus management *)
226
+
`Focus of
227
+
[ `Out | `Next | `Prev | `Left | `Right | `Up | `Down ]
218
228
]
219
229
220
-
type semantic_key = [
221
-
(* Clipboard *)
222
-
| `Copy
223
-
| `Paste
224
-
(* Focus management *)
225
-
| `Focus of [`Out| `Next | `Prev | `Left | `Right | `Up | `Down]
226
-
]
230
+
type key =
231
+
[ Unescape.special | `Uchar of Uchar.t | `ASCII of char | semantic_key ]
232
+
* Unescape.mods
227
233
228
-
type key = [
229
-
| Unescape.special | `Uchar of Uchar.t | `ASCII of char | semantic_key
230
-
] * Unescape.mods
231
-
type may_handle = [ `Unhandled | `Handled | `Remap of key ]
234
+
type may_handle =
235
+
[ `Unhandled
236
+
| `Handled
237
+
| `Remap of key
238
+
]
232
239
233
240
type mouse = Unescape.mouse
234
241
235
-
type event = [ `Key of key | `Mouse of mouse | `Paste of Unescape.paste ]
242
+
type event =
243
+
[ `Key of key
244
+
| `Mouse of mouse
245
+
| `Paste of Unescape.paste
246
+
]
236
247
237
-
type layout_spec = { w : int; h : int; sw : int; sh : int ; mw : int; mh : int}
248
+
type layout_spec =
249
+
{ w : int
250
+
; h : int
251
+
; sw : int
252
+
; sh : int
253
+
; mw : int
254
+
; mh : int
255
+
}
238
256
239
-
let pp_layout_spec ppf { w; h; sw; sh;mw;mh } =
240
-
Format.fprintf ppf "{ w = %d; h = %d; sw = %d; sh = %d; mw= %d; mh=%d; }" w h sw sh mw mh
257
+
let pp_layout_spec ppf { w; h; sw; sh; mw; mh } =
258
+
Format.fprintf
259
+
ppf
260
+
"{ w = %d; h = %d; sw = %d; sh = %d; mw= %d; mh=%d; }"
261
+
w
262
+
h
263
+
sw
264
+
sh
265
+
mw
266
+
mh
267
+
;;
241
268
242
269
type flags = int
270
+
243
271
let flags_none = 0
244
272
let flag_transient_sensor = 1
245
273
let flag_permanent_sensor = 2
···
247
275
type size_sensor = w:int -> h:int -> unit
248
276
type frame_sensor = x:int -> y:int -> w:int -> h:int -> unit -> unit
249
277
250
-
type t = {
251
-
w : int; sw : int;
252
-
mw : int; mh : int;
253
-
h : int; sh : int;
254
-
mutable desc : desc;
255
-
focus : Focus.status;
256
-
mutable flags : flags;
257
-
mutable sensor_cache : (int * int * int * int) option;
258
-
mutable cache : cache;
259
-
}
260
-
and cache = {
261
-
vx : Interval.t; vy : Interval.t;
262
-
image : image;
263
-
}
278
+
type t =
279
+
{ w : int
280
+
; sw : int
281
+
; mw : int
282
+
; mh : int
283
+
; h : int
284
+
; sh : int
285
+
; mutable desc : desc
286
+
; focus : Focus.status
287
+
; mutable flags : flags
288
+
; mutable sensor_cache : (int * int * int * int) option
289
+
; mutable cache : cache
290
+
}
291
+
292
+
and cache =
293
+
{ vx : Interval.t
294
+
; vy : Interval.t
295
+
; image : image
296
+
}
297
+
264
298
and desc =
265
299
| Atom of image
266
300
| Size_sensor of t * size_sensor
···
270
304
| Mouse_handler of t * mouse_handler
271
305
| Focus_area of t * (key -> may_handle)
272
306
| Shift_area of t * int * int
273
-
| Event_filter of t * ([`Key of key | `Mouse of mouse] -> may_handle)
307
+
| Event_filter of t * ([ `Key of key | `Mouse of mouse ] -> may_handle)
274
308
| X of t * t
275
309
| Y of t * t
276
310
| Z of t * t
277
311
312
+
let layout_spec t : layout_spec =
313
+
{ w = t.w; h = t.h; sw = t.sw; sh = t.sh; mw = t.mw; mh = t.mh }
314
+
;;
278
315
279
-
let layout_spec t : layout_spec =
280
-
{ w = t.w; h = t.h; sw = t.sw; sh = t.sh ; mw=t.mw; mh=t.mh }
281
316
let layout_width t = t.w
282
317
let layout_stretch_width t = t.sw
283
318
let layout_height t = t.h
284
319
let layout_stretch_height t = t.sh
285
320
let layout_max_width t = t.mw
286
321
let layout_max_height t = t.mh
287
-
288
-
let cache : cache =
289
-
{ vx = Interval.zero; vy = Interval.zero; image = I.empty }
322
+
let cache : cache = { vx = Interval.zero; vy = Interval.zero; image = I.empty }
290
323
291
324
let empty : t =
292
-
{ w = 0; sw = 0; h = 0; sh = 0; mw= 0; mh=0; flags = flags_none;
293
-
focus = Focus.empty; desc = Atom I.empty;
294
-
sensor_cache = None; cache }
325
+
{ w = 0
326
+
; sw = 0
327
+
; h = 0
328
+
; sh = 0
329
+
; mw = 0
330
+
; mh = 0
331
+
; flags = flags_none
332
+
; focus = Focus.empty
333
+
; desc = Atom I.empty
334
+
; sensor_cache = None
335
+
; cache
336
+
}
337
+
;;
295
338
296
339
let atom img : t =
297
-
{ w = I.width img; sw = 0;
298
-
mw=I.width img;
299
-
mh=I.height img;
300
-
h = I.height img; sh = 0;
301
-
focus = Focus.empty; flags = flags_none;
302
-
desc = Atom img;
303
-
sensor_cache = None; cache; }
340
+
{ w = I.width img
341
+
; sw = 0
342
+
; mw = I.width img
343
+
; mh = I.height img
344
+
; h = I.height img
345
+
; sh = 0
346
+
; focus = Focus.empty
347
+
; flags = flags_none
348
+
; desc = Atom img
349
+
; sensor_cache = None
350
+
; cache
351
+
}
352
+
;;
304
353
305
354
let space_1_0 = atom (I.void 1 0)
306
355
let space_0_1 = atom (I.void 0 1)
···
313
362
| 0, 1 -> space_0_1
314
363
| 1, 1 -> space_1_1
315
364
| _ -> atom (I.void x y)
365
+
;;
316
366
317
-
let mouse_area f t : t =
318
-
{ t with desc = Mouse_handler (t, f) }
367
+
let mouse_area f t : t = { t with desc = Mouse_handler (t, f) }
319
368
320
369
let keyboard_area ?focus f t : t =
321
-
let focus = match focus with
370
+
let focus =
371
+
match focus with
322
372
| None -> t.focus
323
373
| Some focus -> Focus.merge focus t.focus
324
374
in
325
375
{ t with desc = Focus_area (t, f); focus }
376
+
;;
326
377
327
-
let shift_area x y t : t =
328
-
{ t with desc = Shift_area (t, x, y) }
329
-
330
-
let size_sensor handler t : t =
331
-
{ t with desc = Size_sensor (t, handler) }
378
+
let shift_area x y t : t = { t with desc = Shift_area (t, x, y) }
379
+
let size_sensor handler t : t = { t with desc = Size_sensor (t, handler) }
332
380
333
381
let transient_sensor frame_sensor t =
334
-
{ t with desc = Transient_sensor (t, frame_sensor);
335
-
flags = t.flags lor flag_transient_sensor }
382
+
{ t with
383
+
desc = Transient_sensor (t, frame_sensor)
384
+
; flags = t.flags lor flag_transient_sensor
385
+
}
386
+
;;
336
387
337
388
let permanent_sensor frame_sensor t =
338
-
{ t with desc = Permanent_sensor (t, frame_sensor);
339
-
flags = t.flags lor flag_permanent_sensor }
389
+
{ t with
390
+
desc = Permanent_sensor (t, frame_sensor)
391
+
; flags = t.flags lor flag_permanent_sensor
392
+
}
393
+
;;
340
394
341
395
let prepare_gravity = function
342
396
| None, None -> Gravity.(pair default default)
343
397
| Some g, None | None, Some g -> Gravity.(pair g g)
344
398
| Some pad, Some crop -> Gravity.(pair pad crop)
399
+
;;
345
400
346
-
let resize ?w ?h ?sw ?sh ?mw ?mh ?pad ?crop ?(bg=A.empty) t : t =
401
+
let resize ?w ?h ?sw ?sh ?mw ?mh ?pad ?crop ?(bg = A.empty) t : t =
347
402
let g = prepare_gravity (pad, crop) in
348
-
match (w, t.w), (h, t.h), (sw, t.sw), (sh, t.sh), (mw,t.mw) ,(mh,t.mh) with
349
-
| (Some w, _ | None, w), (Some h, _ | None, h),
350
-
(Some sw, _ | None, sw), (Some sh, _ | None, sh), (Some mw, _ | None, mw),(Some mh, _ | None, mh) ->
351
-
let mw= if w>mw then w else mw
352
-
and mh= if h>mh then h else mh
353
-
in
354
-
{t with w; h; sw; sh; mw; mh; desc = Resize (t, g, bg)}
403
+
match (w, t.w), (h, t.h), (sw, t.sw), (sh, t.sh), (mw, t.mw), (mh, t.mh) with
404
+
| ( (Some w, _ | None, w)
405
+
, (Some h, _ | None, h)
406
+
, (Some sw, _ | None, sw)
407
+
, (Some sh, _ | None, sh)
408
+
, (Some mw, _ | None, mw)
409
+
, (Some mh, _ | None, mh) ) ->
410
+
let mw = if w > mw then w else mw
411
+
and mh = if h > mh then h else mh in
412
+
{ t with w; h; sw; sh; mw; mh; desc = Resize (t, g, bg) }
413
+
;;
355
414
356
-
let resize_to ({w; h; sw; sh;mw;mh} : layout_spec) ?pad ?crop ?(bg=A.empty) t : t =
415
+
let resize_to ({ w; h; sw; sh; mw; mh } : layout_spec) ?pad ?crop ?(bg = A.empty) t : t =
357
416
let g = prepare_gravity (pad, crop) in
358
-
let mw= if w>mw then w else mw
359
-
and mh= if h>mh then h else mh
360
-
in
361
-
{t with w; h; sw; sh; mw; mh; desc = Resize (t, g, bg)}
417
+
let mw = if w > mw then w else mw
418
+
and mh = if h > mh then h else mh in
419
+
{ t with w; h; sw; sh; mw; mh; desc = Resize (t, g, bg) }
420
+
;;
362
421
363
422
let event_filter ?focus f t : t =
364
-
let focus = match focus with
423
+
let focus =
424
+
match focus with
365
425
| None -> t.focus
366
426
| Some focus -> focus
367
427
in
368
428
{ t with desc = Event_filter (t, f); focus }
429
+
;;
369
430
370
-
let join_x a b = {
371
-
w = (a.w + b.w); sw = (a.sw + b.sw);
372
-
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
373
-
mw=a.mw+b.mw;
374
-
mh=maxi a.mh b.mh;
375
-
flags = a.flags lor b.flags;
376
-
focus = Focus.merge a.focus b.focus; desc = X (a, b);
377
-
sensor_cache = None; cache
378
-
}
431
+
let join_x a b =
432
+
{ w = a.w + b.w
433
+
; sw = a.sw + b.sw
434
+
; h = maxi a.h b.h
435
+
; sh = maxi a.sh b.sh
436
+
; mw = a.mw + b.mw
437
+
; mh = maxi a.mh b.mh
438
+
; flags = a.flags lor b.flags
439
+
; focus = Focus.merge a.focus b.focus
440
+
; desc = X (a, b)
441
+
; sensor_cache = None
442
+
; cache
443
+
}
444
+
;;
379
445
380
-
let join_y a b = {
381
-
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
382
-
h = (a.h + b.h); sh = (a.sh + b.sh);
383
-
mw=maxi a.mw b.mw;
384
-
mh=a.mh+b.mh;
385
-
flags = a.flags lor b.flags;
386
-
focus = Focus.merge a.focus b.focus; desc = Y (a, b);
387
-
sensor_cache = None; cache;
388
-
}
446
+
let join_y a b =
447
+
{ w = maxi a.w b.w
448
+
; sw = maxi a.sw b.sw
449
+
; h = a.h + b.h
450
+
; sh = a.sh + b.sh
451
+
; mw = maxi a.mw b.mw
452
+
; mh = a.mh + b.mh
453
+
; flags = a.flags lor b.flags
454
+
; focus = Focus.merge a.focus b.focus
455
+
; desc = Y (a, b)
456
+
; sensor_cache = None
457
+
; cache
458
+
}
459
+
;;
389
460
390
-
let join_z a b = {
391
-
w = (maxi a.w b.w); sw = (maxi a.sw b.sw);
392
-
h = (maxi a.h b.h); sh = (maxi a.sh b.sh);
393
-
mw=maxi a.mw b.mw;
394
-
mh=maxi a.mh b.mh;
395
-
flags = a.flags lor b.flags;
396
-
focus = Focus.merge a.focus b.focus; desc = Z (a, b);
397
-
sensor_cache = None; cache;
398
-
}
461
+
let join_z a b =
462
+
{ w = maxi a.w b.w
463
+
; sw = maxi a.sw b.sw
464
+
; h = maxi a.h b.h
465
+
; sh = maxi a.sh b.sh
466
+
; mw = maxi a.mw b.mw
467
+
; mh = maxi a.mh b.mh
468
+
; flags = a.flags lor b.flags
469
+
; focus = Focus.merge a.focus b.focus
470
+
; desc = Z (a, b)
471
+
; sensor_cache = None
472
+
; cache
473
+
}
474
+
;;
399
475
400
-
let pack_x = (empty, join_x)
401
-
let pack_y = (empty, join_y)
402
-
let pack_z = (empty, join_z)
403
-
476
+
let pack_x = empty, join_x
477
+
let pack_y = empty, join_y
478
+
let pack_z = empty, join_z
404
479
let hcat xs = Lwd_utils.reduce pack_x xs
405
480
let vcat xs = Lwd_utils.reduce pack_y xs
406
481
let zcat xs = Lwd_utils.reduce pack_z xs
407
-
408
482
let has_focus t = Focus.has_focus t.focus
409
483
410
484
let rec pp ppf t =
411
-
Format.fprintf ppf
485
+
Format.fprintf
486
+
ppf
412
487
"@[<hov>{@ w = %d;@ h = %d;@ sw = %d;@ sh = %d;@ desc = @[%a@];@ }@]"
413
-
t.w t.h t.sw t.sh pp_desc t.desc
488
+
t.w
489
+
t.h
490
+
t.sw
491
+
t.sh
492
+
pp_desc
493
+
t.desc
414
494
415
495
and pp_desc ppf = function
416
-
| Atom _ -> Format.fprintf ppf "Atom _"
417
-
| Size_sensor (desc, _) ->
418
-
Format.fprintf ppf "Size_sensor (@[%a,@ _@])" pp desc
496
+
| Atom _ -> Format.fprintf ppf "Atom _"
497
+
| Size_sensor (desc, _) -> Format.fprintf ppf "Size_sensor (@[%a,@ _@])" pp desc
419
498
| Transient_sensor (desc, _) ->
420
499
Format.fprintf ppf "Transient_sensor (@[%a,@ _@])" pp desc
421
500
| Permanent_sensor (desc, _) ->
422
501
Format.fprintf ppf "Permanent_sensor (@[%a,@ _@])" pp desc
423
502
| Resize (desc, gravity, _bg) ->
424
-
Format.fprintf ppf "Resize (@[%a,@ %a,@ %a@])" pp desc
425
-
Gravity.pp (Gravity.p1 gravity)
426
-
Gravity.pp (Gravity.p2 gravity)
427
-
| Mouse_handler (n, _) ->
428
-
Format.fprintf ppf "Mouse_handler (@[%a,@ _@])" pp n
429
-
| Focus_area (n, _) ->
430
-
Format.fprintf ppf "Focus_area (@[%a,@ _@])" pp n
431
-
| Shift_area (n, _, _) ->
432
-
Format.fprintf ppf "Shift_area (@[%a,@ _@])" pp n
433
-
| Event_filter (n, _) ->
434
-
Format.fprintf ppf "Event_filter (@[%a,@ _@])" pp n
503
+
Format.fprintf
504
+
ppf
505
+
"Resize (@[%a,@ %a,@ %a@])"
506
+
pp
507
+
desc
508
+
Gravity.pp
509
+
(Gravity.p1 gravity)
510
+
Gravity.pp
511
+
(Gravity.p2 gravity)
512
+
| Mouse_handler (n, _) -> Format.fprintf ppf "Mouse_handler (@[%a,@ _@])" pp n
513
+
| Focus_area (n, _) -> Format.fprintf ppf "Focus_area (@[%a,@ _@])" pp n
514
+
| Shift_area (n, _, _) -> Format.fprintf ppf "Shift_area (@[%a,@ _@])" pp n
515
+
| Event_filter (n, _) -> Format.fprintf ppf "Event_filter (@[%a,@ _@])" pp n
435
516
| X (a, b) -> Format.fprintf ppf "X (@[%a,@ %a@])" pp a pp b
436
517
| Y (a, b) -> Format.fprintf ppf "Y (@[%a,@ %a@])" pp a pp b
437
518
| Z (a, b) -> Format.fprintf ppf "Z (@[%a,@ %a@])" pp a pp b
519
+
;;
438
520
439
-
let iter f ui = match ui.desc with
521
+
let iter f ui =
522
+
match ui.desc with
440
523
| Atom _ -> ()
441
-
| Size_sensor (u, _) | Transient_sensor (u, _) | Permanent_sensor (u, _)
442
-
| Resize (u, _, _) | Mouse_handler (u, _)
443
-
| Focus_area (u, _) | Shift_area (u, _, _) | Event_filter (u, _)
444
-
-> f u
445
-
| X (u1, u2) | Y (u1, u2) | Z (u1, u2) -> f u1; f u2
524
+
| Size_sensor (u, _)
525
+
| Transient_sensor (u, _)
526
+
| Permanent_sensor (u, _)
527
+
| Resize (u, _, _)
528
+
| Mouse_handler (u, _)
529
+
| Focus_area (u, _)
530
+
| Shift_area (u, _, _)
531
+
| Event_filter (u, _) -> f u
532
+
| X (u1, u2) | Y (u1, u2) | Z (u1, u2) ->
533
+
f u1;
534
+
f u2
535
+
;;
446
536
end
537
+
447
538
type ui = Ui.t
448
539
449
-
module Renderer =
450
-
struct
540
+
module Renderer = struct
451
541
open Ui
452
542
453
543
type size = int * int
454
-
455
544
type grab_function = (x:int -> y:int -> unit) * (x:int -> y:int -> unit)
456
-
type t = {
457
-
mutable size : size;
458
-
mutable view : ui;
459
-
mutable mouse_grab : grab_function option;
460
-
}
461
545
462
-
let make () = {
463
-
mouse_grab = None;
464
-
size = (0, 0);
465
-
view = Ui.empty;
466
-
}
546
+
type t =
547
+
{ mutable size : size
548
+
; mutable view : ui
549
+
; mutable mouse_grab : grab_function option
550
+
}
467
551
552
+
let make () = { mouse_grab = None; size = 0, 0; view = Ui.empty }
468
553
let size t = t.size
469
-
470
554
471
555
let solve_focus ui i =
472
556
let rec aux ui =
···
477
561
| Focus.Conflict _ -> Ui.iter aux ui
478
562
in
479
563
aux ui
564
+
;;
480
565
481
-
(* this generates the share of a space between two ui elements *)
566
+
(* this generates the share of a space between two ui elements *)
482
567
let split ~mA:aMax ~mB:bMax ~a ~sa ~b ~sb total =
483
568
(*total stretch value*)
484
569
let stretch = sa + sb in
485
570
(*the free space the two elements have*)
486
571
let flex = total - a - b in
487
572
(*if we have a stretch value and space to stretch into*)
488
-
let canStretch=stretch > 0 && flex > 0 in
489
-
490
-
if canStretch then
491
-
let ratio =
492
-
if sa > sb then
493
-
flex * sa / stretch
494
-
else
495
-
flex - flex * sb / stretch
496
-
497
-
498
-
in
573
+
let canStretch = stretch > 0 && flex > 0 in
574
+
if canStretch
575
+
then (
576
+
let ratio = if sa > sb then flex * sa / stretch else flex - (flex * sb / stretch) in
499
577
(* this is way to complex but basically:
500
-
1. stretch a, if we hit max give the leftover to b
501
-
2. stretch b give the leftover to a
502
-
3. check if a is overstretched
578
+
1. stretch a, if we hit max give the leftover to b
579
+
2. stretch b give the leftover to a
580
+
3. check if a is overstretched
503
581
*)
504
-
let aRatio,bRatio= ref (a+ratio), ref (b+flex-ratio) in
505
-
506
-
let aMaxed =ref false in
507
-
if !aRatio>aMax then
508
-
(
509
-
bRatio:=!bRatio+(!aRatio-aMax);
510
-
aRatio:=aMax ;
511
-
aMaxed:=true
512
-
);
513
-
if (!bRatio)>bMax then
514
-
begin
515
-
if !aMaxed then
516
-
bRatio:=bMax
517
-
else
518
-
aRatio:=!aRatio+(!bRatio-bMax);
519
-
bRatio:=bMax;
520
-
end;
521
-
if !aRatio>aMax then
522
-
aRatio:=aMax ;
523
-
524
-
(!aRatio,!bRatio)
525
-
526
-
else
527
-
(a, b)
582
+
let aRatio, bRatio = ref (a + ratio), ref (b + flex - ratio) in
583
+
let aMaxed = ref false in
584
+
if !aRatio > aMax
585
+
then (
586
+
bRatio := !bRatio + (!aRatio - aMax);
587
+
aRatio := aMax;
588
+
aMaxed := true);
589
+
if !bRatio > bMax
590
+
then (
591
+
if !aMaxed then bRatio := bMax else aRatio := !aRatio + (!bRatio - bMax);
592
+
bRatio := bMax);
593
+
if !aRatio > aMax then aRatio := aMax;
594
+
!aRatio, !bRatio)
595
+
else a, b
596
+
;;
528
597
529
598
let pack ~max ~fixed ~stretch total g1 g2 =
530
599
(*flex is the space we should expand into if we stretch*)
531
600
let flex = total - fixed in
532
-
if stretch > 0 && flex >= 0 && max >total then
533
-
(0, total)
534
-
else
535
-
(* If we can stretch and we have space to expand into and we got here we must have wanted to stretch beyond the max which means we should stretch to max and recalculate the flex*)
536
-
let (fixed,flex)=if stretch > 0 && total >= max then (max,total-max) else (fixed,flex) in
537
-
601
+
if stretch > 0 && flex >= 0 && max > total
602
+
then 0, total
603
+
else (
604
+
(* If we can stretch and we have space to expand into and we got here we must have wanted to stretch beyond the max which means we should stretch to max and recalculate the flex*)
605
+
let fixed, flex =
606
+
if stretch > 0 && total >= max then max, total - max else fixed, flex
607
+
in
538
608
let gravity = if flex >= 0 then g1 else g2 in
539
-
540
609
match gravity with
541
-
| `Negative -> (0, fixed)
542
-
| `Neutral -> (flex / 2, fixed)
543
-
| `Positive -> (flex, fixed)
610
+
| `Negative -> 0, fixed
611
+
| `Neutral -> flex / 2, fixed
612
+
| `Positive -> flex, fixed)
613
+
;;
544
614
545
615
let has_transient_sensor flags = flags land flag_transient_sensor <> 0
546
616
let has_permanent_sensor flags = flags land flag_permanent_sensor <> 0
547
617
548
618
let rec update_sensors ox oy sw sh mw mh ui =
549
-
if has_transient_sensor ui.flags || (
550
-
has_permanent_sensor ui.flags &&
551
-
match ui.sensor_cache with
552
-
| None -> true
553
-
| Some (ox', oy', sw', sh') ->
554
-
not (ox = ox' && oy = oy' && sw = sw' && sh = sh')
555
-
)
619
+
if has_transient_sensor ui.flags
620
+
|| (has_permanent_sensor ui.flags
621
+
&&
622
+
match ui.sensor_cache with
623
+
| None -> true
624
+
| Some (ox', oy', sw', sh') ->
625
+
not (ox = ox' && oy = oy' && sw = sw' && sh = sh'))
556
626
then (
557
627
ui.flags <- ui.flags land lnot flag_transient_sensor;
558
-
if has_permanent_sensor ui.flags then
559
-
ui.sensor_cache <- Some (ox, oy, sw, sh);
628
+
if has_permanent_sensor ui.flags then ui.sensor_cache <- Some (ox, oy, sw, sh);
560
629
match ui.desc with
561
630
| Atom _ -> ()
562
-
| Size_sensor (t, _) | Mouse_handler (t, _)
563
-
| Focus_area (t, _) | Event_filter (t, _) ->
564
-
update_sensors ox oy sw sh mw mh t
631
+
| Size_sensor (t, _) | Mouse_handler (t, _) | Focus_area (t, _) | Event_filter (t, _)
632
+
-> update_sensors ox oy sw sh mw mh t
565
633
| Transient_sensor (t, sensor) ->
566
634
ui.desc <- t.desc;
567
635
let sensor = sensor ~x:ox ~y:oy ~w:sw ~h:sh in
568
-
update_sensors ox oy sw sh mw mh t;
636
+
update_sensors ox oy sw sh mw mh t;
569
637
sensor ()
570
638
| Permanent_sensor (t, sensor) ->
571
639
let sensor = sensor ~x:ox ~y:oy ~w:sw ~h:sh in
···
575
643
let open Gravity in
576
644
let dx, rw = pack ~max:t.mw ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) in
577
645
let dy, rh = pack ~max:t.mh ~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g)) in
578
-
update_sensors (ox + dx) (oy + dy) rw rh mw mh t
579
-
| Shift_area (t, sx, sy) ->
580
-
update_sensors (ox - sx) (oy - sy) sw sh mw mh t
646
+
update_sensors (ox + dx) (oy + dy) rw rh mw mh t
647
+
| Shift_area (t, sx, sy) -> update_sensors (ox - sx) (oy - sy) sw sh mw mh t
581
648
| X (a, b) ->
582
649
let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw ~mA:a.mw ~mB:b.mw sw in
583
650
update_sensors ox oy aw sh mw mh a;
···
585
652
| Y (a, b) ->
586
653
let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh ~mA:a.mh ~mB:b.mh sh in
587
654
update_sensors ox oy sw ah mw mh a;
588
-
update_sensors ox (oy + ah) sw bh mw mh b
655
+
update_sensors ox (oy + ah) sw bh mw mh b
589
656
| Z (a, b) ->
590
657
update_sensors ox oy sw sh mw mh a;
591
-
update_sensors ox oy sw sh mw mh b
592
-
)
658
+
update_sensors ox oy sw sh mw mh b)
659
+
;;
593
660
594
661
(** goes through all focuses and attempts to resolve any that have changed*)
595
662
let update_focus ui =
596
663
match ui.focus with
597
664
| Focus.Empty | Focus.Handle _ -> ()
598
665
| Focus.Conflict i -> solve_focus ui i
666
+
;;
599
667
600
668
let update t size ui =
601
669
t.size <- size;
602
670
t.view <- ui;
603
671
(* TODO:I think i need to do something here*)
604
-
update_sensors 0 0 (fst size) (snd size) (fst size) (snd size)ui;
672
+
update_sensors 0 0 (fst size) (snd size) (fst size) (snd size) ui;
605
673
update_focus ui
674
+
;;
606
675
607
676
let dispatch_mouse st x y btn w h t =
608
677
let handle ox oy f =
609
678
match f ~x:(x - ox) ~y:(y - oy) btn with
610
679
| `Unhandled -> false
611
680
| `Handled -> true
612
-
| `Grab f -> st.mouse_grab <- Some f; true
681
+
| `Grab f ->
682
+
st.mouse_grab <- Some f;
683
+
true
613
684
in
614
685
let rec aux ox oy sw sh t =
615
686
match t.desc with
616
687
| Atom _ -> false
617
688
| X (a, b) ->
618
689
let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw ~mA:a.mh ~mB:b.mh sw in
619
-
if x - ox < aw
620
-
then aux ox oy aw sh a
621
-
else aux (ox + aw) oy bw sh b
690
+
if x - ox < aw then aux ox oy aw sh a else aux (ox + aw) oy bw sh b
622
691
| Y (a, b) ->
623
692
let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh ~mA:a.mh ~mB:b.mh sh in
624
-
if y - oy < ah
625
-
then aux ox oy sw ah a
626
-
else aux ox (oy + ah) sw bh b
627
-
| Z (a, b) ->
628
-
aux ox oy sw sh b || aux ox oy sw sh a
693
+
if y - oy < ah then aux ox oy sw ah a else aux ox (oy + ah) sw bh b
694
+
| Z (a, b) -> aux ox oy sw sh b || aux ox oy sw sh a
629
695
| Mouse_handler (t, f) ->
630
696
let _offsetx, rw = pack ~max:t.mw ~fixed:t.w ~stretch:t.sw sw `Negative `Negative
631
-
and _offsety, rh = pack ~max:t.mh~fixed:t.h ~stretch:t.sh sh `Negative `Negative
697
+
and _offsety, rh =
698
+
pack ~max:t.mh ~fixed:t.h ~stretch:t.sh sh `Negative `Negative
632
699
in
633
700
assert (_offsetx = 0 && _offsety = 0);
634
-
(x - ox >= 0 && x - ox <= rw && y - oy >= 0 && y - oy <= rh) &&
635
-
(aux ox oy sw sh t || handle ox oy f)
701
+
(x - ox >= 0 && x - ox <= rw && y - oy >= 0 && y - oy <= rh)
702
+
&& (aux ox oy sw sh t || handle ox oy f)
636
703
| Size_sensor (desc, _)
637
-
| Transient_sensor (desc, _) | Permanent_sensor (desc, _)
638
-
| Focus_area (desc, _) ->
639
-
aux ox oy sw sh desc
640
-
| Shift_area (desc, sx, sy) ->
641
-
aux (ox - sx) (oy - sy) sw sh desc
704
+
| Transient_sensor (desc, _)
705
+
| Permanent_sensor (desc, _)
706
+
| Focus_area (desc, _) -> aux ox oy sw sh desc
707
+
| Shift_area (desc, sx, sy) -> aux (ox - sx) (oy - sy) sw sh desc
642
708
| Resize (t, g, _bg) ->
643
709
let open Gravity in
644
-
let dx, rw = pack ~max:t.mw~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) in
645
-
let dy, rh = pack ~max:t.mh~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g)) in
710
+
let dx, rw = pack ~max:t.mw ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) in
711
+
let dy, rh = pack ~max:t.mh ~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g)) in
646
712
aux (ox + dx) (oy + dy) rw rh t
647
713
| Event_filter (n, f) ->
648
-
begin match f (`Mouse (`Press btn, (x, y), [])) with
649
-
| `Handled -> true
650
-
| `Unhandled -> aux ox oy sw sh n
651
-
| `Remap _ -> failwith "Cannot remap mouse events"
652
-
end
714
+
(match f (`Mouse (`Press btn, (x, y), [])) with
715
+
| `Handled -> true
716
+
| `Unhandled -> aux ox oy sw sh n
717
+
| `Remap _ -> failwith "Cannot remap mouse events")
653
718
in
654
719
aux 0 0 w h t
720
+
;;
655
721
656
722
let release_grab st x y =
657
723
match st.mouse_grab with
···
659
725
| Some (_, release) ->
660
726
st.mouse_grab <- None;
661
727
release ~x ~y
728
+
;;
662
729
663
730
let dispatch_mouse t (event, (x, y), _mods) =
664
-
if
665
-
match event with
666
-
| `Press btn ->
667
-
release_grab t x y;
668
-
let w, h = t.size in
669
-
dispatch_mouse t x y btn w h t.view
670
-
| `Drag ->
671
-
begin match t.mouse_grab with
731
+
if match event with
732
+
| `Press btn ->
733
+
release_grab t x y;
734
+
let w, h = t.size in
735
+
dispatch_mouse t x y btn w h t.view
736
+
| `Drag ->
737
+
(match t.mouse_grab with
672
738
| None -> false
673
-
| Some (drag, _) -> drag ~x ~y; true
674
-
end
675
-
| `Release ->
676
-
release_grab t x y; true
739
+
| Some (drag, _) ->
740
+
drag ~x ~y;
741
+
true)
742
+
| `Release ->
743
+
release_grab t x y;
744
+
true
677
745
then `Handled
678
746
else `Unhandled
747
+
;;
679
748
680
749
let resize_canvas rw rh image =
681
750
let w = I.width image in
682
751
let h = I.height image in
683
-
if w <> rw || h <> rh
684
-
then I.pad ~r:(rw - w) ~b:(rh - h) image
685
-
else image
752
+
if w <> rw || h <> rh then I.pad ~r:(rw - w) ~b:(rh - h) image else image
753
+
;;
686
754
687
755
let resize_canvas2 ox oy rw rh image =
688
756
let w = I.width image in
689
757
let h = I.height image in
690
758
I.pad ~l:ox ~t:oy ~r:(rw - w - ox) ~b:(rh - h - oy) image
759
+
;;
691
760
692
-
let same_size w h image =
693
-
w = I.width image &&
694
-
h = I.height image
761
+
let same_size w h image = w = I.width image && h = I.height image
695
762
696
763
let rec render_node vx1 vy1 vx2 vy2 sw sh t : cache =
697
-
if
698
-
let cache = t.cache in
699
-
vx1 >= Interval.fst cache.vx && vy1 >= Interval.fst cache.vy &&
700
-
vx2 <= Interval.snd cache.vx && vy2 <= Interval.snd cache.vy &&
701
-
same_size sw sh cache.image
764
+
if let cache = t.cache in
765
+
vx1 >= Interval.fst cache.vx
766
+
&& vy1 >= Interval.fst cache.vy
767
+
&& vx2 <= Interval.snd cache.vx
768
+
&& vy2 <= Interval.snd cache.vy
769
+
&& same_size sw sh cache.image
702
770
then t.cache
703
-
else if vx2 < 0 || vy2 < 0 || sw < vx1 || sh < vy1 then
704
-
let vx = Interval.make vx1 vx2 and vy = Interval.make vy1 vy2 in
705
-
{ vx; vy; image = I.void sw sh }
706
-
else
707
-
let cache = match t.desc with
771
+
else if vx2 < 0 || vy2 < 0 || sw < vx1 || sh < vy1
772
+
then (
773
+
let vx = Interval.make vx1 vx2
774
+
and vy = Interval.make vy1 vy2 in
775
+
{ vx; vy; image = I.void sw sh })
776
+
else (
777
+
let cache =
778
+
match t.desc with
708
779
| Atom image ->
709
-
{ vx = Interval.make 0 sw;
710
-
vy = Interval.make 0 sh;
711
-
image = resize_canvas sw sh image }
780
+
{ vx = Interval.make 0 sw
781
+
; vy = Interval.make 0 sh
782
+
; image = resize_canvas sw sh image
783
+
}
712
784
| Size_sensor (desc, handler) ->
713
785
handler ~w:sw ~h:sh;
714
786
render_node vx1 vy1 vx2 vy2 sw sh desc
···
717
789
| Focus_area (desc, _) | Mouse_handler (desc, _) ->
718
790
render_node vx1 vy1 vx2 vy2 sw sh desc
719
791
| Shift_area (t', sx, sy) ->
720
-
let cache = render_node
721
-
(vx1 + sx) (vy1 + sy) (vx2 + sx) (vy2 + sy) (sx + sw) (sy + sh) t'
792
+
let cache =
793
+
render_node (vx1 + sx) (vy1 + sy) (vx2 + sx) (vy2 + sy) (sx + sw) (sy + sh) t'
722
794
in
723
-
let vx = Interval.make vx1 vx2 and vy = Interval.make vy1 vy2 in
795
+
let vx = Interval.make vx1 vx2
796
+
and vy = Interval.make vy1 vy2 in
724
797
let image = resize_canvas sw sh (I.crop ~l:sx ~t:sy cache.image) in
725
798
{ vx; vy; image }
726
799
| X (a, b) ->
727
800
let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw ~mA:a.mw ~mB:b.mw sw in
728
801
let ca = render_node vx1 vy1 vx2 vy2 aw sh a in
729
802
let cb = render_node (vx1 - aw) vy1 (vx2 - aw) vy2 bw sh b in
730
-
let vx = Interval.make
803
+
let vx =
804
+
Interval.make
731
805
(maxi (Interval.fst ca.vx) (Interval.fst cb.vx + aw))
732
806
(mini (Interval.snd ca.vx) (Interval.snd cb.vx + aw))
733
-
and vy = Interval.make
807
+
and vy =
808
+
Interval.make
734
809
(maxi (Interval.fst ca.vy) (Interval.fst cb.vy))
735
810
(mini (Interval.snd ca.vy) (Interval.snd cb.vy))
736
-
and image = resize_canvas sw sh (I.(<|>) ca.image cb.image) in
811
+
and image = resize_canvas sw sh (I.( <|> ) ca.image cb.image) in
737
812
{ vx; vy; image }
738
813
| Y (a, b) ->
739
814
let ah, bh = split ~a:a.h ~sa:a.sh ~b:b.h ~sb:b.sh ~mA:a.mh ~mB:b.mh sh in
740
815
let ca = render_node vx1 vy1 vx2 vy2 sw ah a in
741
816
let cb = render_node vx1 (vy1 - ah) vx2 (vy2 - ah) sw bh b in
742
-
let vx = Interval.make
817
+
let vx =
818
+
Interval.make
743
819
(maxi (Interval.fst ca.vx) (Interval.fst cb.vx))
744
820
(mini (Interval.snd ca.vx) (Interval.snd cb.vx))
745
-
and vy = Interval.make
821
+
and vy =
822
+
Interval.make
746
823
(maxi (Interval.fst ca.vy) (Interval.fst cb.vy + ah))
747
824
(mini (Interval.snd ca.vy) (Interval.snd cb.vy + ah))
748
-
and image = resize_canvas sw sh (I.(<->) ca.image cb.image) in
825
+
and image = resize_canvas sw sh (I.( <-> ) ca.image cb.image) in
749
826
{ vx; vy; image }
750
827
| Z (a, b) ->
751
828
let ca = render_node vx1 vy1 vx2 vy2 sw sh a in
752
829
let cb = render_node vx1 vy1 vx2 vy2 sw sh b in
753
-
let vx = Interval.make
830
+
let vx =
831
+
Interval.make
754
832
(maxi (Interval.fst ca.vx) (Interval.fst cb.vx))
755
833
(mini (Interval.snd ca.vx) (Interval.snd cb.vx))
756
-
and vy = Interval.make
834
+
and vy =
835
+
Interval.make
757
836
(maxi (Interval.fst ca.vy) (Interval.fst cb.vy))
758
837
(mini (Interval.snd ca.vy) (Interval.snd cb.vy))
759
-
and image = resize_canvas sw sh (I.(</>) cb.image ca.image) in
838
+
and image = resize_canvas sw sh (I.( </> ) cb.image ca.image) in
760
839
{ vx; vy; image }
761
840
| Resize (t, g, bg) ->
762
841
let open Gravity in
763
842
let dx, rw = pack ~max:t.mw ~fixed:t.w ~stretch:t.sw sw (h (p1 g)) (h (p2 g)) in
764
843
let dy, rh = pack ~max:t.mh ~fixed:t.h ~stretch:t.sh sh (v (p1 g)) (v (p2 g)) in
765
-
let c =
766
-
render_node (vx1 - dx) (vy1 - dy) (vx2 - dx) (vy2 - dy) rw rh t
767
-
in
844
+
let c = render_node (vx1 - dx) (vy1 - dy) (vx2 - dx) (vy2 - dy) rw rh t in
768
845
let image = resize_canvas2 dx dy sw sh c.image in
769
-
let image =
770
-
if bg != A.empty then
771
-
I.(image </> char bg ' ' sw sh)
772
-
else
773
-
image
774
-
in
846
+
let image = if bg != A.empty then I.(image </> char bg ' ' sw sh) else image in
775
847
let vx = Interval.shift c.vx dx in
776
848
let vy = Interval.shift c.vy dy in
777
849
{ vx; vy; image }
778
-
| Event_filter (t, _f) ->
779
-
render_node vx1 vy1 vx2 vy2 sw sh t
850
+
| Event_filter (t, _f) -> render_node vx1 vy1 vx2 vy2 sw sh t
780
851
in
781
852
t.cache <- cache;
782
-
cache
853
+
cache)
854
+
;;
783
855
784
-
let image {size = (w, h); view; _} =
856
+
let image { size = w, h; view; _ } =
785
857
(*There is a weird quirk in how rending works that is fixed by having an empty top level node.
786
-
See when you resize you actually resize the parent node and then insert a resize node. That means that if you resize at the top level It doesn't have a parent node and the resize doesn't apply. This is a very odd quirk which can be fixed by ensuring there is always a top level node that doesn't actually do anything.
787
-
Hence we wrap everything in this resize node which does nothing.
858
+
See when you resize you actually resize the parent node and then insert a resize node. That means that if you resize at the top level It doesn't have a parent node and the resize doesn't apply. This is a very odd quirk which can be fixed by ensuring there is always a top level node that doesn't actually do anything.
859
+
Hence we wrap everything in this resize node which does nothing.
788
860
*)
789
-
(render_node 0 0 w h w h (view|>resize)).image
861
+
(render_node 0 0 w h w h (view |> resize)).image
862
+
;;
790
863
791
864
let rec dispatch_raw_key st key =
792
-
let rec iter (sts: ui list) : [> `Unhandled] =
865
+
let rec iter (sts : ui list) : [> `Unhandled ] =
793
866
match sts with
794
867
| [] -> `Unhandled
795
868
| ui :: tl ->
796
-
begin match ui.desc with
797
-
| Atom _ -> iter tl
798
-
| X (a, b) | Y (a, b) | Z (a, b) ->
799
-
(* Try left/top most branch first *)
800
-
let st' =
801
-
if Focus.has_focus b.focus&&Focus.has_focus a.focus
802
-
then b::a :: tl
803
-
else if Focus.has_focus b.focus
804
-
then b :: tl
805
-
else if Focus.has_focus a.focus
806
-
then a :: tl
807
-
(*If neither branch has focus we can just go down both*)
808
-
else b::a :: tl
809
-
in
810
-
iter st'
811
-
| Focus_area (t, f) ->
812
-
begin match iter [t] with
813
-
| `Unhandled ->
814
-
begin
815
-
match f key with
816
-
| `Unhandled -> iter tl
817
-
|other->other
818
-
end
819
-
|other->other
820
-
end
821
-
| Mouse_handler (t, _) | Size_sensor (t, _)
822
-
| Transient_sensor (t, _) | Permanent_sensor (t, _)
823
-
| Shift_area (t, _, _) | Resize (t, _, _) ->
824
-
iter (t :: tl)
825
-
| Event_filter (t, f) ->
826
-
begin match f (`Key key) with
827
-
| `Unhandled -> iter (t :: tl)
828
-
| `Handled -> `Handled
829
-
| `Remap key ->
830
-
dispatch_raw_key st key
831
-
end
832
-
end
869
+
(match ui.desc with
870
+
| Atom _ -> iter tl
871
+
| X (a, b) | Y (a, b) | Z (a, b) ->
872
+
(* Try left/top most branch first *)
873
+
let st' =
874
+
if Focus.has_focus b.focus && Focus.has_focus a.focus
875
+
then b :: a :: tl
876
+
else if Focus.has_focus b.focus
877
+
then b :: tl
878
+
else if Focus.has_focus a.focus
879
+
then a :: tl (*If neither branch has focus we can just go down both*)
880
+
else b :: a :: tl
881
+
in
882
+
iter st'
883
+
| Focus_area (t, f) ->
884
+
(match iter [ t ] with
885
+
| `Unhandled ->
886
+
(match f key with
887
+
| `Unhandled -> iter tl
888
+
| other -> other)
889
+
| other -> other)
890
+
| Mouse_handler (t, _)
891
+
| Size_sensor (t, _)
892
+
| Transient_sensor (t, _)
893
+
| Permanent_sensor (t, _)
894
+
| Shift_area (t, _, _)
895
+
| Resize (t, _, _) -> iter (t :: tl)
896
+
| Event_filter (t, f) ->
897
+
(match f (`Key key) with
898
+
| `Unhandled -> iter (t :: tl)
899
+
| `Handled -> `Handled
900
+
| `Remap key -> dispatch_raw_key st key))
833
901
in
834
-
iter [st.view]
902
+
iter [ st.view ]
903
+
;;
835
904
836
905
exception Acquired_focus
837
906
···
839
908
let rec aux ui =
840
909
match ui.focus with
841
910
| Focus.Empty -> ()
842
-
| Focus.Handle (_, v) -> Focus.request_var v; raise Acquired_focus
911
+
| Focus.Handle (_, v) ->
912
+
Focus.request_var v;
913
+
raise Acquired_focus
843
914
| Focus.Conflict _ -> iter aux ui
844
915
in
845
-
try aux ui; false with Acquired_focus -> true
846
-
916
+
try
917
+
aux ui;
918
+
false
919
+
with
920
+
| Acquired_focus -> true
921
+
;;
847
922
848
923
let rec dispatch_focus t dir =
849
924
match t.desc with
850
925
| Atom _ -> false
851
-
| Mouse_handler (t, _) | Size_sensor (t, _)
852
-
| Transient_sensor (t, _) | Permanent_sensor (t, _)
853
-
| Shift_area (t, _, _) | Resize (t, _, _) | Event_filter (t, _) ->
854
-
dispatch_focus t dir
926
+
| Mouse_handler (t, _)
927
+
| Size_sensor (t, _)
928
+
| Transient_sensor (t, _)
929
+
| Permanent_sensor (t, _)
930
+
| Shift_area (t, _, _)
931
+
| Resize (t, _, _)
932
+
| Event_filter (t, _) -> dispatch_focus t dir
855
933
| Focus_area (t', _) ->
856
-
begin
857
-
match dir with
858
-
| `Out ->
859
-
(*If my element doesn't have focus then I should let a child element take focus or grab focus for myself.
860
-
This should drill down until an element has focus and then let the next element up take the focus *)
861
-
if (Focus.has_focus t'.focus) && (Focus.has_focus t.focus)then
862
-
dispatch_focus t' dir ||grab_focus t
863
-
else if not (Focus.has_focus t'.focus) then
864
-
false
865
-
else
866
-
true
867
-
|_->
868
-
if Focus.has_focus t'.focus then
869
-
dispatch_focus t' dir || grab_focus t
870
-
else if Focus.has_focus t.focus then
871
-
false
872
-
else
873
-
grab_focus t
874
-
end
934
+
(match dir with
935
+
| `Out ->
936
+
(*If my element doesn't have focus then I should let a child element take focus or grab focus for myself.
937
+
This should drill down until an element has focus and then let the next element up take the focus *)
938
+
if Focus.has_focus t'.focus && Focus.has_focus t.focus
939
+
then dispatch_focus t' dir || grab_focus t
940
+
else if not (Focus.has_focus t'.focus)
941
+
then false
942
+
else true
943
+
| _ ->
944
+
if Focus.has_focus t'.focus
945
+
then dispatch_focus t' dir || grab_focus t
946
+
else if Focus.has_focus t.focus
947
+
then false
948
+
else grab_focus t)
875
949
| X (a, b) ->
876
-
begin if Focus.has_focus a.focus then
877
-
dispatch_focus a dir ||
878
-
(match dir with
879
-
| `Out|`Next | `Right -> dispatch_focus b dir
880
-
| _ -> false
881
-
)
882
-
else if Focus.has_focus b.focus then
883
-
dispatch_focus b dir ||
884
-
(match dir with
885
-
| `Out|`Prev | `Left -> dispatch_focus a dir
886
-
| _ -> false
887
-
)
888
-
else
889
-
match dir with
890
-
| `Out|`Prev | `Left | `Up -> dispatch_focus b dir || dispatch_focus a dir
891
-
| `Next | `Down | `Right -> dispatch_focus a dir || dispatch_focus b dir
892
-
|_->false
893
-
end
950
+
if Focus.has_focus a.focus
951
+
then
952
+
dispatch_focus a dir
953
+
||
954
+
match dir with
955
+
| `Out | `Next | `Right -> dispatch_focus b dir
956
+
| _ -> false
957
+
else if Focus.has_focus b.focus
958
+
then
959
+
dispatch_focus b dir
960
+
||
961
+
match dir with
962
+
| `Out | `Prev | `Left -> dispatch_focus a dir
963
+
| _ -> false
964
+
else (
965
+
match dir with
966
+
| `Out | `Prev | `Left | `Up -> dispatch_focus b dir || dispatch_focus a dir
967
+
| `Next | `Down | `Right -> dispatch_focus a dir || dispatch_focus b dir
968
+
| _ -> false)
894
969
| Y (a, b) ->
895
-
begin if Focus.has_focus a.focus then
896
-
dispatch_focus a dir ||
897
-
(match dir with
898
-
| `Out|`Next | `Down -> dispatch_focus b dir
899
-
| _ -> false
900
-
)
901
-
else if Focus.has_focus b.focus then
902
-
dispatch_focus b dir ||
903
-
(match dir with
904
-
| `Out|`Prev | `Up -> dispatch_focus a dir
905
-
| _ -> false
906
-
)
907
-
else match dir with
908
-
|`Out| `Prev | `Up -> dispatch_focus b dir || dispatch_focus a dir
909
-
| `Next | `Left | `Down | `Right -> dispatch_focus a dir || dispatch_focus b dir
910
-
|_->false
911
-
end
970
+
if Focus.has_focus a.focus
971
+
then
972
+
dispatch_focus a dir
973
+
||
974
+
match dir with
975
+
| `Out | `Next | `Down -> dispatch_focus b dir
976
+
| _ -> false
977
+
else if Focus.has_focus b.focus
978
+
then
979
+
dispatch_focus b dir
980
+
||
981
+
match dir with
982
+
| `Out | `Prev | `Up -> dispatch_focus a dir
983
+
| _ -> false
984
+
else (
985
+
match dir with
986
+
| `Out | `Prev | `Up -> dispatch_focus b dir || dispatch_focus a dir
987
+
| `Next | `Left | `Down | `Right -> dispatch_focus a dir || dispatch_focus b dir
988
+
| _ -> false)
912
989
| Z (a, b) ->
913
-
if Focus.has_focus a.focus then
914
-
dispatch_focus a dir
915
-
else
916
-
dispatch_focus b dir || dispatch_focus a dir
990
+
if Focus.has_focus a.focus
991
+
then dispatch_focus a dir
992
+
else dispatch_focus b dir || dispatch_focus a dir
993
+
;;
917
994
918
995
let rec dispatch_key st key =
919
996
match dispatch_raw_key st key, key with
920
997
| `Handled, _ -> `Handled
921
998
| `Remap k, _ -> dispatch_key st k
922
-
| `Unhandled, (`Arrow dir, [`Meta]) ->
923
-
let dir : [`Down | `Left | `Right | `Up] :>
924
-
[`Down | `Left | `Right |`Out| `Up | `Next | `Prev] = dir in
925
-
dispatch_key st (`Focus dir, [`Meta])
999
+
| `Unhandled, (`Arrow dir, [ `Meta ]) ->
1000
+
let dir : [ `Down | `Left | `Right | `Up ]
1001
+
:> [ `Down | `Left | `Right | `Out | `Up | `Next | `Prev ]
1002
+
=
1003
+
dir
1004
+
in
1005
+
dispatch_key st (`Focus dir, [ `Meta ])
926
1006
| `Unhandled, (`Tab, mods) ->
927
1007
let dir = if List.mem `Shift mods then `Prev else `Next in
928
1008
dispatch_key st (`Focus dir, mods)
929
1009
| `Unhandled, (`Focus dir, _) ->
930
1010
if dispatch_focus st.view dir then `Handled else `Unhandled
931
1011
| `Unhandled, _ -> `Unhandled
1012
+
;;
932
1013
933
1014
let dispatch_event t = function
934
1015
| `Key key -> dispatch_key t key
935
1016
| `Mouse mouse -> dispatch_mouse t mouse
936
1017
| `Paste _ -> `Unhandled
1018
+
;;
937
1019
end
938
1020
939
-
module Ui_loop =
940
-
struct
1021
+
module Ui_loop = struct
941
1022
open Notty_unix
942
1023
943
1024
(* FIXME Uses of [quick_sample] and [quick_release] should be replaced by
944
-
[sample] and [release] with the appropriate release management. *)
1025
+
[sample] and [release] with the appropriate release management. *)
945
1026
946
-
let step ?(process_event=true) ?(timeout=(-1.0)) ~renderer term root =
1027
+
let step ?(process_event = true) ?(timeout = -1.0) ~renderer term root =
947
1028
let size = Term.size term in
948
1029
let image =
949
1030
let rec stabilize () =
950
1031
let tree = Lwd.quick_sample root in
951
1032
Renderer.update renderer size tree;
952
1033
let image = Renderer.image renderer in
953
-
if Lwd.is_damaged root
954
-
then stabilize ()
955
-
else image
1034
+
if Lwd.is_damaged root then stabilize () else image
956
1035
in
957
1036
stabilize ()
958
1037
in
959
1038
Term.image term image;
960
-
if process_event then
1039
+
if process_event
1040
+
then (
961
1041
let wait_for_event () =
962
1042
let i, _ = Term.fds term in
963
1043
let rec select () =
964
-
match Unix.select [i] [] [i] timeout with
1044
+
match Unix.select [ i ] [] [ i ] timeout with
965
1045
| [], [], [] -> Term.pending term
966
1046
| _ -> true
967
-
| exception (Unix.Unix_error (Unix.EINTR, _, _)) -> select ()
1047
+
| exception Unix.Unix_error (Unix.EINTR, _, _) -> select ()
968
1048
in
969
1049
select ()
970
1050
in
971
1051
let has_event = timeout < 0.0 || Term.pending term || wait_for_event () in
972
-
if has_event then
1052
+
if has_event
1053
+
then (
973
1054
match Term.event term with
974
1055
| `End -> ()
975
1056
| `Resize _ -> ()
976
1057
| #Unescape.event as event ->
977
1058
let event = (event : Unescape.event :> Ui.event) in
978
-
ignore (Renderer.dispatch_event renderer event : [`Handled | `Unhandled])
1059
+
ignore (Renderer.dispatch_event renderer event : [ `Handled | `Unhandled ])))
1060
+
;;
979
1061
980
-
let run_with_term term ?tick_period ?(tick=ignore) ~renderer quit t =
1062
+
let run_with_term term ?tick_period ?(tick = ignore) ~renderer quit t =
981
1063
let quit = Lwd.observe (Lwd.get quit) in
982
1064
let root = Lwd.observe t in
983
1065
let rec loop () =
984
1066
let quit = Lwd.quick_sample quit in
985
-
if not quit then (
1067
+
if not quit
1068
+
then (
986
1069
step ~process_event:true ?timeout:tick_period ~renderer term root;
987
1070
tick ();
988
-
loop ()
989
-
)
1071
+
loop ())
990
1072
in
991
1073
loop ();
992
1074
ignore (Lwd.quick_release root);
993
1075
ignore (Lwd.quick_release quit)
1076
+
;;
994
1077
995
-
let run ?tick_period ?tick ?term ?(renderer=Renderer.make ())
996
-
?quit ?(quit_on_escape=true) ?(quit_on_ctrl_q=true) t =
997
-
let quit = match quit with
1078
+
let run
1079
+
?tick_period
1080
+
?tick
1081
+
?term
1082
+
?(renderer = Renderer.make ())
1083
+
?quit
1084
+
?(quit_on_escape = true)
1085
+
?(quit_on_ctrl_q = true)
1086
+
t
1087
+
=
1088
+
let quit =
1089
+
match quit with
998
1090
| Some quit -> quit
999
1091
| None -> Lwd.var false
1000
1092
in
1001
-
let t = Lwd.map t ~f:(Ui.event_filter (function
1002
-
| `Key (`ASCII 'Q', [`Ctrl]) when quit_on_ctrl_q ->
1003
-
Lwd.set quit true; `Handled
1004
-
| `Key (`Escape, []) when quit_on_escape ->
1005
-
Lwd.set quit true; `Handled
1006
-
| _ -> `Unhandled
1007
-
))
1093
+
let t =
1094
+
Lwd.map
1095
+
t
1096
+
~f:
1097
+
(Ui.event_filter (function
1098
+
| `Key (`ASCII 'Q', [ `Ctrl ]) when quit_on_ctrl_q ->
1099
+
Lwd.set quit true;
1100
+
`Handled
1101
+
| `Key (`Escape, []) when quit_on_escape ->
1102
+
Lwd.set quit true;
1103
+
`Handled
1104
+
| _ -> `Unhandled))
1008
1105
in
1009
1106
match term with
1010
1107
| Some term -> run_with_term term ?tick_period ?tick ~renderer quit t
···
1012
1109
let term = Term.create () in
1013
1110
run_with_term term ?tick_period ?tick ~renderer quit t;
1014
1111
Term.release term
1015
-
1112
+
;;
1016
1113
end
+12
-4
forks/nottui/lib/nottui/widgets/overlays.ml
+12
-4
forks/nottui/lib/nottui/widgets/overlays.ml
···
219
219
prompt_internal ?pad_w ?pad_h ~focus ~show_prompt:prompt_args ui
220
220
;;
221
221
222
-
let popup ~show_popup_var ui =
222
+
let popup ?(focus = Focus.make ()) ?on_key ~show_popup_var ui =
223
223
let popup_ui =
224
224
let$* show_popup = Lwd.get show_popup_var in
225
225
match show_popup with
226
226
| Some (content, label) ->
227
-
let prompt_field = content in
228
-
prompt_field |>$ Ui.resize ~w:5 ~sw:1 |> BB.box ~label_top:label |> clear_bg
229
-
| None -> Ui.empty |> Lwd.pure
227
+
let ui =
228
+
let$ status = Focus.status focus
229
+
and$ prompt_field = content in
230
+
if not (Focus.has_focus status) then Focus.request_reversable focus;
231
+
prompt_field |> Ui.resize ~w:5 ~sw:1
232
+
in
233
+
ui |> BB.focusable ~focus ~label_top:label ?on_key |> clear_bg
234
+
| None ->
235
+
let$ status = Focus.status focus in
236
+
if Focus.has_focus status then Focus.release_reversable focus;
237
+
Ui.empty
230
238
in
231
239
W.zbox [ ui; popup_ui |>$ Ui.resize ~crop:neutral_grav ~pad:neutral_grav ]
232
240
;;
+2
forks/nottui/lib/nottui/widgets/overlays.mli
+2
forks/nottui/lib/nottui/widgets/overlays.mli
···
75
75
76
76
(**This is a simple popup that can show ontop of other ui elements *)
77
77
val popup :
78
+
?focus:Nottui_main.Focus.handle ->
79
+
?on_key:(Nottui_main.Ui.key->Nottui_main.Ui.may_handle)->
78
80
show_popup_var:(Nottui_main.ui Lwd.t * string) option Lwd.var ->
79
81
Nottui_main.ui Lwd.t -> Nottui_main.ui Lwd.t
+17
-6
forks/nottui/lib/nottui/widgets/selection_list.ml
+17
-6
forks/nottui/lib/nottui/widgets/selection_list.ml
···
60
60
61
61
let multi_selection_list_exclusions
62
62
?(focus = Focus.make ())
63
+
?reset_selections
63
64
?(on_selection_change = fun ~hovered ~selected -> ())
64
65
~custom_handler
65
66
(items : 'a maybe_multi_selectable array Lwd.t)
···
72
73
4. offset by the scroll amount, apply size sensors and output final ui
73
74
*)
74
75
let selected_items_var = Lwd.var MyMap.empty in
76
+
(*provides a way to set this from the outside*)
77
+
reset_selections
78
+
|> Option.iter (Signal.sub (fun x -> selected_items_var $= MyMap.empty));
79
+
(*Lets external functions to reset the selection*)
75
80
(*hovered var is a tuple of (id, overall_idx,selection_idx)*)
76
81
(*we set it up this way so we can avoid double rendering. We sometimes wish to change the value of the hover var during rendering and that would not update till the next render and cause a re-render*)
77
82
let hovered_var = ref (0, 0, 0) in
···
132
137
on_selection_change
133
138
~hovered:item.data
134
139
~selected:
135
-
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_,a) -> a));
140
+
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_, a) -> a));
136
141
items, selectable_items)
137
142
else items, selectable_items
138
143
and$ _ = Lwd.get hover_changed
···
167
172
on_selection_change
168
173
~hovered:(selectable_items.(hovered_idx) |> snd).data
169
174
~selected:
170
-
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_,a) -> a));
175
+
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_, a) -> a));
171
176
`Handled
172
177
| `Arrow `Down, [] ->
173
178
let hovered_idx =
···
181
186
on_selection_change
182
187
~hovered:(selectable_items.(hovered_idx) |> snd).data
183
188
~selected:
184
-
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_,a) -> a));
189
+
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_, a) -> a));
185
190
`Handled
186
191
| `ASCII ' ', [] ->
187
192
let hovered_id, _, hovered_idx = !hovered_var in
188
-
let data=
189
-
(selectable_items.(hovered_idx) |> snd).data in let selected = Lwd.peek selected_items_var in
193
+
let data = (selectable_items.(hovered_idx) |> snd).data in
194
+
let selected = Lwd.peek selected_items_var in
190
195
if selected |> MyMap.mem hovered_id
191
196
then Lwd.set selected_items_var (MyMap.remove hovered_id selected)
192
197
else Lwd.set selected_items_var (MyMap.add hovered_id data selected);
···
194
199
on_selection_change
195
200
~hovered:data
196
201
~selected:
197
-
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_,a)-> a));
202
+
(Lwd.peek selected_items_var |> MyMap.to_list |> List.map (fun (_, a) -> a));
203
+
`Handled
204
+
| `Escape, [] ->
205
+
Lwd.set selected_items_var MyMap.empty;
198
206
`Handled
199
207
| a -> custom_handler ~selected:(Lwd.peek selected_items_var) ~selectable_items a)
200
208
in
···
382
390
383
391
let multi_selection_list_custom
384
392
?(focus = Focus.make ())
393
+
?reset_selections
385
394
?(on_selection_change = fun ~hovered ~selected -> ())
386
395
~custom_handler
387
396
(items : 'a multi_selectable_item list Lwd.t)
388
397
=
389
398
multi_selection_list_exclusions
390
399
~focus
400
+
?reset_selections
391
401
~on_selection_change
392
402
~custom_handler
393
403
(items
···
395
405
let selectable_items = Array.make (List.length items) (Obj.magic ()) in
396
406
items |> List.iteri (fun i x -> Array.set selectable_items i (Selectable x));
397
407
selectable_items)
408
+
;;
398
409
399
410
let selection_list_custom
400
411
?(focus = Focus.make ())
+2
forks/nottui/lib/nottui/widgets/selection_list.mli
+2
forks/nottui/lib/nottui/widgets/selection_list.mli
···
16
16
(** multi_selectable exclusions *)
17
17
val multi_selection_list_exclusions
18
18
: ?focus:Nottui_main.Focus.handle
19
+
-> ?reset_selections:'s Signal.t
19
20
-> ?on_selection_change:(hovered:'a -> selected:'a list -> unit)
20
21
-> custom_handler:
21
22
(selected:'a MyMap.t
···
56
57
Only handles up and down keyboard events. Use [~custom_handler] to do handle confirming your selection and such *)
57
58
val multi_selection_list_custom
58
59
: ?focus:Nottui_main.Focus.handle
60
+
-> ?reset_selections:'s Signal.t
59
61
-> ?on_selection_change:(hovered:'a -> selected:'a list -> unit)
60
62
-> custom_handler:
61
63
(selected:'a MyMap.t
+1
-1
jj_tui/bin/dune
+1
-1
jj_tui/bin/dune
···
1
1
(executable
2
2
(public_name jj_tui)
3
3
(name main)
4
-
(libraries jj_tui nottui base stdio picos_io picos_mux.multififo picos_std.sync picos_std.finally picos_std.structured eio_main eio-process spawn )
4
+
(libraries signal jj_tui nottui base stdio picos_io picos_mux.multififo picos_std.sync picos_std.finally picos_std.structured eio_main eio-process spawn )
5
5
6
6
(preprocess
7
7
(pps logs-ppx ppx_deriving.std))
+2
-1
jj_tui/bin/file_view.ml
+2
-1
jj_tui/bin/file_view.ml
···
93
93
(fun rev ->
94
94
let selected = Lwd.peek active_files in
95
95
confirm_prompt
96
-
("discard all changes to '" ^ (selected|>String.concat "\n") ^ "' in rev " ^ rev)
96
+
("discard all changes to:\n" ^ (selected|>String.concat "\n") ^ "\nin rev " ^ rev)
97
97
(Cmd (["restore"; "--to"; rev; "--from"; rev ^ "-"] @selected)))
98
98
}
99
99
]
···
119
119
*)
120
120
file_uis|>
121
121
W.Lists.multi_selection_list_custom
122
+
~reset_selections:Vars.ui_state.reset_selection
122
123
~on_selection_change:(fun ~hovered ~selected ->
123
124
let active=
124
125
if selected|>List.length =0 then [hovered] else selected
+11
jj_tui/bin/global_vars.ml
+11
jj_tui/bin/global_vars.ml
···
4
4
open Picos_std_structured
5
5
open Lwd_infix
6
6
open Jj_tui.Process
7
+
open Jj_tui.Logging
7
8
8
9
type cmd_args = string list
9
10
···
33
34
; selected_revisions : rev_id maybe_unique list Lwd.var
34
35
; revset : string option Lwd.var
35
36
; trigger_update : unit Lwd.var
37
+
; reset_selection : unit Signal.t
36
38
}
37
39
38
40
let get_unique_id maybe_unique_rev =
···
61
63
val ui_state : ui_state_t
62
64
val update_ui_state : (ui_state_t -> unit) -> unit
63
65
val render_mutex : Eio.Mutex.t
66
+
val reset_selection : unit -> unit
64
67
65
68
(**returns either a change_id or if their are change_id conflicts, a commit_id *)
66
69
val get_hovered_rev : unit -> string
···
102
105
; show_string_selection_prompt = Lwd.var None
103
106
; command_log = Lwd.var []
104
107
; trigger_update = Lwd.var ()
108
+
; reset_selection = Signal.make ~equal:(fun _ _ -> false) ()
105
109
}
106
110
;;
107
111
···
124
128
let get_eio_env () = (Option.get !eio).env
125
129
let get_eio_vars () = Option.get !eio
126
130
let get_term () = Option.get !term
131
+
132
+
let reset_selection () =
133
+
Flock.fork(fun _ ->
134
+
Picos_std_structured.Control.sleep ~seconds:0.7;
135
+
[%log info "Resetting selection"];
136
+
ui_state.reset_selection |> Signal.trigger)
137
+
;;
127
138
128
139
(**Gets an id for the currently hovered revision. If the change_id is unique we use that, if it's not we return a commit_id instead*)
129
140
let get_hovered_rev () = Lwd.peek ui_state.hovered_revision |> get_unique_id
+3
-2
jj_tui/bin/graph_view.ml
+3
-2
jj_tui/bin/graph_view.ml
···
41
41
; {
42
42
key = 'N'
43
43
; description = "Make a new change and insert it after the selected rev"
44
-
; cmd = Dynamic_r (fun rev -> Cmd [ "new"; "--insert-after"; rev ])
44
+
; cmd = Cmd_with_revs (Active [ "new"; "--insert-after"])
45
45
}
46
46
; {
47
47
key = 'n'
48
-
; cmd = Dynamic_r (fun rev -> Cmd [ "new"; rev ])
48
+
; cmd = Cmd_with_revs (Active [ "new" ])
49
49
; description = "Make a new empty change as a child of the selected rev"
50
50
}
51
51
; {
···
425
425
let list_ui =
426
426
items
427
427
|> W.Lists.multi_selection_list_exclusions
428
+
~reset_selections:Vars.ui_state.reset_selection
428
429
~on_selection_change:(fun ~hovered ~selected ->
429
430
(*Respond to change in selected revision*)
430
431
Lwd.set Vars.ui_state.hovered_revision hovered;
+15
-3
jj_tui/bin/jj_commands.ml
+15
-3
jj_tui/bin/jj_commands.ml
···
18
18
| Cmd of cmd_args (** Regular jj command *)
19
19
| Cmd_r of cmd_args
20
20
(** Regular jj command that should operate on the hovered revison *)
21
-
| Cmd_ of cmd_args revision_type
21
+
| Cmd_with_revs of cmd_args revision_type
22
22
(** Regular jj command that should operate on active revisions*)
23
23
| Dynamic of (unit -> 'a command_variant)
24
24
| Dynamic_r of (string -> 'a command_variant)
···
72
72
a, get_selected_revs ()
73
73
| Active a ->
74
74
a, get_active_revs ()
75
+
;;
76
+
77
+
(**resets the selection if there was a selection and the command revision type used it*)
78
+
let reset_selection_post_cmd rev_type =
79
+
match rev_type with
80
+
| Selected _ ->
81
+
Vars.reset_selection ()
82
+
| Active _ ->
83
+
if Vars.get_selected_revs () |> List.length > 0 then Vars.reset_selection ()
84
+
| _ ->
85
+
()
75
86
;;
76
87
77
88
let render_command_line ~indent_level key desc =
···
189
200
ui_state.show_popup $= None;
190
201
noOut (args @ [ "-r"; Vars.get_hovered_rev () ]);
191
202
raise Handled
192
-
| Cmd_ rev_type ->
203
+
| Cmd_with_revs rev_type ->
193
204
let args, revs = get_revs rev_type in
194
205
ui_state.show_popup $= None;
195
206
noOut (args @ ("-r" :: revs));
207
+
reset_selection_post_cmd rev_type;
196
208
raise Handled
197
209
| Prompt (str, args) ->
198
210
ui_state.show_popup $= None;
···
200
212
raise Handled
201
213
| Prompt_r (str, args) ->
202
214
ui_state.show_popup $= None;
203
-
prompt str (`Cmd (args @ [ "-r"; Vars.get_hovered_rev() ]));
215
+
prompt str (`Cmd (args @ [ "-r"; Vars.get_hovered_rev () ]));
204
216
raise Handled
205
217
| PromptThen (label, next) ->
206
218
ui_state.show_popup $= None;
+3
jj_tui/bin/jj_ui.ml
+3
jj_tui/bin/jj_ui.ml
···
141
141
|> W.Overlay.selection_list_prompt_filterable
142
142
~show_prompt_var:ui_state.show_string_selection_prompt
143
143
|> inputs ~custom:(function
144
+
144
145
| `Enter, [] ->
145
146
Focus.request_reversable summary_focus;
146
147
`Handled
148
+
| `ASCII k, [] ->
149
+
Jj_commands.handleInputs Jj_commands.default_list k
147
150
| _ ->
148
151
`Unhandled)
149
152
;;