Initial comit - Clone

plugins/gwxjg/META

@@ -0,0 +1 @@
+depends:jingoo

plugins/gwxjg/README.MD

@@ -0,0 +1,281 @@
+# gwxjg
+
+`gwxjg` means GeneWeb x Jingoo. This package translate data from Geneweb
+structure to Jingoo's type system. Below, see a quick reference of which
+structures and which fields are accessible from a Jingoo template.
+
+If you (approximately) know how to read OCaml code, the best is to read
+[Data module](data.ml), where everything is defined.
+
+Alternatively, here is a simplified view of what you get when using `gwxjg`
+
+## boolean
+
+Either `true` or `false`.
+
+## burial
+
+- `type`: [burial type]
+- `date`: [date]
+
+## burial type
+
+A [burial type] is `"Buried"` or `"Cremated"`
+
+## calendar
+
+A [calendar] is one of these [string]:
+- `"Dgregorian"`
+- `"Djulian"`
+- `"Dfrench"`
+- `"Dhebrew"`
+
+## date
+
+- `calendar`: [calendar]
+- `d2`: [date]
+- `day`: [int]
+- `month`: [int]
+- `prec`: [prec]
+- `year`: [int]
+
+## death
+
+- `date` : [date]
+- `death_reason`: [death reason]
+
+## death reason
+
+A [death reason] is one of these [string]:
+- `"Killed"`
+- `"Murdered"`
+- `"Executed"`
+- `"Disappeared"`
+- `"Unspecified"`
+- `"DeadYoung"`
+- `"DeadDontKnowWhen"`
+- `"DontKnowIfDead"`
+- `"OfCourseDead"`
+
+## event
+
+- `date`: [date]
+- `kind`: [event kind]
+- `name`: [string]
+- `note`: [string]
+- `place`: [place]
+- `spouse`: [person]
+- `src`: [string]
+- `witnesses`: [witness] [list]
+
+## event kind
+
+A [event kind] is either *free text* or one of these [string]:
+- `"EPERS_BIRTH"`
+- `"EPERS_BAPTISM"`
+- `"EPERS_DEATH"`
+- `"EPERS_BURIAL"`
+- `"EPERS_CREMATION"`
+- `"EPERS_ACCOMPLISHMENT"`
+- `"EPERS_ACQUISITION"`
+- `"EPERS_ADHESION"`
+- `"EPERS_BAPTISMLDS"`
+- `"EPERS_BARMITZVAH"`
+- `"EPERS_BATMITZVAH"`
+- `"EPERS_BENEDICTION"`
+- `"EPERS_CHANGENAME"`
+- `"EPERS_CIRCUMCISION"`
+- `"EPERS_CONFIRMATION"`
+- `"EPERS_CONFIRMATIONLDS"`
+- `"EPERS_DECORATION"`
+- `"EPERS_DEMOBILISATIONMILITAIRE"`
+- `"EPERS_DIPLOMA"`
+- `"EPERS_DISTINCTION"`
+- `"EPERS_DOTATION"`
+- `"EPERS_DOTATIONLDS"`
+- `"EPERS_EDUCATION"`
+- `"EPERS_ELECTION"`
+- `"EPERS_EMIGRATION"`
+- `"EPERS_EXCOMMUNICATION"`
+- `"EPERS_FAMILYLINKLDS"`
+- `"EPERS_FIRSTCOMMUNION"`
+- `"EPERS_FUNERAL"`
+- `"EPERS_GRADUATE"`
+- `"EPERS_HOSPITALISATION"`
+- `"EPERS_ILLNESS"`
+- `"EPERS_IMMIGRATION"`
+- `"EPERS_LISTEPASSENGER"`
+- `"EPERS_MILITARYDISTINCTION"`
+- `"EPERS_MILITARYPROMOTION"`
+- `"EPERS_MILITARYSERVICE"`
+- `"EPERS_MOBILISATIONMILITAIRE"`
+- `"EPERS_NATURALISATION"`
+- `"EPERS_OCCUPATION"`
+- `"EPERS_ORDINATION"`
+- `"EPERS_PROPERTY"`
+- `"EPERS_RECENSEMENT"`
+- `"EPERS_RESIDENCE"`
+- `"EPERS_RETIRED"`
+- `"EPERS_SCELLENTCHILDLDS"`
+- `"EPERS_SCELLENTPARENTLDS"`
+- `"EPERS_SCELLENTSPOUSELDS"`
+- `"EPERS_VENTEBIEN"`
+- `"EPERS_WILL"`
+- `"EFAM_MARRIAGE"`
+- `"EFAM_NO_MARRIAGE"`
+- `"EFAM_NO_MENTION"`
+- `"EFAM_ENGAGE"`
+- `"EFAM_DIVORCE"`
+- `"EFAM_SEPARATED"`
+- `"EFAM_ANNULATION"`
+- `"EFAM_MARRIAGE_BANN"`
+- `"EFAM_MARRIAGE_CONTRACT"`
+- `"EFAM_MARRIAGE_LICENSE"`
+- `"EFAM_PACS"`
+- `"EFAM_RESIDENCE"`
+
+## family
+
+- `divorce_date`: [date]
+- `children`: [person] [list]
+- `father`: [person]
+- `events`: [event] [list]
+- `ifam`: [string]
+- `marriage_date`: [date]
+- `marriage_place`: [place]
+- `marriage_note`: [string]
+- `marriage_source`: [string]
+- `mother`: [person]
+- `origin_file`: [string]
+- `relation`: [relation]
+- `separation`: [separation]
+- `spouse`: [person]
+- `witnesses`: [persons] [list]
+
+## float
+
+A floating point number.
+
+## int
+
+An integer.
+
+## list
+
+A sequence of zero or more items.
+
+## person
+
+- `access`: [string]
+- `baptism_date`: [date]
+- `baptism_place`: [place]
+- `birth_date`: [date]
+- `birth_place`: [place]
+- `burial`: [burial]
+- `burial_place`: [string]
+- `children`: [person] [list]
+- `cremation_place`: [place]
+- `consanguinity`: [float]
+- `dates`: [string]
+- `death`: [death]
+- `death_place`: [place]
+- `digest`: [string]
+- `events`: [event] [list]
+- `families`: [family] [list]
+- `father`: [person]
+- `first_name`: [string]
+- `first_name_aliases`: [string] [list]
+- `first_name_key`: [string]
+- `first_name_key_val`: [string]
+- `half_siblings`: [person] [list]
+- `iper`: [string]
+- `is_birthday`: [boolean]
+- `is_visible_for_visitors`: [boolean]
+- `linked_page`: [string]
+- `mother`: [person]
+- `occ`: [int]
+- `occupation`: [string]
+- `parents`: [family]
+- `public_name`: [string]
+- `qualifier`: [string]
+- `qualifiers`: [string] [list]
+- `relations`: [person] [list]
+- `related`: [related] list
+- `sex`: [int]
+- `siblings`: [person] [list]
+- `sosa`: [string]
+- `sources`: [string]
+- `spouses`: [person] [list]
+- `surname`: [string]
+- `surname_aliases`: [string] [list]
+- `surname_key`: [string]
+- `surname_key_val`: [string]
+- `titles`: [title] [list]
+
+## place
+
+For now, [place] is an alias for [string],
+but it will eventually become a real data structure.
+
+## prec
+
+A [prec] is one of these [string]:
+- `"sure"`
+- `"about"`
+- `"maybe"`
+- `"before"`
+- `"after"`
+- `"oryear"`
+- `"yearint"`
+
+## related
+
+A related is a [person] with these extra fields:
+- `sources`: [string]
+- `kind`: [related kind]
+
+## related kind
+
+A [related kind] is one of these [string]:
+- `"ADOPTION"`
+- `"RECOGNITION"`
+- `"CANDIDATEPARENT"`
+- `"GODPARENT"`
+- `"FOSTERPARENT"`
+
+## string
+
+This is just text.
+
+## title
+
+- `ident`: [string]
+- `name`: [string]
+- `place`: [place]
+- `date_start`: [date]
+- `date_end`: [date]
+- `nth`: [int]
+
+
+## witness
+
+[boolean]: #boolean
+[burial]: #burial
+[burial type]: #burial-type
+[calendar]: #calendar
+[date]: #date
+[death]: #death
+[death reason]: #death
+[event]: #event
+[family]: #family
+[float]: #float
+[int]: #int
+[list]: #list
+[person]: #person
+[place]: #place
+[prec]: #prec
+[related]: #related
+[related kind]: #related-kind
+[string]: #string
+[title]: #title
+[witness]: #witness

plugins/gwxjg/dune

@@ -0,0 +1,24 @@
+(alias
+ (name plugin)
+ (deps
+  (file META)
+  plugin_gwxjg.cmxs))
+
+(ocamllex gwxjg_lexicon_parser)
+
+(library
+ (name plugin_gwxjg_lib)
+ (public_name geneweb.plugin_gwxjg_lib)
+ (libraries unix geneweb jingoo)
+ (flags
+  (:standard -w -42-40))
+ (modules gwxjg_ezgw gwxjg_data gwxjg_trans gwxjg_lexicon_parser))
+
+(executable
+ (name plugin_gwxjg)
+ (libraries geneweb.gwd_lib plugin_gwxjg_lib)
+ (embed_in_plugin_libraries plugin_gwxjg_lib)
+ (flags -linkall)
+ (modes
+  (native plugin))
+ (modules plugin_gwxjg))

plugins/gwxjg/gwxjg_ezgw.ml

@@ -0,0 +1,291 @@
+(* /!\ This is mostly copy/paste of the Perso module /!\ *)
+(* Sync with perso from ed7525bac *)
+open Geneweb
+open Config
+open Def
+open Gwdb
+open Util
+
+type fam = ifam * family * (iper * iper * iper) * bool
+type rel = relation * person option
+
+type env = {
+  all_gp : Perso.generation_person list option;
+  baseprefix : string option;
+  desc_level_table : (int array * int array) Lazy.t option;
+  desc_mark : bool array ref option;
+  f_link : bool option;
+  fam : fam option;
+  fam_link : fam option;
+  p_link : bool option;
+  prev_fam : fam option;
+  sosa : (iper * (Sosa.t * person) option) list ref option;
+  sosa_ref : person option Lazy.t option;
+  src : string option;
+}
+
+let conf_w_baseprefix conf env =
+  match env.baseprefix with
+  | Some baseprefix -> { conf with command = baseprefix }
+  | None -> conf
+
+let empty =
+  {
+    all_gp = None;
+    baseprefix = None;
+    desc_level_table = None;
+    desc_mark = None;
+    fam = None;
+    f_link = None;
+    fam_link = None;
+    p_link = None;
+    prev_fam = None;
+    sosa = None;
+    sosa_ref = None;
+    src = None;
+  }
+
+let env = empty
+let get_env x = match x with Some x -> x | None -> raise Not_found
+
+let sex_of_index = function
+  | 0 -> Male
+  | 1 -> Female
+  | 2 -> Neuter
+  | _ -> raise (Invalid_argument "sex_of_index")
+
+module Person = struct
+  let children base p = Gwdb.children_of_p base p
+
+  let consanguinity p =
+    let c = get_consang p in
+    if c != Adef.fix (-1) && c >= Adef.fix_of_float 0.0001 then
+      Adef.float_of_fix c
+    else 0.
+
+  let dates conf base p = DateDisplay.short_dates_text conf base p
+  let death p = get_death p
+
+  (* TODOWHY: should it be Event.sorted_events or can it be just Event.events? *)
+  let events = Event.sorted_events
+  let first_name base p = p_first_name base p
+
+  let history_file base p =
+    let fn = sou base (get_first_name p) in
+    let sn = sou base (get_surname p) in
+    let occ = get_occ p in
+    HistoryDiff.history_file fn sn occ
+
+  let is_accessible_by_key conf base p =
+    Util.accessible_by_key conf base p (p_first_name base p) (p_surname base p)
+
+  let linked_page conf base p s =
+    let db = Gwdb.read_nldb base in
+    let db = Notes.merge_possible_aliases conf db in
+    let key =
+      let fn = Name.lower (sou base (get_first_name p)) in
+      let sn = Name.lower (sou base (get_surname p)) in
+      (fn, sn, get_occ p)
+    in
+    List.fold_left (Perso.linked_page_text conf base p s key) (Adef.safe "") db
+
+  let note conf base p = if not conf.no_note then sou base (get_notes p) else ""
+
+  let related conf base p =
+    List.sort (fun (c1, _) (c2, _) ->
+        let mk_date c =
+          match Date.od_of_cdate (get_baptism c) with
+          | None -> Date.od_of_cdate (get_birth c)
+          | x -> x
+        in
+        match (mk_date c1, mk_date c2) with
+        | Some d1, Some d2 -> Date.compare_date d1 d2
+        | _ -> -1)
+    @@ List.fold_left
+         (fun list ic ->
+           let c = pget conf base ic in
+           List.fold_left
+             (fun acc r ->
+               match (r.r_fath, r.r_moth) with
+               | Some ip, _ when ip = get_iper p -> (c, r) :: acc
+               | _, Some ip when ip = get_iper p -> (c, r) :: acc
+               | _ -> acc)
+             list (get_rparents c))
+         []
+         (List.sort_uniq compare (get_related p))
+
+  (* Why isnt this already unique? *)
+  let relations p = List.sort_uniq compare (get_related p)
+
+  let siblings base p =
+    match get_parents p with
+    | Some ifam ->
+        let ip = get_iper p in
+        Array.fold_right
+          (fun i acc -> if i <> ip then i :: acc else acc)
+          (get_children (foi base ifam))
+          []
+    | None -> []
+
+  let half_siblings base p =
+    match get_parents p with
+    | Some ifam ->
+        let ip = get_iper p in
+        let f = foi base ifam in
+        let filter (acc : iper list) i =
+          if i = ifam then acc
+          else
+            Array.fold_right
+              (fun i acc -> if i <> ip then i :: acc else acc)
+              (get_children (foi base i))
+              acc
+        in
+        let hs =
+          let ifath = get_father f in
+          if ifath = dummy_iper then []
+          else Array.fold_left filter [] (get_family @@ poi base ifath)
+        in
+        let imoth = get_mother f in
+        if imoth = dummy_iper then hs
+        else Array.fold_left filter hs (get_family @@ poi base imoth)
+    | None -> []
+
+  let sex p = index_of_sex (get_sex p)
+  let surname base p = p_surname base p
+end
+
+module Family = struct
+  let children (_, fam, _, _) = get_children fam
+
+  let divorce_date (_, fam, _, auth) =
+    match get_divorce fam with
+    | Divorced d when auth -> Date.od_of_cdate d
+    | _ -> None
+
+  let events (_, fam, (_, _, isp), auth) =
+    if auth then
+      List.fold_right
+        (fun evt fam_fevents ->
+          let name = Event.Fevent evt.efam_name in
+          let date = evt.efam_date in
+          let place = evt.efam_place in
+          let note = evt.efam_note in
+          let src = evt.efam_src in
+          let wl = evt.efam_witnesses in
+          let x = (name, date, place, note, src, wl, Some isp) in
+          x :: fam_fevents)
+        (get_fevents fam) []
+    else []
+
+  let father (_, _, (ifath, _, _), _) = ifath
+  let ifam (ifam, _, _, _) = string_of_ifam ifam
+
+  let marriage_date (_, fam, (_, _, _), auth) =
+    if auth then Date.od_of_cdate (get_marriage fam) else None
+
+  let marriage_place (_, fam, _, _) = get_marriage_place fam
+
+  let marriage_note (_, fam, _, auth) =
+    if auth then get_marriage_note fam else Gwdb.empty_string
+
+  let marriage_source (_, fam, _, auth) =
+    if auth then get_marriage_src fam else Gwdb.empty_string
+
+  let mother (_, _, (_, imoth, _), _) = imoth
+
+  let note conf base (_, fam, _, auth) =
+    if auth && not conf.no_note then sou base (get_comment fam) else ""
+
+  let origin_file conf base (_, fam, _, _) =
+    if conf.wizard then sou base (get_origin_file fam) else ""
+
+  let spouse_iper (_, _, (_, _, ip), _) = ip
+  let witnesses (_, fam, _, auth) = if auth then get_witnesses fam else [||]
+
+  let sources base (_, fam, _, auth) =
+    if auth then sou base (get_fsources fam) else ""
+end
+
+module Event = struct
+  let name conf base (n, _, _, _, _, _, _) =
+    match n with
+    | Event.Pevent name -> Util.string_of_pevent_name conf base name
+    | Event.Fevent name -> Util.string_of_fevent_name conf base name
+
+  let kind (n, _, _, _, _, _, _) =
+    match n with
+    | Event.Pevent Epers_Birth -> "EPERS_BIRTH"
+    | Pevent Epers_Baptism -> "EPERS_BAPTISM"
+    | Pevent Epers_Death -> "EPERS_DEATH"
+    | Pevent Epers_Burial -> "EPERS_BURIAL"
+    | Pevent Epers_Cremation -> "EPERS_CREMATION"
+    | Pevent Epers_Accomplishment -> "EPERS_ACCOMPLISHMENT"
+    | Pevent Epers_Acquisition -> "EPERS_ACQUISITION"
+    | Pevent Epers_Adhesion -> "EPERS_ADHESION"
+    | Pevent Epers_BaptismLDS -> "EPERS_BAPTISMLDS"
+    | Pevent Epers_BarMitzvah -> "EPERS_BARMITZVAH"
+    | Pevent Epers_BatMitzvah -> "EPERS_BATMITZVAH"
+    | Pevent Epers_Benediction -> "EPERS_BENEDICTION"
+    | Pevent Epers_ChangeName -> "EPERS_CHANGENAME"
+    | Pevent Epers_Circumcision -> "EPERS_CIRCUMCISION"
+    | Pevent Epers_Confirmation -> "EPERS_CONFIRMATION"
+    | Pevent Epers_ConfirmationLDS -> "EPERS_CONFIRMATIONLDS"
+    | Pevent Epers_Decoration -> "EPERS_DECORATION"
+    | Pevent Epers_DemobilisationMilitaire -> "EPERS_DEMOBILISATIONMILITAIRE"
+    | Pevent Epers_Diploma -> "EPERS_DIPLOMA"
+    | Pevent Epers_Distinction -> "EPERS_DISTINCTION"
+    | Pevent Epers_Dotation -> "EPERS_DOTATION"
+    | Pevent Epers_DotationLDS -> "EPERS_DOTATIONLDS"
+    | Pevent Epers_Education -> "EPERS_EDUCATION"
+    | Pevent Epers_Election -> "EPERS_ELECTION"
+    | Pevent Epers_Emigration -> "EPERS_EMIGRATION"
+    | Pevent Epers_Excommunication -> "EPERS_EXCOMMUNICATION"
+    | Pevent Epers_FamilyLinkLDS -> "EPERS_FAMILYLINKLDS"
+    | Pevent Epers_FirstCommunion -> "EPERS_FIRSTCOMMUNION"
+    | Pevent Epers_Funeral -> "EPERS_FUNERAL"
+    | Pevent Epers_Graduate -> "EPERS_GRADUATE"
+    | Pevent Epers_Hospitalisation -> "EPERS_HOSPITALISATION"
+    | Pevent Epers_Illness -> "EPERS_ILLNESS"
+    | Pevent Epers_Immigration -> "EPERS_IMMIGRATION"
+    | Pevent Epers_ListePassenger -> "EPERS_LISTEPASSENGER"
+    | Pevent Epers_MilitaryDistinction -> "EPERS_MILITARYDISTINCTION"
+    | Pevent Epers_MilitaryPromotion -> "EPERS_MILITARYPROMOTION"
+    | Pevent Epers_MilitaryService -> "EPERS_MILITARYSERVICE"
+    | Pevent Epers_MobilisationMilitaire -> "EPERS_MOBILISATIONMILITAIRE"
+    | Pevent Epers_Naturalisation -> "EPERS_NATURALISATION"
+    | Pevent Epers_Occupation -> "EPERS_OCCUPATION"
+    | Pevent Epers_Ordination -> "EPERS_ORDINATION"
+    | Pevent Epers_Property -> "EPERS_PROPERTY"
+    | Pevent Epers_Recensement -> "EPERS_RECENSEMENT"
+    | Pevent Epers_Residence -> "EPERS_RESIDENCE"
+    | Pevent Epers_Retired -> "EPERS_RETIRED"
+    | Pevent Epers_ScellentChildLDS -> "EPERS_SCELLENTCHILDLDS"
+    | Pevent Epers_ScellentParentLDS -> "EPERS_SCELLENTPARENTLDS"
+    | Pevent Epers_ScellentSpouseLDS -> "EPERS_SCELLENTSPOUSELDS"
+    | Pevent Epers_VenteBien -> "EPERS_VENTEBIEN"
+    | Pevent Epers_Will -> "EPERS_WILL"
+    | Fevent Efam_Marriage -> "EFAM_MARRIAGE"
+    | Fevent Efam_NoMarriage -> "EFAM_NO_MARRIAGE"
+    | Fevent Efam_NoMention -> "EFAM_NO_MENTION"
+    | Fevent Efam_Engage -> "EFAM_ENGAGE"
+    | Fevent Efam_Divorce -> "EFAM_DIVORCE"
+    | Fevent Efam_Separated -> "EFAM_SEPARATED"
+    | Fevent Efam_Annulation -> "EFAM_ANNULATION"
+    | Fevent Efam_MarriageBann -> "EFAM_MARRIAGE_BANN"
+    | Fevent Efam_MarriageContract -> "EFAM_MARRIAGE_CONTRACT"
+    | Fevent Efam_MarriageLicense -> "EFAM_MARRIAGE_LICENSE"
+    | Fevent Efam_PACS -> "EFAM_PACS"
+    | Fevent Efam_Residence -> "EFAM_RESIDENCE"
+    | Pevent (Epers_Name _) -> "EPERS"
+    | Fevent (Efam_Name _) -> "EFAM"
+
+  let date (_, d, _, _, _, _, _) = Date.od_of_cdate d
+  let place base (_, _, p, _, _, _, _) = sou base p
+
+  let note conf base (_, _, _, n, _, _, _) =
+    if conf.no_note then "" else sou base n
+
+  let src base (_, _, _, _, s, _, _) = sou base s
+  let witnesses (_, _, _, _, _, w, _) = w
+  let spouse_opt (_, _, _, _, _, _, isp) = isp
+end

plugins/gwxjg/gwxjg_lexicon_parser.mll

@@ -0,0 +1,143 @@
+{
+
+type i18n_expr =
+  | Arg of string
+  | Str of string
+  | Elision of string * string
+  | Declension of char * string
+
+let flush buffer acc =
+  let acc = match Buffer.contents buffer with
+    | "" -> acc
+    | x -> Str x :: acc in
+  Buffer.clear buffer ;
+  acc
+
+let need_split = function
+  | "!languages"
+  | "(date)"
+  | "(french revolution month)"
+  | "(hebrew month)"
+  | "(month)"
+  | "(week day)"
+  | "a 2nd cousin"
+  | "a 3rd cousin"
+  | "a cousin"
+  | "a descendant"
+  | "alive"
+  | "an ancestor"
+  | "and"
+  | "a %s cousin"
+  | "baptized"
+  | "born"
+  | "buried"
+  | "cremated"
+  | "died"
+  | "died young"
+  | "disappeared"
+  | "engaged%t to"
+  | "executed (legally killed)"
+  | "grand-parents"
+  | "great-grand-parents"
+  | "inversion done"
+  | "killed (in action)"
+  | "married%t to"
+  | "murdered"
+  | "next sibling"
+  | "nth"
+  | "nth (cousin)"
+  | "nth (generation)"
+  | "previous sibling"
+  | "relationship%t to"
+  | "the spouse"
+  | "would be his/her own ancestor"
+  | "died at an advanced age"
+  | "half siblings"
+  | "(short month)"
+    -> true
+  | "is born after his/her child"
+  | "loop in database: %s is his/her own ancestor"
+  | "%t was witness after his/her death"
+  | "%t was witness before his/her birth"
+  | "%t's %s before his/her %s"
+  | "%t witnessed the %s after his/her death"
+  | "%t witnessed the %s before his/her birth"
+    -> false
+  | t -> String.contains t '/'
+
+}
+
+let lower = ['a'-'z']
+let upper = ['A'-'Z']
+let num = ['0'-'9']
+
+let id = (lower | ['_']) (lower | upper | num | ['_'])*
+
+let line = [^ '\n' ]+
+let eol = '\n'
+
+rule p_main acc = parse
+  | ' '+ (line as t) eol
+      { p_main ((t, p_lang (need_split t) [] lexbuf) :: acc) lexbuf }
+  | _
+      { p_main acc lexbuf }
+  | eof { acc }
+
+and p_lang split acc = parse
+  | ((lower | '-' )+ as lang) ':' ' '? (line as trad) eol {
+      let trad =
+        if split then Array.of_list @@ String.split_on_char '/' trad
+        else [| trad |]
+      in
+      let trad =
+        Array.map (fun t -> p_trad (Buffer.create 42) [] @@ Lexing.from_string t) trad
+      in
+      p_lang split ((lang, trad) :: acc) lexbuf
+    }
+  | "" { acc }
+
+and p_trad buffer acc = parse
+  | '%' (num as n) {
+      let acc = flush buffer acc in
+      p_trad buffer (Arg ("_" ^ String.make 1 n) :: acc) lexbuf
+    }
+  | '%' (lower as n) {
+      let acc = flush buffer acc in
+      p_trad buffer (Arg (String.make 1 n) :: acc) lexbuf
+    }
+  | ':' (lower as c) ':' '%' (num as n) {
+      let acc = flush buffer acc in
+      p_trad buffer (Declension (c, "_" ^ String.make 1 n) :: acc) lexbuf
+    }
+  | ':' (lower as c) ':' '%' (lower as n) {
+      let acc = flush buffer acc in
+      p_trad buffer (Declension (c, String.make 1 n) :: acc) lexbuf
+    }
+  | '[' ([^'|']* as s1) '|' ([^']']* as s2) ']' {
+      let acc = flush buffer acc in
+      p_trad buffer (Elision (s1, s2) :: acc) lexbuf
+    }
+  | _ as c {
+      Buffer.add_char buffer c ;
+      p_trad buffer acc lexbuf
+    }
+  | eof {
+      let occ c acc =
+        List.fold_left (fun sum -> function Arg x when x.[0] = c -> sum + 1 | _ -> sum) 1 acc
+      in
+      let rec loop acc = function
+        | Arg hd :: tl ->
+          let c = hd.[0] in
+          if c <> '_' then
+            let occ = occ c tl in
+            if occ = 1
+            && not (List.exists (function Arg s -> s.[0] = c | _ -> false) acc)
+            then loop (Arg hd :: acc) tl
+            else loop (Arg (hd ^ string_of_int occ) :: acc) tl
+          else loop (Arg hd :: acc) tl
+        | hd :: tl -> loop (hd :: acc) tl
+        | [] -> acc
+      in
+      loop [] (flush buffer acc)
+      |> Array.of_list
+    }

plugins/gwxjg/gwxjg_trans.ml

@@ -0,0 +1,121 @@
+module Lexicon_parser = Gwxjg_lexicon_parser
+open Jingoo
+
+let fast_concat = function
+  | [] -> ""
+  | [ s ] -> s
+  | l ->
+      let b =
+        Bytes.create (List.fold_left (fun acc s -> String.length s + acc) 0 l)
+      in
+      ignore
+      @@ List.fold_left
+           (fun pos s ->
+             let len = String.length s in
+             Bytes.unsafe_blit (Bytes.unsafe_of_string s) 0 b pos len;
+             pos + len)
+           0 l;
+      Bytes.unsafe_to_string b
+
+let args line =
+  List.sort_uniq compare
+  @@ List.fold_left
+       (fun acc list ->
+         List.fold_left
+           (fun acc -> function Lexicon_parser.Arg x -> x :: acc | _ -> acc)
+           acc list)
+       [] line
+
+let import_trad ht keyword line =
+  let open Jg_types in
+  let open Jg_runtime in
+  Hashtbl.add ht keyword @@ fun ?(kwargs = []) i ->
+  let i = if i < 0 || i >= Array.length line then 0 else i in
+  let arg s = List.assoc s kwargs in
+  Tstr
+    (fast_concat
+    @@
+    let a = Array.unsafe_get line i in
+    let rec loop acc i =
+      if i < 0 then acc
+      else
+        match Array.unsafe_get a i with
+        | Lexicon_parser.Str s -> loop (s :: acc) (i - 1)
+        | Arg n -> loop (string_of_tvalue (arg n) :: acc) (i - 1)
+        | Declension (c, n) ->
+            loop ((arg n |> string_of_tvalue |> Mutil.decline c) :: acc) (i - 1)
+        | Elision (s1, s2) ->
+            let x =
+              try unbox_string @@ arg "elision" with Not_found -> List.hd acc
+            in
+            if
+              x <> ""
+              && Unidecode.decode
+                   (fun _ _ -> false)
+                   (fun _ -> function
+                     | 'A' | 'E' | 'I' | 'O' | 'U' | 'a' | 'e' | 'i' | 'o' | 'u'
+                       ->
+                         true
+                     | _ -> false)
+                   (fun _ -> false)
+                   x 0 (String.length x)
+            then loop (s2 :: acc) (i - 1)
+            else loop (s1 :: acc) (i - 1)
+    in
+    loop [] (Array.length a - 1))
+
+let default_lang = "en"
+
+let find_lang lang tr =
+  try List.assoc lang tr with Not_found -> List.assoc default_lang tr
+
+let make_lang lexicon len lang =
+  let ht = Hashtbl.create len in
+  List.iter (fun (key, tr) -> import_trad ht key (find_lang lang tr)) lexicon;
+  ht
+
+let lexicon_files = ref []
+
+let de_en_es_fi_fr_it_nl_no_pt_sv =
+  lazy
+    (let acc =
+       List.fold_left
+         (fun acc file ->
+           let in_chan = open_in file in
+           let lexbuf = Lexing.from_channel in_chan in
+           try
+             let acc = Lexicon_parser.p_main acc lexbuf in
+             close_in in_chan;
+             acc
+           with Failure msg ->
+             failwith
+               (Printf.sprintf "%s line: %d" msg
+                  lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum))
+         [] !lexicon_files
+     in
+     let lexicon =
+       let rec loop acc = function
+         | [] -> acc
+         | ((key, trad) as hd) :: tl ->
+             let acc =
+               if
+                 List.exists (fun (k, _) -> k = key) acc
+                 || not (List.mem_assoc default_lang trad)
+               then acc
+               else hd :: acc
+             in
+             loop acc tl
+       in
+       loop [] acc
+     in
+     let len = List.length lexicon in
+     ( make_lang lexicon len "de",
+       make_lang lexicon len "en",
+       make_lang lexicon len "es",
+       make_lang lexicon len "fi",
+       make_lang lexicon len "fr",
+       make_lang lexicon len "it",
+       make_lang lexicon len "nl",
+       make_lang lexicon len "no",
+       make_lang lexicon len "pt",
+       make_lang lexicon len "sv" ))

plugins/gwxjg/plugin_gwxjg.ml

@@ -0,0 +1 @@
+let () = ()