console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

well inuit integration kinda works but is still v broken

Browse Source
This commit is contained in:
cqc
2021-10-14 10:05:22 -05:00
parent 4ec076826c
commit 50073f19e1
1 changed files with 104 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
human.ml
View File

@ -823,7 +823,7 @@ module Panel = struct
, ( Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box))
, !node ) )
let format_symbolic_output_buffer (ppf : Format.formatter) buf =
let format_symbolic_output_items (ppf : Format.formatter) buf =
List.iter
Format.(
function
@ -832,6 +832,10 @@ module Panel = struct
| Output_string s -> Format.pp_print_string ppf s
| Output_spaces n | Output_indent n ->
Format.pp_print_string ppf (String.make n ' '))
buf
let format_symbolic_output_buffer (ppf : Format.formatter) buf =
format_symbolic_output_items ppf
(Format.get_symbolic_output_buffer buf)
let prettyprint ?(height = !g_text_height) ?(tag = "pretty-print")
@ -1046,6 +1050,15 @@ module Panel = struct
end
module InuitTextedit = struct
(* Most of this module stolen from https://github.com/let-def/inuit and heavily modified:
Copyright (c) 2016 Frédéric Bour
Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
open Format
type 'a clickable = [> `Clickable | `Clicked] as 'a
@ -1383,8 +1396,7 @@ module Panel = struct
let {Patch.operation; offset= _; text_len; flags= _} =
patch in
match operation with
| Patch.Remove n -> remote_replace b patch n 0
| Patch.Replace (n, _) ->
| Patch.Remove n | Patch.Replace (n, _) ->
remote_replace b patch n text_len
| Patch.Insert _ -> remote_insert b patch text_len
| Patch.Propertize n -> remote_propertize b patch n )
@ -1410,6 +1422,9 @@ module Panel = struct
let trope = buffer.trope in
let offset = Trope.position trope t.left in
let length = Trope.position trope t.right - offset in
F.epr " generic_clear: t.right=%d t.left=%d@."
(Trope.position trope t.left)
(Trope.position trope t.right) ;
let patch = Patch.make ~offset [] (Patch.Remove length) in
let observed =
notify_observers buffer `Local t ~stop_at:[] patch in
@ -1524,13 +1539,6 @@ module Panel = struct
type 'flags clickable = [> `Clickable | `Clicked] as 'flags
let count_char str chr =
let count = ref 0 in
for i = 0 to String.length str - 1 do
if str.[i] = chr then incr count
done ;
!count
let indent_text col text =
if col <= 0 then text
else
@ -1591,7 +1599,7 @@ module Panel = struct
List.iter
(function
| Output_string s -> F.epr "printf: %s @." s | _ -> () )
(Format.flush_symbolic_output_buffer sob) ;
(Format.get_symbolic_output_buffer sob) ;
text t ?flags (Format.flush_symbolic_output_buffer sob)
let link t ?flags fmt f =
@ -1616,6 +1624,12 @@ module Panel = struct
{t with indent= max 0 (t.indent + indent)}
end
let rec list_split i ?(left = []) = function
| [] -> (left, [])
| x :: xs ->
if i <= 0 then (left, x :: xs)
else list_split (i - 1) ~left:(left @ [x]) xs
module Edit = struct
open Cursor
@ -1623,12 +1637,6 @@ module Panel = struct
{ mutable cursor: 'flags cursor
; mutable state: Format.symbolic_output_buffer }
let rec list_split i ?(left = []) = function
| [] -> (left, [])
| x :: xs ->
if i <= 0 then (left, x :: xs)
else list_split (i - 1) ~left:(left @ [x]) xs
let make ?(state = []) ?on_change cursor =
let t =
{cursor; state= Format.make_symbolic_output_buffer ()} in
@ -1667,8 +1675,7 @@ module Panel = struct
; mutable next: 'flags page list
; frame: 'flags frame option }
and 'flags page =
Format.symbolic_output_buffer * ('flags frame -> unit)
and 'flags page = Patch.symbols * ('flags frame -> unit)
and 'flags frame =
{title: 'flags cursor; body: 'flags cursor; nav: 'flags t}
@ -1680,11 +1687,10 @@ module Panel = struct
let update_frame t =
match t.frame with
| None -> ()
| Some frame ->
let {title; body; nav= _} = frame in
| Some ({title; body; nav= _} as frame) ->
clear title ;
text title
(Format.get_symbolic_output_buffer (fst t.page)) ;
text title (fst t.page) ;
F.epr "Nav.update_frame clear body@." ;
clear body ;
(snd t.page) frame
@ -1748,21 +1754,21 @@ module Panel = struct
| `Custom of string ]
type t =
{ edit: flag Cursor.cursor
; sock: flag Patch.t Socket.t
; view: flag Nav.t
; bind: Input.Bind.state }
{ mutable edit: flag Cursor.cursor
; mutable sock: flag Patch.t Socket.t
; mutable buf: Format.symbolic_output_item list
; mutable view: flag Nav.t
; mutable bind: Input.Bind.state }
let clear t = Cursor.clear t.edit
let insert t = Cursor.text t.edit
let contents t : Format.symbolic_output_item list = t.buf
let contents t : Format.symbolic_output_buffer =
(t.view.page.)
let pr s =
let pr_sob s =
let sob = make_symbolic_output_buffer () in
let pp = formatter_of_symbolic_output_buffer sob in
F.pf pp s ; sob
F.pf pp s ;
flush_symbolic_output_buffer sob
let bindings _t =
let open Input.Bind in
@ -1807,33 +1813,75 @@ module Panel = struct
@@ add [([Meta], Char 'v')] [Custom (fun () -> ())]
@@ empty
let make ?(bindings = bindings) title main =
let sob = Format.make_symbolic_output_buffer () in
let make ?(bindings = bindings) ?on_change main =
let open Cursor in
let edit, sock = Cursor.make () in
let sock' = Socket.make ~receive:ignore in
Socket.connect
~a:(Socket.endpoint sock)
~b:(Socket.endpoint sock') ;
let t =
{ edit
; sock
; buff = sob
; buf= []
; view=
( Nav.make title
( F.epr "Nav.make@." ;
Nav.make (pr_sob "MR. DERPSALOT")
@@ fun {Nav.title= _; body; nav} ->
let open Cursor in
printf body "Je mens.\n\n" ;
printf body "Je mens.@.@." ;
link body "- C'est vrai." (fun _ ->
Nav.push nav (pr "C'est vrai !")
Nav.push nav (pr_sob "C'est vrai !")
@@ fun {Nav.body; _} -> printf body "C'est faux." ) ;
printf body "\n" ;
printf body "@." ;
link body "- C'est faux." (fun _ ->
Nav.push nav (pr "C'est faux !")
Nav.push nav (pr_sob "C'est faux !")
@@ fun {Nav.body; _} -> printf body "C'est vrai." ) ;
printf body "\n" ;
printf body main )
printf body "@." ;
printf body main ;
F.epr "Nav.make callback@." )
; bind= Input.Bind.init Input.Bind.empty } in
let sock' =
Socket.make (*~receive:ignore*)
~receive:
Patch.(
fun p ->
F.epr "Patch.t {offset=%d, operation=" p.offset ;
match p.operation with
| Insert s ->
F.epr "Insert (sob len %d) \"" (List.length s) ;
format_symbolic_output_items F.stderr s ;
F.epr "\"@."
| Replace (i, s) ->
F.epr "Replace %d \"" i ;
format_symbolic_output_items F.stderr s ;
F.epr "\"@."
| Remove i -> F.epr "Remove %d@." i
| Propertize i ->
F.epr "Propertize %d@." i ;
F.epr ", text_len=%d}@." p.text_len) in
Socket.connect ~a:t.sock ~b:(Socket.endpoint sock') ;
printf (add_flag `Prompt edit) "# " ;
Cursor.printf edit main ;
t.edit <-
observe edit (fun cursor' side p ->
let offset =
p.Patch.offset
- Inuit_region.unsafe_left_offset (region cursor') in
F.epr
"observe edit: (length t.buf)=%d; offset=(p.offset=%d \
- unsafe_left_offset=%d)=%d @."
(List.length t.buf) p.Patch.offset
(Inuit_region.unsafe_left_offset (region cursor'))
offset ;
( match p.operation with
| Insert _ ->
let sl, sr = list_split offset t.buf in
t.buf <- sl @ Patch.inserted_text p @ sr
| Replace (i, _) | Remove i ->
let sl, sr = list_split offset t.buf in
let _, sr = list_split i sr in
t.buf <- sl @ Patch.inserted_text p @ sr
| Propertize i -> F.epr "Propertize %d@." i ) ;
let callback =
if side = `Remote then on_change else None in
(p.Patch.flags, callback) ) ;
t.bind.bindings <- bindings t ;
t
@ -1860,12 +1908,8 @@ module Panel = struct
Lwt.return
(draw_pp height (fun pp ->
Format.pp_open_hvbox pp 0 ;
F.epr "format_symbolic_output_buffer: @." ;
format_symbolic_output_buffer F.stderr
(contents t) ;
format_symbolic_output_buffer pp (contents t) ;
format_symbolic_output_items pp (contents t) ;
F.pf pp "@." ;
F.epr "@." ;
Format.pp_close_box pp () ) ) )
; subpanels= []
; tag= "textedit" }
@ -2261,8 +2305,8 @@ let root_actor = ref (std_actor (Store.editor "../rootstore"))
open Panel
let inuit_test =
let t = InuitTextedit.make (Format.make_symbolic_output_buffer ()) in
InuitTextedit.panel (t " TEST @. What @. Help @.")
let t = InuitTextedit.make " TEST @. What @. Help @." in
InuitTextedit.panel t
let start () =
root_actor := std_actor inuit_test ;