Permalink
Browse files

TO BE REMOVED: revert some changes in geneweb

  • Loading branch information...
sagotch committed Aug 10, 2018
1 parent 42029ad commit 457c9ccd62a6dcb0c5d845c417b37ecadb969fe5
Showing with 61 additions and 66 deletions.
  1. +3 −7 internal/date.ml
  2. +26 −22 internal/hutil.ml
  3. +9 −11 internal/notes.ml
  4. +1 −1 internal/util.ml
  5. +9 −9 internal/wiki.ml
  6. +9 −12 lib/cousins.ml
  7. +3 −3 lib/descend.ml
  8. +1 −1 lib/perso.ml
View
@@ -248,14 +248,10 @@ let string_of_prec_dmy conf s s2 d =
| Before -> transl_decline conf "before (date)" s
| After -> transl_decline conf "after (date)" s
| Maybe -> transl_decline conf "possibly (date)" s
| OrYear _ ->
"<span class=\"text-nowrap\">" ^ s ^ "</span>" ^ " " ^
"<span class=\"text-nowrap\">" ^ transl conf "or" ^ " " ^
Mutil.nominative s2 ^ "</span>"
| OrYear _ -> s ^ " " ^ transl conf "or" ^ " " ^ Mutil.nominative s2
| YearInt _ ->
"<span class=\"text-nowrap\">" ^ transl conf "between (date)" ^ " " ^
s ^ "</span>" ^ " " ^ "<span class=\"text-nowrap\">" ^
transl_nth conf "and" 0 ^ " " ^ Mutil.nominative s2 ^ "</span>"
transl conf "between (date)" ^ " " ^ s ^ " " ^
transl_nth conf "and" 0 ^ " " ^ Mutil.nominative s2
let string_of_dmy conf d =
let sy = code_dmy conf d in
View
@@ -3,6 +3,8 @@
open Config
let up_fname _conf = "up.png"
let commd_no_params conf =
conf.command ^ "?" ^
List.fold_left
@@ -22,22 +24,27 @@ let link_to_referer conf =
else ""
let gen_print_link_to_welcome f conf right_aligned =
if conf.cancel_links then ()
else
begin
if right_aligned then
Wserver.printf "<div class=\"btn-group float-%s mt-2\">\n" conf.right
else Wserver.printf "<p>\n";
f ();
let str = link_to_referer conf in
if str = "" then () else Wserver.printf "%s" str;
Wserver.printf "<a href=\"%s\">\
<span class=\"fa fa-home fa-lg ml-1 px-0\" title=\"%s\"></span>\
</a>\n"
(commd_no_params conf) (Util.capitale (Util.transl conf "home"));
if right_aligned then Wserver.printf "</div>\n"
else Wserver.printf "</p>\n"
end
if not conf.cancel_links then begin
let fname = up_fname conf in
let wid_hei =
match Util.image_size (Util.image_file_name fname) with
| Some (wid, hei) ->
" width=\"" ^ string_of_int wid ^ "\" height=\"" ^ string_of_int hei ^ "\""
| None -> ""
in
if right_aligned then
Wserver.printf "<div style=\"float:%s\">\n" conf.right
else Wserver.printf "<p>\n";
f ();
let str = link_to_referer conf in
if str = "" then () else Wserver.printf "%s" str;
Wserver.printf "<a href=\"%s\">\
<img src=\"%s/%s\"%s alt=\"^^\" title=\"^^\"%s>\
</a>\n"
(commd_no_params conf) (Util.image_prefix conf) fname wid_hei conf.xhs;
if right_aligned then Wserver.printf "</div>\n"
else Wserver.printf "</p>\n"
end
let print_link_to_welcome = gen_print_link_to_welcome (fun () -> ())
@@ -68,13 +75,12 @@ let header_without_http conf title =
Not_found -> ""
in
let s = s ^ Util.body_prop conf in
Wserver.printf "<body%s>\n" s; Util.message_to_wizard conf
Wserver.printf "<body%s>\n" s;
Util.message_to_wizard conf
let header_without_page_title conf title =
Util.html conf;
header_without_http conf title;
(* balancing </div> in gen_trailer *)
Wserver.printf "<div class=\"container\">"
header_without_http conf title
let header_link_welcome conf title =
header_without_page_title conf title;
@@ -97,8 +103,6 @@ let header conf title =
let header_fluid conf title =
header_without_http conf title;
(* balancing </div> in gen_trailer *)
Wserver.printf "<div class=\"container-fluid\">";
Wserver.printf "\n<h1>";
title false;
Wserver.printf "</h1>\n"
View
@@ -75,19 +75,17 @@ let print_whole_notes conf base fnotes title s ho =
end
in
Hutil.gen_print_link_to_welcome what_links_page conf true;
Wserver.printf "<div class=\"d-flex justify-content-between\">\n";
if title <> "" then
begin let title =
match ho with
Some (case_sens, h) -> html_highlight case_sens h title
| None -> title
in
Wserver.printf "<h1 class=\"my-3\">%s</h1>\n" title
match ho with
| Some (case_sens, h) -> html_highlight case_sens h title
| None -> title
in
Wserver.printf "<h1>%s</h1>\n" title
end;
Wserver.printf "</div>\n";
begin match Util.open_etc_file "summary" with
Some ic -> Templ.copy_from_templ conf [] ic
| None -> ()
| Some ic -> Templ.copy_from_templ conf [] ic
| None -> ()
end;
let file_path = file_path conf base in
let s = string_with_macros conf [] s in
@@ -103,7 +101,7 @@ let print_whole_notes conf base fnotes title s ho =
in
let s =
match ho with
Some (case_sens, h) -> html_highlight case_sens h s
| Some (case_sens, h) -> html_highlight case_sens h s
| None -> s
in
Wserver.printf "%s\n" s;
@@ -258,7 +256,7 @@ let print_linked_list conf base pgl =
Wserver.printf "<tt>";
if conf.wizard then
begin
Wserver.printf "<a class=\"mx-2\" href=\"%s;i=%d;\">"
Wserver.printf "<a href=\"%s;i=%d;\">"
(commd conf) (Adef.int_of_iper ip);
Wserver.printf "</sup><i class=\"fa fa-cog\"></i></sup>";
Wserver.printf "</a>"
View
@@ -885,7 +885,7 @@ let titled_person_text conf base p t =
let one_title_text base t =
let place = sou base t.t_place in
let s = sou base t.t_ident in
let s = if place = "" then s else s ^ " " ^ place in " <em>" ^ s ^ "</em>"
let s = if place = "" then s else s ^ " " ^ place in ", <em>" ^ s ^ "</em>"
let geneweb_link conf href s =
if conf.cancel_links then s
View
@@ -344,7 +344,8 @@ let string_of_modify_link conf cnt empty =
let mode_pref = if can_edit then "MOD" else "VIEW" in
Printf.sprintf "%s(<a href=\"%sm=%s_%s;v=%d%s\">%s</a>)%s\n"
(if empty then "<p>"
else Printf.sprintf "<div class=\"small float-%s\">" conf.right)
else Printf.sprintf "<div style=\"font-size:80%%;float:%s;margin-%s:3em\">"
conf.right conf.left)
(commd conf) mode_pref mode cnt
(if sfn = "" then "" else ";f=" ^ sfn)
(if can_edit then transl_decline conf "modify" ""
@@ -574,7 +575,8 @@ let html_with_summary_of_tlsw conf wi edit_opt s =
(lines_before_summary @ summary @ lines_after_summary))
in
if lines_before_summary <> [] || lines = [] then
let s2 = string_of_modify_link conf 0 (s = "") edit_opt in s2 ^ s
let s2 = string_of_modify_link conf 0 (s = "") edit_opt in
s2 ^ "<p><br" ^ conf.xhs ^ "></p>\n" ^ s
else s
let rev_extract_sub_part s v =
@@ -603,21 +605,19 @@ let print_sub_part_links conf edit_mode sfn cnt0 is_empty =
Wserver.printf "<p>\n";
if cnt0 >= first_cnt then
begin
Wserver.printf "<a href=\"%sm=%s%s;v=%d\">" (commd conf) edit_mode sfn
(cnt0 - 1);
Wserver.printf
"<span class=\"fa fa-arrow-left fa-lg\" title=\"<<\"></span>";
"<a href=\"%sm=%s%s;v=%d\">" (commd conf) edit_mode sfn (cnt0 - 1);
Wserver.printf "&lt;&lt;" ;
Wserver.printf "</a>\n"
end;
Wserver.printf "<a href=\"%sm=%s%s\">" (commd conf) edit_mode sfn;
Wserver.printf "<span class=\"fa fa-arrow-up fa-lg\" title=\"^^\"></span>";
Wserver.printf "^^";
Wserver.printf "</a>\n";
if not is_empty then
begin
Wserver.printf "<a href=\"%sm=%s%s;v=%d\">" (commd conf) edit_mode sfn
(cnt0 + 1);
Wserver.printf
"<span class=\"fa fa-arrow-right fa-lg\" title=\">>\"></span>";
"<a href=\"%sm=%s%s;v=%d\">" (commd conf) edit_mode sfn (cnt0 + 1);
Wserver.printf "&gt;&gt;" ;
Wserver.printf "</a>\n"
end;
Wserver.printf "</p>\n"
View
@@ -228,10 +228,11 @@ let rec print_descend_upto conf base max_cnt ini_p ini_br lev children =
let sibling_has_desc_lev conf base lev (ip, _) =
has_desc_lev conf base lev (pget conf base ip)
let print_cousins_side_of conf base max_cnt a ini_p ini_br lev1 lev2 =
let print_cousins_side_of conf base max_cnt a ini_p ini_br lev1 lev2 tips =
let sib = siblings conf base (get_key_index a) in
if List.exists (sibling_has_desc_lev conf base lev2) sib then
begin
if tips then Util.print_tips_relationship conf ;
if lev1 > 1 then
begin
Wserver.printf "<li>\n";
@@ -257,25 +258,22 @@ let print_cousins_lev conf base max_cnt p lev1 lev2 =
loop Sosa.one lev1
in
let last_sosa = Sosa.twice first_sosa in
Wserver.printf "<div>\n";
Util.print_tips_relationship conf;
Wserver.printf "</div>\n";
if lev1 > 1 then Wserver.printf "<ul>\n";
let some =
let rec loop sosa some =
let rec loop sosa some print_tips =
if !cnt < max_cnt && Sosa.gt last_sosa sosa then
let some =
match Util.branch_of_sosa conf base (get_key_index p) sosa with
Some ((ia, _) :: _ as br) ->
print_cousins_side_of conf base max_cnt (pget conf base ia) p br
lev1 lev2 ||
lev1 lev2 print_tips ||
some
| _ -> some
in
loop (Sosa.inc sosa 1) some
loop (Sosa.inc sosa 1) some false
else some
in
loop first_sosa false
loop first_sosa false true
in
if some then ()
else Wserver.printf "%s.\n" (capitale (transl conf "no match"));
@@ -332,9 +330,9 @@ let print_cousins conf base p lev1 lev2 =
Perso.interp_notempl_with_menu title "perso_header" conf base p;
Wserver.printf "<div>\n";
(*include_templ conf "cousins_tools";*)
Wserver.printf "<h3>\n";
Wserver.printf "<h2>\n";
title false;
Wserver.printf "</h3>\n";
Wserver.printf "</h2>\n";
Wserver.printf "</div>\n";
cnt := 0;
(* Construction de la table des sosa de la base *)
@@ -349,8 +347,7 @@ let print_cousins conf base p lev1 lev2 =
(Util.translate_eval ("@(c)" ^ transl_nth conf "person/persons" 1));
if p_getenv conf.env "spouse" = Some "on" then
Wserver.printf " %s %d %s.\n" (transl conf "and") !cnt_sp
(Util.translate_eval ("@(c)" ^ transl_nth conf "spouse/spouses" 1))
else Wserver.printf ".\n" ;
(Util.translate_eval ("@(c)" ^ transl_nth conf "spouse/spouses" 1)) ;
Wserver.printf "</p>\n";
Wserver.printf "</div>\n";
Hutil.trailer conf
View
@@ -1375,17 +1375,17 @@ let print conf base p =
match p_getenv conf.env "t" with
Some ("F" | "L" | "M") -> "deslist"
| Some "D" -> "deslist_hr"
| Some ("H" | "I" | "A") -> "destable"
| Some ((* "H" | *) "I" (* | "A" *)) -> "destable"
| Some "V" -> "destree"
| Some _ -> ""
| _ -> "desmenu"
in
if templ <> "" then Perso.interp_templ templ conf base p
else
match p_getenv conf.env "t", p_getint conf.env "v" with
Some "B", Some v -> print_aboville conf base v p
Some "A" (* "B" *), Some v -> print_aboville conf base v p
| Some "S", Some v -> display_descendants_level conf base v p
| Some "K", Some v -> display_descendant_with_table conf base v p
| Some "H" (* "K" *), Some v -> display_descendant_with_table conf base v p
| Some "N", Some v -> display_descendants_with_numbers conf base v p
| Some "G", Some v -> display_descendant_index conf base v p
| Some "C", Some v -> display_spouse_index conf base v p
View
@@ -3488,7 +3488,7 @@ and eval_date_field_var conf d =
end
| _ -> VVstring ""
end
| [] -> VVstring (Date.string_of_date_sep conf "&#010; " d)
| [] -> VVstring (Date.string_of_date_sep conf "<br />" d)
| _ -> raise Not_found
and _eval_place_field_var conf place =
function

0 comments on commit 457c9cc

Please sign in to comment.