diff --git a/src/compiler/ast.ml b/src/compiler/ast.ml index 97f5c2f8..5e64b2b7 100644 --- a/src/compiler/ast.ml +++ b/src/compiler/ast.ml @@ -191,10 +191,9 @@ module Utils = struct (** Get the attributes of a cmarkit node, returns them and the element stripped of its attributes *) - let merge_attribute new_attrs b = + let merge_attribute ~keep_base new_attrs b = let merge (base, meta) = - (Attributes.merge ~base ~new_attrs, meta) - (* Old attributes take precendence over "new" one *) + (Attributes.merge ~keep_base ~base ~new_attrs, meta) in match update_attribute merge b with None -> b | Some (b, _) -> b @@ -299,10 +298,9 @@ module Utils = struct (** Get the attributes of a cmarkit node, returns them and the element stripped of its attributes *) - let merge_attribute new_attrs b = + let merge_attribute ~keep_base new_attrs b = let merge (base, meta) = - (Attributes.merge ~base ~new_attrs, meta) - (* Old attributes take precendence over "new" one *) + (Attributes.merge ~keep_base ~base ~new_attrs, meta) in match update_attribute merge b with None -> b | Some (b, _) -> b diff --git a/src/compiler/compile.ml b/src/compiler/compile.ml index f63c23cc..88fef3c1 100644 --- a/src/compiler/compile.ml +++ b/src/compiler/compile.ml @@ -177,7 +177,8 @@ module Stage1 = struct | None -> None | Some ((ld, (attrs_ld, meta2)), meta) -> let attrs = - Cmarkit.Attributes.merge ~base:attrs ~new_attrs:attrs_ld + Cmarkit.Attributes.merge ~keep_base:true ~base:attrs + ~new_attrs:attrs_ld in let kind = classify_link_definition ld attrs in let attrs_ld = Mapper.map_attrs m attrs_ld in @@ -353,10 +354,10 @@ module Stage1 = struct { Cmarkit.Attributes.v; delimiter = Some '"' } in ( attrs - |> Cmarkit.Attributes.add + |> Cmarkit.Attributes.add ~keep_base:true (Special_attrs.gui_file, Meta.none) (Some (file_attr, Meta.none)) - |> Cmarkit.Attributes.add + |> Cmarkit.Attributes.add ~keep_base:true (Special_attrs.gui_id, Meta.none) (Some (id_attr, Meta.none)), meta )) @@ -441,14 +442,20 @@ module Stage2 = struct | Some key -> ( match (categorize key, value) with | `Class c, None -> Attributes.add_class acc (c, meta) - | `Kv c, _ -> Attributes.add (c, meta) value acc + | `Kv c, _ -> + Attributes.add ~keep_base:false (c, meta) value acc | `Class c, Some (_, v_meta) -> Diagnosis.add (ChildrenClassWithValue { loc = Meta.textloc v_meta }); Attributes.add_class acc (c, meta))) Attributes.empty kvs in - let bs = List.map (Ast.Utils.Block.merge_attribute new_attrs) bs in + let bs = + (* keep_base true to avoid erasing more specific attributes *) + List.map + (Ast.Utils.Block.merge_attribute ~keep_base:true new_attrs) + bs + in let bs = match Mapper.map_block m (Block.Blocks (bs, m_bs)) with | None -> Block.Blocks ([], m_bs) @@ -497,7 +504,10 @@ module Stage3 = struct || Attributes.mem Actions_arguments.Enter.on attrs) || not may_enter then attrs - else Attributes.add (Actions_arguments.Enter.on, Meta.none) None attrs + else + Attributes.add ~keep_base:true + (Actions_arguments.Enter.on, Meta.none) + None attrs in let attrs = Mapper.map_attrs m attrs in (b, (attrs, meta2)) @@ -880,16 +890,16 @@ let to_cmarkit units = | Ast.S_inline i -> inline m i | _ -> Mapper.default in - let attrs = - Cmarkit.Attributes.map (function - | `Kv (("up-at-unpause", m), v) -> [ `Kv (("up", m), v) ] - | `Kv (("center-at-unpause", m), v) -> [ `Kv (("center", m), v) ] - | `Kv (("enter-at-unpause", m), v) -> [ `Kv (("enter", m), v) ] - | `Kv (("down-at-unpause", m), v) -> [ `Kv (("down", m), v) ] - | `Kv (("exec-at-unpause", m), v) -> [ `Kv (("exec", m), v) ] - | `Kv (("scroll-at-unpause", m), v) -> [ `Kv (("scroll", m), v) ] - | x -> [ x ]) + let attrs = function + | `Kv (("up-at-unpause", m), v) -> [ `Kv (("up", m), v) ] + | `Kv (("center-at-unpause", m), v) -> [ `Kv (("center", m), v) ] + | `Kv (("enter-at-unpause", m), v) -> [ `Kv (("enter", m), v) ] + | `Kv (("down-at-unpause", m), v) -> [ `Kv (("down", m), v) ] + | `Kv (("exec-at-unpause", m), v) -> [ `Kv (("exec", m), v) ] + | `Kv (("scroll-at-unpause", m), v) -> [ `Kv (("scroll", m), v) ] + | x -> [ x ] in + let attrs = Attributes.map attrs in Ast.Mapper.make ~block ~inline ~attrs () let to_cmarkit diff --git a/src/compiler/frontmatter.ml b/src/compiler/frontmatter.ml index cf60448e..e30f18a2 100644 --- a/src/compiler/frontmatter.ml +++ b/src/compiler/frontmatter.ml @@ -73,7 +73,9 @@ module Global = struct (match (x.toplevel_attributes, y.toplevel_attributes) with | Some (a1, meta1), Some (a2, _meta2) -> (* Hopefully not merging the locations is fine *) - Some (Cmarkit.Attributes.merge ~base:a1 ~new_attrs:a2, meta1) + Some + ( Cmarkit.Attributes.merge ~keep_base:false ~base:a1 ~new_attrs:a2, + meta1 ) | (Some _ as a), _ | _, (Some _ as a) -> a | None, None -> None); } @@ -132,7 +134,7 @@ module Attributes = struct | None -> v | Some (a, _meta2) -> (* Hopefully not merging the locations is fine *) - Cmarkit.Attributes.merge ~base:a ~new_attrs:v + Cmarkit.Attributes.merge ~keep_base:false ~base:a ~new_attrs:v in { fm with local = { attributes = Some (v, meta1) } } end @@ -162,7 +164,7 @@ module Toplevel_attributes = struct | None -> v | Some (a, _meta2) -> (* Hopefully not merging the locations is fine *) - Cmarkit.Attributes.merge ~base:a ~new_attrs:v + Cmarkit.Attributes.merge ~keep_base:false ~base:a ~new_attrs:v in { fm with diff --git a/src/compiler/renderers.ml b/src/compiler/renderers.ml index d9282012..58dda97c 100644 --- a/src/compiler/renderers.ml +++ b/src/compiler/renderers.ml @@ -212,8 +212,9 @@ let svg c ~uri ~files i attrs = match src with | `Link l -> let attrs = - attrs |> add_escaped_attrs "data" l - |> add_escaped_attrs "type" "image/svg+xml" + attrs + |> add_escaped_attrs ~keep_base:false "data" l + |> add_escaped_attrs ~keep_base:false "type" "image/svg+xml" in media ~self_closing:false ~media_name:"object" c ~uri ~files i attrs | `Source (content, _mime_type) -> @@ -241,9 +242,10 @@ let pure_embed ~root c ~name uri files attrs = in let attrs = attrs - |> add_escaped_attrs "x-path" (Fpath.to_string p) - |> add_escaped_attrs "x-data" (Option.value ~default:"" content) - |> add_escaped_attrs "x-name" name + |> add_escaped_attrs ~keep_base:false "x-path" (Fpath.to_string p) + |> add_escaped_attrs ~keep_base:false "x-data" + (Option.value ~default:"" content) + |> add_escaped_attrs ~keep_base:false "x-name" name in Context.string c " let attrs = - Attributes.add ("type", Meta.none) + Attributes.add ~keep_base:false ("type", Meta.none) (Some ({ v = "slip-script"; delimiter = None }, Meta.none)) attrs in diff --git a/src/engine/previewer/dune b/src/engine/previewer/dune index e3e99af7..16aba032 100644 --- a/src/engine/previewer/dune +++ b/src/engine/previewer/dune @@ -1,4 +1,12 @@ (library (name previewer) (public_name slipshow.previewer) - (libraries communication brr slipshow js_of_ocaml-lwt lwt ansi actions_arguments common_types)) + (libraries + communication + brr + slipshow + js_of_ocaml-lwt + lwt + ansi + actions_arguments + common_types)) diff --git a/src/engine/previewer/previewer.mli b/src/engine/previewer/previewer.mli index 8506dd35..b18a9b40 100644 --- a/src/engine/previewer/previewer.mli +++ b/src/engine/previewer/previewer.mli @@ -14,9 +14,7 @@ val create_previewer : ?callback:(int -> unit) -> ?save_drawing:(path:string -> content:string -> unit) -> save_coordinate: - (id:Common_types.gui_id -> - coord:Actions_arguments.Gui.t -> - unit) -> + (id:Common_types.gui_id -> coord:Actions_arguments.Gui.t -> unit) -> goto_loc:(Common_types.gui_id -> unit) -> include_speaker_view:bool -> errors_el:Brr.El.t -> diff --git a/src/engine/runtime/messaging/messaging.mli b/src/engine/runtime/messaging/messaging.mli index ed7936b8..095a3b61 100644 --- a/src/engine/runtime/messaging/messaging.mli +++ b/src/engine/runtime/messaging/messaging.mli @@ -15,8 +15,5 @@ val open_speaker_notes : unit -> unit val send_speaker_notes : string -> unit val opened_recording_panel : unit -> unit val closed_recording_panel : unit -> unit - -val send_gui_coordinate : - Common_types.gui_id -> Actions_arguments.Gui.t -> unit - +val send_gui_coordinate : Common_types.gui_id -> Actions_arguments.Gui.t -> unit val send_loc : Common_types.gui_id -> unit diff --git a/src/lspishow/roots.mli b/src/lspishow/roots.mli index e1bd6f80..ceb62894 100644 --- a/src/lspishow/roots.mli +++ b/src/lspishow/roots.mli @@ -14,7 +14,7 @@ val saved : t (** The roots for the saved buffers. *) val update_root : - should_broadcast: bool -> + should_broadcast:bool -> Slipshow.Compile.file_reader -> t -> Slipshow.Ast.unit' Fpath.map -> diff --git a/src/server/proto/proto.mli b/src/server/proto/proto.mli index bc2cd314..54450f26 100644 --- a/src/server/proto/proto.mli +++ b/src/server/proto/proto.mli @@ -12,10 +12,7 @@ module Client_to_server : sig | Ping | UpdateFrom of string | Save_drawing of string * string (* path * content *) - | Save_gui_position of { - id : Common_types.gui_id; - coord : string; - } + | Save_gui_position of { id : Common_types.gui_id; coord : string } | GotoLoc of Common_types.gui_id include Serializing with type t := t diff --git a/src/server/slipshow_server.mli b/src/server/slipshow_server.mli index b046157b..c7654ffc 100644 --- a/src/server/slipshow_server.mli +++ b/src/server/slipshow_server.mli @@ -29,9 +29,7 @@ val do_watch : module Server : sig val do_serve : port:int -> - to_lsp_server: - (Proto.Client_to_server.t -> root -> unit) - option -> + to_lsp_server:(Proto.Client_to_server.t -> root -> unit) option -> roots -> (unit, [> `Addr_in_use ]) result Lwt.t end diff --git a/test/compiler/dash-separator/children-slides.t/run.t b/test/compiler/dash-separator/children-slides.t/run.t index 55b4efb1..a14dbf46 100644 --- a/test/compiler/dash-separator/children-slides.t/run.t +++ b/test/compiler/dash-separator/children-slides.t/run.t @@ -1,20 +1,15 @@ $ export SLIPSHOW__SECRET__NO_ENGINE=TRUE $ slipshow compile slides.md - warning: Non standard attribute: 'key' - ┌─ slides.md:24:2 - 24 │ {children:key=value #attributes} - │ ^^^^^^^^^^^^ + warning: Non standard attribute: 'k' + ┌─ slides.md:33:2 + 33 │ {k=v key="other value"} + │ ^ warning: Non standard attribute: 'key' ┌─ slides.md:33:6 33 │ {k=v key="other value"} │ ^^^ - warning: Non standard attribute: 'k' - ┌─ slides.md:33:2 - 33 │ {k=v key="other value"} - │ ^ - warning: Non standard attribute: 'key' ┌─ slides.md:24:2 24 │ {children:key=value #attributes} @@ -65,7 +60,7 @@

A

-
+

B diff --git a/test/compiler/slides.t/run.t b/test/compiler/slides.t/run.t index eac53048..857d6057 100644 --- a/test/compiler/slides.t/run.t +++ b/test/compiler/slides.t/run.t @@ -15,7 +15,7 @@ We can compile the file using the slip_of_mark binary

-
+
First title
diff --git a/vendor/github.com/panglesd/cmarkit/src/cmarkit.ml b/vendor/github.com/panglesd/cmarkit/src/cmarkit.ml index 0f5bc65b..df7329da 100644 --- a/vendor/github.com/panglesd/cmarkit/src/cmarkit.ml +++ b/vendor/github.com/panglesd/cmarkit/src/cmarkit.ml @@ -148,11 +148,15 @@ module Attributes = struct let class' t = t.class' - let add_class t class' = { t with class' = class' :: t.class'} + let add_class t class' = + if + List.exists (fun (cl, _meta) -> String.equal cl (fst class')) t.class' + then t + else { t with class' = class' :: t.class'} let remove_class t class' = { t with - class' = List.filter (fun (c, _) -> compare class' c <> 0) t.class' + class' = List.filter (fun (c, _) -> not (String.equal class' c)) t.class' } (** {1 Id}) *) @@ -170,15 +174,27 @@ module Attributes = struct let mem key t = List.exists (function ((k, _), _) -> String.equal k key) t.kv_attributes - let add (key, meta) value t = + let add ~keep_base (key, meta) value t = match key, value with | "id", Some ({v = value; _}, meta) -> - set_id t (value, meta) + (match id t with + | Some _ when keep_base -> t + | _ -> set_id t (value, meta) + ) | "class", Some ({v = value; _}, meta) -> let values = String.split_on_char ' ' value in List.fold_left (fun t value -> add_class t (value, meta)) t values | _ -> - let kv_attributes = ((key, meta), value) :: t.kv_attributes in + let mem_key = mem key t in + if keep_base && mem_key then t else + let kv_attributes = + if mem_key then + List.map + (function | ((k, _), _) when String.equal k key -> ((key, meta), value) + | x -> x) + t.kv_attributes + else ((key, meta), value) :: t.kv_attributes + in { t with kv_attributes } let remove key t = @@ -190,10 +206,17 @@ module Attributes = struct let find key t = List.find_opt (function ((k, _), _) -> String.equal k key) t.kv_attributes - let merge ~base ~new_attrs = - let base = match id new_attrs with None -> base | Some id -> set_id base id in + let merge ~keep_base ~base ~new_attrs = + let base = + match id base, id new_attrs with + | Some _, _ when keep_base -> base + | _, None -> base + | _, Some id -> set_id base id + in let base = List.fold_left add_class base (class' new_attrs) in - List.fold_left (fun base (k, v) -> add k v base) base (kv_attributes new_attrs) + List.fold_left + (fun base (k, v) -> add ~keep_base k v base) + base (kv_attributes new_attrs) (** Merge *) @@ -205,7 +228,7 @@ module Attributes = struct (fun acc -> function | `Class x -> add_class acc x | `Id id -> set_id acc id - | `Kv (x,y) -> add x y acc) + | `Kv (x,y) -> add ~keep_base:false x y acc) empty (class' @ id @ kv_attrs) end @@ -1779,7 +1802,7 @@ module Inline_struct = struct let v, meta = attr_of_rev_spans p value in Some ({Attributes.v ; delimiter}, meta) in - Attributes.add key value attrs + Attributes.add ~keep_base:false key value attrs in let attrs = List.fold_right add_attribute new_attrs attrs in let first = p.current_char and last = p.current_line_last_char in @@ -2852,7 +2875,7 @@ module Block_struct = struct let (v, meta) = Inline_struct.attr_of_rev_spans p value in Some ({Attributes.v ; delimiter}, meta) in - Attributes.add key value attrs + Attributes.add ~keep_base:false key value attrs in let new_attrs = List.fold_right add_attribute new_attrs Attributes.empty, Meta.none @@ -2883,7 +2906,7 @@ module Block_struct = struct let (v, meta) = (Inline_struct.attr_of_rev_spans p value) in Some ({Attributes.v ; delimiter}, meta) in - Attributes.add key value attrs + Attributes.add ~keep_base:false key value attrs in let attrs = List.fold_right add_attribute new_attrs attrs in let first = p.current_char and last = p.current_line_last_char in diff --git a/vendor/github.com/panglesd/cmarkit/src/cmarkit.mli b/vendor/github.com/panglesd/cmarkit/src/cmarkit.mli index 9a47fffd..3293e596 100644 --- a/vendor/github.com/panglesd/cmarkit/src/cmarkit.mli +++ b/vendor/github.com/panglesd/cmarkit/src/cmarkit.mli @@ -313,7 +313,7 @@ module Attributes : sig val mem : key -> t -> bool (** [mem k m] is [true] iff [k] is bound in [m]. *) - val add : key node -> value node option -> t -> t + val add : keep_base:bool -> key node -> value node option -> t -> t (** [add k v m] is [m] with key [k] bound to [v]. *) val remove : key -> t -> t @@ -335,7 +335,7 @@ module Attributes : sig list) -> t -> t - val merge : base:t -> new_attrs:t -> t + val merge : keep_base:bool -> base:t -> new_attrs:t -> t end type 'a attributed = 'a * Attributes.t node diff --git a/vendor/github.com/panglesd/cmarkit/src/cmarkit_html.ml b/vendor/github.com/panglesd/cmarkit/src/cmarkit_html.ml index 79545f65..0b1d5b21 100644 --- a/vendor/github.com/panglesd/cmarkit/src/cmarkit_html.ml +++ b/vendor/github.com/panglesd/cmarkit/src/cmarkit_html.ml @@ -264,7 +264,9 @@ let link_dest_and_title c ld = let image ?(close = " >") c i attrs = match Inline.Link.reference_definition (C.get_defs c) i with | Some (Link_definition.Def ((ld, (attributes, _)), _)) -> - let attributes = Attributes.merge ~base:attributes ~new_attrs:attrs in + let attributes = + Attributes.merge ~keep_base:false ~base:attributes ~new_attrs:attrs + in let plain_text c i = let lines = Inline.to_plain_text ~break_on_soft:false i in String.concat "\n" (List.map (String.concat "") lines) @@ -303,7 +305,9 @@ let link_footnote c l fn = let link c l attrs = match Inline.Link.reference_definition (C.get_defs c) l with | Some (Link_definition.Def ((ld, (attributes, _)), _)) -> - let attributes = Attributes.merge ~base:attributes ~new_attrs:attrs in + let attributes = + Attributes.merge ~keep_base:false ~base:attributes ~new_attrs:attrs + in let link, title = link_dest_and_title c ld in C.string c "