Merge branch 'fix/server/requests-in-index' into 'master'

[Server] Make all server requests appear in the doc index.

Closes #770

See merge request frama-c/frama-c!2483

doc/pandoc/style.css

@@ -61,7 +61,7 @@ body {
     max-width: 8cm ;
     height: 100% ;
     padding: 0cm 0.5cm 0cm 0.5cm ;
-    background: #888 ;
+    background: #eee ;
 }
 
 #CONTENT {
@@ -85,6 +85,10 @@ body {
     font-size: smaller ;
 }
 
+#NAVIGATION a {
+    color: black ;
+}
+
 #NAVIGATION a.root {
     display: block;
     font-family: "Optima", "Verdana", "Arial", sans;
@@ -104,14 +108,6 @@ body {
     background-color: darkorange ;
 }
 
-#NAVIGATION a {
-    color: white ;
-}
-
-#NAVIGATION code {
-    color: black ;
-}
-
 #NAVIGATION ul {
     width: 6cm ;
 }
@@ -120,7 +116,6 @@ body {
     margin-left: 0px ;
     padding-top: 2px ;
     padding-bottom: 2px ;
-    background-color: darkgrey ;
 }
 
 /* -------------------------------------------------------------------------- */
@@ -143,13 +138,11 @@ h2 {
     margin-top: 5mm;
     margin-bottom: 2mm;
     border-bottom: solid thin darkred ;
-    color: darkred;
 }
 
 h3 {
     width: 17cm;
     font-family: "Optima", "Verdana", "Arial", sans;
-    color: black;
     margin-top: 5mm;
     margin-bottom: 3mm;
     border-bottom: thin solid #404040;
@@ -163,7 +156,6 @@ h4,h5,h6 {
     font-size: 10pt;
     font-style: italic;
     font-weight: bold;
-    color: darkred;
 }
 
 p { margin: 6px 0px 6px 0px; width: 15cm; }
@@ -178,6 +170,8 @@ li {
     padding-right : 6px ;
 }
 
+li p { margin: 0px }
+
 pre {
     width : 15cm ;
     background-color: #eef ;

src/plugins/server/doc.ml

@@ -120,10 +120,42 @@ let table_of_contents () =
        (fun p -> table_of_chapter (`Plugin p))
        (List.sort String.compare !plugins))
 
+module Cmap = Map.Make
+    (struct
+      type t = string list
+      let compare = Pervasives.compare
+    end)
+
+let index_entry (title,href) =
+  text @@ Markdown.href ~text:(plain title) href
+
 let index () =
-  List.map
-    (fun (title,entry) -> Markdown.href ~text:(plain title) entry)
-    (List.sort (fun (a,_) (b,_) -> String.compare a b) !entries)
+  let category name =
+    match List.rev (String.split_on_char '.' name) with
+    | [] -> []
+    | _::rpath -> List.rev rpath in
+  let cmap =
+    List.fold_left
+      (fun cs entry ->
+         let c = category (fst entry) in
+         let es = try Cmap.find c cs with Not_found -> [] in
+         Cmap.add c (entry :: es) cs)
+      Cmap.empty !entries in
+  let by_name (a,_) (b,_) = String.compare a b in
+  let categories = Cmap.fold
+      (fun c es ces -> ( c , List.sort by_name es ) :: ces)
+      cmap [] in
+  begin
+    List.fold_left
+      (fun elements (c,es) ->
+         let entries = Block (list @@ List.map index_entry es) :: elements in
+         if c = [] then entries
+         else
+           let cname = String.concat "." c in
+           let title = Printf.sprintf "Index of `%s`" cname in
+           H3(plain title,None) :: entries
+      ) [] categories
+  end
 
 let link ~toc ~title ~href : json =
   let link = [ "title" , `String title ; "href" , `String href ] in
@@ -193,8 +225,9 @@ let dump ~root ?(meta=true) () =
         @
         table_of_contents ()
         @
-        [H2 (plain "Index", None);
-         Block (list (List.map text (index ())))]
+        [H2 (plain "Index", None)]
+        @
+        index ()
       in
       let title = "Documentation" in
       pp_one_page ~root ~page:"readme.md" ~title body

src/plugins/server/request.ml

@@ -296,6 +296,7 @@ let register_sig (type a b) (s : (a,b) signature) (process : rq -> a -> b) =
   in
   let skind = Main.string_of_kind s.kind in
   let title =  Printf.sprintf "`%s` %s" skind s.name in
+  let index = [ Printf.sprintf "%s (`%s`)" s.name skind ] in
   let header = [ plain "Input", Center; plain "Output", Center] in
   let content =
     [[ Syntax.text @@ sy_input s.input ;
@@ -307,7 +308,9 @@ let register_sig (type a b) (s : (a,b) signature) (process : rq -> a -> b) =
     doc_input s.input @
     doc_output s.output
   in
-  let _ = Doc.publish ~page:s.page ~name:s.name ~title description [] in
+  let _ =
+    Doc.publish ~page:s.page ~name:s.name ~title ~index description []
+  in
   Main.register s.kind s.name processor ;
   s.defined <- true
 

src/plugins/server/syntax.ml

@@ -65,12 +65,13 @@ let publish ~page ~name ~descr ~synopsis ?(details = []) () =
   check_page page name ;
   let id = Printf.sprintf "data-%s" name in
   let title = Printf.sprintf "`DATA` %s" name in
+  let index = [ Printf.sprintf "%s (`DATA`)" name ] in
   let dref = Doc.href page id in
   let dlink = Markdown.href ~text:(Markdown.emph name) dref in
   let syntax = Markdown.(glue [
       plain "<" ; dlink ; plain ">" ; plain ":=" ; synopsis.text ]) in
   let content = Markdown.(Block ( text descr @ text syntax ) :: details) in
-  let _href = Doc.publish ~page ~name:id ~title ~index:[name] content [] in
+  let _href = Doc.publish ~page ~name:id ~title ~index content [] in
   atom dlink
 
 let unit = atom @@ Markdown.plain "-"