Skip to content
Snippets Groups Projects
Commit fb7a7e5e authored by Virgile Prevosto's avatar Virgile Prevosto
Browse files

[lib] remove backup from old markdown lib

parent fabe9c83
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/libraries/utils/markdown_old.ml deleted 100644 → 0
+ 0
− 333
View file @ fabe9c83
(**************************************************************************)
(* *)
(* This file is part of Frama-C. *)
(* *)
(* Copyright (C) 2007-2019 *)
(* CEA (Commissariat à l'énergie atomique et aux énergies *)
(* alternatives) *)
(* *)
(* you can redistribute it and/or modify it under the terms of the GNU *)
(* Lesser General Public License as published by the Free Software *)
(* Foundation, version 2.1. *)
(* *)
(* It is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Lesser General Public License for more details. *)
(* *)
(* See the GNU Lesser General Public License version 2.1 *)
(* for more details (enclosed in the file licenses/LGPLv2.1). *)
(* *)
(**************************************************************************)
(* -------------------------------------------------------------------------- *)
(* --- Markdown Documentation Generation Utility --- *)
(* -------------------------------------------------------------------------- *)
type md = Format.formatter -> unit
type text = md
type block = md
type section = md
let pretty fmt w = w fmt
let pp_text = pretty
let pp_block = pretty
let pp_section = pretty
(* -------------------------------------------------------------------------- *)
(* --- Context --- *)
(* -------------------------------------------------------------------------- *)
type toc = level:int -> name:string -> title:string -> unit
type context = {
page: string ;
path: string list ;
names: bool ;
level: int ;
toc: toc option ;
}
let context = ref {
page = "" ;
path = [] ;
names = false ;
level = 0 ;
toc = None ;
}
let local ctxt job data =
let current = !context in
try context := ctxt ; job data ; context := current
with err -> context := current ; raise err
(* -------------------------------------------------------------------------- *)
(* --- Combinators --- *)
(* -------------------------------------------------------------------------- *)
let nil _fmt = ()
let empty= nil
let space fmt = Format.pp_print_space fmt ()
let newline fmt = Format.pp_print_newline fmt ()
let merge sep ds fmt =
match List.filter (fun d -> d != nil) ds with
| [] -> ()
| d::ds -> d fmt ; List.iter (fun d -> sep fmt ; d fmt) ds
let glue ?sep ds fmt =
match sep with
| None -> List.iter (fun d -> d fmt) ds
| Some s -> merge s ds fmt
let (<@>) a b =
if a == empty then b else
if b == empty then a else
fun fmt -> a fmt ; b fmt
let (<+>) a b =
if a == empty then b else
if b == empty then a else
fun fmt -> a fmt ; space fmt ; b fmt
let (</>) a b =
if a == empty then b else
if b == empty then a else
fun fmt -> a fmt ; newline fmt ; b fmt
let fmt_text k fmt = Format.fprintf fmt "@[<h 0>%t@]" k
let fmt_block k fmt = Format.fprintf fmt "@[<v 0>%t@]@\n" k
(* -------------------------------------------------------------------------- *)
(* --- Elementary Text --- *)
(* -------------------------------------------------------------------------- *)
let raw s fmt = Format.pp_print_string fmt s
let rm s fmt = Format.pp_print_string fmt s
let it s fmt = Format.fprintf fmt "_%s_" s
let bf s fmt = Format.fprintf fmt "**%s**" s
let tt s fmt = Format.fprintf fmt "`%s`" s
let text = merge space
let praw s = fmt_block (raw s)
(* -------------------------------------------------------------------------- *)
(* --- Links --- *)
(* -------------------------------------------------------------------------- *)
type href = [
| `URL of string
| `Page of string
| `Name of string
| `Section of string * string
]
let filepath m = String.split_on_char '/' m
let rec relative source target =
match source , target with
| p::ps , q::qs when p = q -> relative ps qs
| [] , _ -> target
| _::d , _ -> List.map (fun _ -> "..") d @ target
let lnk target =
String.concat "/" (relative !context.path (filepath target))
let id m =
let buffer = Buffer.create (String.length m) in
let lowercase = Char.lowercase_ascii in
let dash = ref false in
let emit c =
if !dash then (Buffer.add_char buffer '-' ; dash := false) ;
Buffer.add_char buffer c in
String.iter
(function
| '0'..'9' as c -> emit c
| 'a'..'z' as c -> emit c
| 'A'..'Z' as c -> emit (lowercase c)
| '.' | '_' as c -> emit c
| ' ' | '\t' | '\n' | '-' -> dash := (Buffer.length buffer > 0)
| _ -> ()) m ;
Buffer.contents buffer
let href ?title (h : href) fmt =
match title , h with
| None , `URL url -> Format.fprintf fmt "%s" url
| Some w , `URL url -> Format.fprintf fmt "[%s](%s)" w url
| None , `Page p -> Format.fprintf fmt "[%s](%s)" p (lnk p)
| Some w , `Page p -> Format.fprintf fmt "[%s](%s)" w (lnk p)
| None , `Section(p,s) -> Format.fprintf fmt "[%s](%s#%s)" s (lnk p) (id s)
| Some w , `Section(p,s) -> Format.fprintf fmt "[%s](%s#%s)" w (lnk p) (id s)
| None , `Name a -> Format.fprintf fmt "[%s](#%s)" a (id a)
| Some w , `Name a -> Format.fprintf fmt "[%s](#%s)" w (id a)
(* -------------------------------------------------------------------------- *)
(* --- Blocks --- *)
(* -------------------------------------------------------------------------- *)
let aname anchor fmt =
Format.fprintf fmt "<a name=\"%s\"></a>@\n" (id anchor)
let title h ?name title fmt =
begin
let { level ; names ; toc } = !context in
let level = max 0 (min 5 (level + h - 1)) in
Format.fprintf fmt "%s %s" (String.make level '#') title ;
if names || name <> None || toc <> None then
begin
let anchor = match name with None -> title | Some a -> a in
Format.fprintf fmt " {#%s}" (id anchor) ;
(match toc with
| None -> ()
| Some callback ->
callback ~level ~name:anchor ~title) ;
end ;
Format.pp_print_newline fmt () ;
end
let h1 = title 1
let h2 = title 2
let h3 = title 3
let h4 = title 4
let indent h w fmt = local { !context with level = !context.level + h } w fmt
let in_h1 = indent 1
let in_h2 = indent 2
let in_h3 = indent 3
let in_h4 = indent 4
let hrule fmt = Format.pp_print_string fmt "-------------------------@."
let par w fmt = Format.fprintf fmt "@[<hov 0>%t@]@." w
let list ws fmt =
List.iter
(fun w -> Format.fprintf fmt "@[<hov 2>- %t@]@." w) ws
let enum ws fmt =
let k = ref 0 in
List.iter
(fun w -> incr k ; Format.fprintf fmt "@[<hov 3>%d. %t@]@." !k w) ws
let description items fmt =
List.iter
(fun (a,w) -> Format.fprintf fmt "@[<hov 2>- **%s** %t@]@." a w) items
let code ?(lang="") pp fmt =
begin
Format.fprintf fmt "@[<v 0>```%s" lang ;
let buffer = Buffer.create 80 in
let bfmt = Format.formatter_of_buffer buffer in
pp bfmt ; Format.pp_print_flush bfmt () ;
let content = Buffer.contents buffer in
let lines = String.split_on_char '\n' content in
let rec clean = function [] -> [] | ""::w -> clean w | w -> w in
List.iter
(fun l -> Format.fprintf fmt "@\n%s" l)
(List.rev (clean (List.rev (clean lines)))) ;
Format.fprintf fmt "@\n```@]@."
end
type column = [
| `Left of string
| `Right of string
| `Center of string
]
let table columns rows fmt =
begin
Format.fprintf fmt "@[<v 0>" ;
List.iter
(function `Left h | `Right h | `Center h -> Format.fprintf fmt "| %s " h)
columns ;
Format.fprintf fmt "|@\n" ;
List.iter (fun column ->
let dash h k = String.make (max 3 (String.length h + k)) '-' in
match column with
| `Left h -> Format.fprintf fmt "|:%s" (dash h 1)
| `Right h -> Format.fprintf fmt "|%s:" (dash h 1)
| `Center h -> Format.fprintf fmt "|:%s:" (dash h 0)
) columns ;
Format.fprintf fmt "|@\n" ;
List.iter (fun row ->
List.iter (fun col -> Format.fprintf fmt "| @[<h 0>%t@] " col) row ;
Format.fprintf fmt "|@\n" ;
) rows ;
Format.fprintf fmt "@]@." ;
end
let concat ps = merge newline (List.filter (fun p -> p != empty) ps)
(* -------------------------------------------------------------------------- *)
(* --- Refs --- *)
(* -------------------------------------------------------------------------- *)
let mk f fmt = (f ()) fmt
let mk_text = mk
let mk_block = mk
(* -------------------------------------------------------------------------- *)
(* --- Sections --- *)
(* -------------------------------------------------------------------------- *)
let document s = s
let subsections section subsections = section </> in_h1 (merge newline subsections)
let section ?name ~title content subsections =
h1 ?name title </> content </> in_h1 (merge newline subsections)
(* -------------------------------------------------------------------------- *)
(* --- Include File --- *)
(* -------------------------------------------------------------------------- *)
let from_file path fmt =
let inc = open_in path in
try
while true do
let line = input_line inc in
Format.pp_print_string fmt line ;
Format.pp_print_newline fmt () ;
done
with
| End_of_file -> close_in inc
| exn -> close_in inc ; raise exn
let read_block = from_file
let read_section = from_file
let read_text path fmt = Format.fprintf fmt "@[<h 0>%t@]" (from_file path)
(* -------------------------------------------------------------------------- *)
(* --- Dump to File --- *)
(* -------------------------------------------------------------------------- *)
let rec mkdir root page =
let dir = Filename.dirname page in
if dir <> "." && dir <> ".." then
let path = Printf.sprintf "%s/%s" root dir in
if not (Sys.file_exists path) then
begin
mkdir root dir ;
try Unix.mkdir path 0o755
with Unix.Unix_error _ ->
failwith (Printf.sprintf "Can not create direcoty '%s'" dir)
end
let dump ~root ~page ?(names=false) ?toc doc =
local
{ page ; path = filepath page ; level = 1 ; toc ; names = names }
begin fun () ->
mkdir root page ;
let out = open_out (Printf.sprintf "%s/%s" root page) in
let fmt = Format.formatter_of_out_channel out in
try
doc fmt ;
Format.pp_print_newline fmt () ;
close_out out ;
with err ->
Format.pp_print_newline fmt () ;
close_out out ;
raise err
end ()
(* -------------------------------------------------------------------------- *)
src/libraries/utils/markdown_old.mli deleted 100644 → 0
+ 0
− 183
View file @ fabe9c83
(**************************************************************************)
(* *)
(* This file is part of Frama-C. *)
(* *)
(* Copyright (C) 2007-2019 *)
(* CEA (Commissariat à l'énergie atomique et aux énergies *)
(* alternatives) *)
(* *)
(* you can redistribute it and/or modify it under the terms of the GNU *)
(* Lesser General Public License as published by the Free Software *)
(* Foundation, version 2.1. *)
(* *)
(* It is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Lesser General Public License for more details. *)
(* *)
(* See the GNU Lesser General Public License version 2.1 *)
(* for more details (enclosed in the file licenses/LGPLv2.1). *)
(* *)
(**************************************************************************)
(* -------------------------------------------------------------------------- *)
(* --- Markdown Documentation Generation Utility --- *)
(* -------------------------------------------------------------------------- *)
(** {2 Markdown}
A lightweight helper for generating Markdown documentation.
Two levels of formatters are defined to help managing indentation and
spaces: [text] for inline markdown, and [block] for markdown paragraphs.
*)
type text
type block
type section
val (<@>) : text -> text -> text (** Infix operator for [glue] *)
val (<+>) : text -> text -> text (** Infix operator for [text] *)
val (</>) : block -> block -> block (** Infix operator for [concat] *)
(** {2 Text Constructors} *)
val nil : text (** Empty *)
val raw : string -> text (** inlined markdown format *)
val rm : string -> text (** roman (normal) style *)
val it : string -> text (** italic style *)
val bf : string -> text (** bold style *)
val tt : string -> text (** typewriter style *)
val glue : ?sep:text -> text list -> text (** Glue text fragments *)
val text : text list -> text (** Glue text fragments with spaces *)
(** {2 Block Constructors} *)
val empty : block (** Empty *)
val hrule : block (** Horizontal rule *)
val h1 : ?name:string -> string -> block (** Title level 1 *)
val h2 : ?name:string -> string -> block (** Title level 2 *)
val h3 : ?name:string -> string -> block (** Title level 3 *)
val h4 : ?name:string -> string -> block (** Title level 4 *)
val in_h1 : block -> block (** Increment title levels by 1 *)
val in_h2 : block -> block (** Increment title levels by 2 *)
val in_h3 : block -> block (** Increment title levels by 3 *)
val in_h4 : block -> block (** Increment title levels by 4 *)
val par : text -> block (** Simple text paragraph *)
val praw : string -> block (** Simple raw paragraph *)
val list : text list -> block (** Itemized list *)
val enum : text list -> block (** Enumerated list *)
val description : (string * text) list -> block (** Description list *)
(** Formatted code.
The code content is pretty-printed in a vertical [<v0>] box
with default [Format] formatter.
Leading and trailing empty lines are removed and indentation is
preserved. *)
val code : ?lang:string -> (Format.formatter -> unit) -> block
val concat : block list -> block (** Glue paragraphs with empty lines *)
(** {2 Hyperlinks}
[`Page], [`Name] and [`Section] links refers to the current document,
see [dump] function below.
In [`Section(p,t)], [p] is the page path relative to the
document {i root}, and [t] is the section title {i or} name.
For [`Name a], the links refers to name or title [a]
in the {i current} page.
Hence, everywhere throughout a self-content document directory [~root],
local page [~page] inside [~root] can be referenced
by [`Page page], and its sections can by [`Section(page,title)]
or [`Section(page,name)].
*)
type href = [
| `URL of string
| `Page of string
| `Name of string
| `Section of string * string
]
(** Default [~title] is taken from [href]. When printed,
actual link will be relativized with respect to current page. *)
val href : ?title:string -> href -> text
(** Define a local anchor *)
val aname : string -> block
(** {2 Tables} *)
type column = [
| `Left of string
| `Right of string
| `Center of string
]
val table : column list -> text list list -> block
(** {2 Markdown Generator}
Generating function are called each time the markdown
fragment is printed. *)
val mk_text : (unit -> text) -> text
val mk_block : (unit -> block) -> block
(** {2 Sections}
Sections are an alternative to [h1-h4] constructors to build
properly nested sub-sections. Deep sections at depth 5 and more are
flattened.
*)
val section : ?name:string -> title:string -> block -> section list -> section
val subsections : section -> section list -> section
val document : section -> block
(** {2 Dump to file}
Generate the markdown [~page] in directory [~root] with the given content.
The [~root] directory shall be absolute or relative to the current working
directory. The [~page] file-path shall be relative to the [~root] directory
and will be used to relocate hyperlinks to other [`Page] and [`Section]
properly.
Hence, everywhere throughout the document, [dump ~root ~page doc]
is referenced by [`Page page], and its sections are referenced by
[`Section(page,title)].
*)
(** Callback to listen for actual sections when printing a page. *)
type toc = level:int -> name:string -> title:string -> unit
(** Create a markdown page.
- [~root] document directory (relocatable)
- [~page] relative file-path of the page in [~root] (non relocatable)
- [~names] generate explicit [<a name=...>] tags for all titles
- [~toc] optional callback to register table of contents
*)
val dump : root:string -> page:string -> ?names:bool -> ?toc:toc -> block -> unit
(** {2 Miscellaneous} *)
val read_text : string -> text
val read_block : string -> block
val read_section : string -> section
val fmt_text : (Format.formatter -> unit) -> text
val fmt_block : (Format.formatter -> unit) -> block
val pp_text : Format.formatter -> text -> unit
val pp_block : Format.formatter -> block -> unit
val pp_section : Format.formatter -> section -> unit
(* -------------------------------------------------------------------------- *)
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment