Promote tests and fix regression

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
 

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

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

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 "<span";
           RenderAttrs.add_attrs c attrs;
@@ -404,7 +406,7 @@ let custom_html_renderer (units : Ast.units)
           true
       | Ast.SlipScript ((cb, (attrs, _)), _) ->
           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

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))

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 ->

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

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 ->

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

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

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 @@
       <p><span>A</span>
       </p>
     </div>
-    <div class="other custom-class">
+    <div class="custom-class other">
       <p>
         <span>
           B</span>

test/compiler/slides.t/run.t

@@ -15,7 +15,7 @@ We can compile the file using the slip_of_mark binary
   <div class="slip-body">
   <div src=slides.md include>
   <div style="display: flex">
-  <div id="slide1" class="slipshow-rescaler" slide enter-at-unpause>
+  <div id="slide1" class="slipshow-rescaler" enter-at-unpause slide>
   <div class="slide">
   <div class="slide-title">
   <span>First title</span></div>