forked from facebookarchive/pfff
/
org_mode.ml
88 lines (77 loc) · 2.58 KB
/
org_mode.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
(* Yoann Padioleau
*
* Copyright (C) 2010 Facebook
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License (GPL)
* version 2 as published by the Free Software Foundation.
*
* This program 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
* file license.txt for more details.
*)
open Common
module HC = Highlight_code
(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(*****************************************************************************)
(* Types *)
(*****************************************************************************)
type org_line =
| Header of int * string (* full string, including starting stars *)
(* todo? could also highlight the http refs and other markup ? *)
| Comment of string
| Other of string
type org = org_line list
(*****************************************************************************)
(* Parsing *)
(*****************************************************************************)
let parse file =
let xs = Common.cat file in
xs +> List.map (fun s ->
let s = s ^ "\n" in
match () with
| _ when s =~ "^\\([*]+\\)" ->
let header = Common.matched1 s in
Header (String.length header, s)
| _ when s =~ "^#.*" ->
Comment s
| _ ->
Other s
)
(*****************************************************************************)
(* Highlighting *)
(*****************************************************************************)
let highlight org =
org +> Common.index_list_1 +> List.map (fun (org, line) ->
let filepos = { l = line; c = 0; } in
match org with
| Comment s ->
s, Some (HC.Comment), filepos
| Other s ->
let categ =
(match s with
| _ when s =~ "http://" ->
HC.EmbededUrl
| _ when s =~ "https://" ->
HC.EmbededStyle
| _ -> HC.Normal
)
in
s, Some categ , filepos
| Header (int, s) ->
let categ =
(match int with
| 0 -> raise Impossible
| 1 -> Some HC.CommentSection0
| 2 -> Some HC.CommentSection1
| 3 -> Some HC.CommentSection2
| 4 -> Some HC.CommentSection3
| 5 -> Some HC.CommentSection4
| _ -> None
)
in
s, categ, filepos
)