Commit 4e004729 authored by Idir Lankri's avatar Idir Lankri

Improve the corpus manager interface

parent eb372641
function hideShowElement(id) {
var elt = document.getElementById(id);
if (elt.style.display === 'block') {
elt.style.display = 'none';
} else {
elt.style.display = 'block';
}
}
......@@ -254,8 +254,8 @@ params.cmo : params.cmi
params.cmx : params.cmi
interface_cgi.cmo : interface.cmi
interface_cgi.cmx : interface.cmx
html.cmo : paths.cmo
html.cmx : paths.cmx
html.cmo : paths.cmo ../ZEN/gen.cmo
html.cmx : paths.cmx ../ZEN/gen.cmx
web.cmo : SCLpaths.cmo paths.cmo html.cmo date.cmo
web.cmx : SCLpaths.cmx paths.cmx html.cmx date.cmx
css.cmo : web.cmo html.cmo
......@@ -284,22 +284,21 @@ mk_reader_page.cmx : web.cmx paths.cmx params.cmx html.cmx control.cmx \
cgi.cmx
mk_sandhi_page.cmo : web.cmo html.cmo
mk_sandhi_page.cmx : web.cmx html.cmx
corpus.cmi :
corpus.cmo : web.cmo dir.cmi corpus.cmi
corpus.cmx : web.cmx dir.cmx corpus.cmi
mk_corpus_page.cmo : web.cmo html.cmo
mk_corpus_page.cmx : web.cmx html.cmx
corpus.cmi : ../ZEN/word.cmo
corpus.cmo : ../ZEN/word.cmo web.cmo sanskrit.cmi interface.cmi \
../ZEN/gen.cmo encode.cmo dir.cmi corpus.cmi
corpus.cmx : ../ZEN/word.cmx web.cmx sanskrit.cmx interface.cmx \
../ZEN/gen.cmx encode.cmx dir.cmx corpus.cmi
corpus_manager.cmi :
corpus_manager.cmo : ../ZEN/word.cmo web.cmo paths.cmo params.cmi \
multilingual.cmo html.cmo ../ZEN/gen.cmo dir.cmi corpus.cmi canon.cmo \
corpus_manager.cmi
corpus_manager.cmx : ../ZEN/word.cmx web.cmx paths.cmx params.cmx \
multilingual.cmx html.cmx ../ZEN/gen.cmx dir.cmx corpus.cmx canon.cmx \
corpus_manager.cmi
corpus_manager.cmo : web.cmo paths.cmo params.cmi multilingual.cmo html.cmo \
dir.cmi corpus.cmi canon.cmo corpus_manager.cmi
corpus_manager.cmx : web.cmx paths.cmx params.cmx multilingual.cmx html.cmx \
dir.cmx corpus.cmx canon.cmx corpus_manager.cmi
corpus_manager_cgi.cmo : params.cmi corpus_manager.cmi cgi.cmo
corpus_manager_cgi.cmx : params.cmx corpus_manager.cmx cgi.cmx
save_corpus.cmi :
save_corpus.cmo : web.cmo sanskrit.cmi interface.cmi ../ZEN/gen.cmo \
encode.cmo corpus_manager.cmi save_corpus.cmi
save_corpus.cmx : web.cmx sanskrit.cmx interface.cmx ../ZEN/gen.cmx \
encode.cmx corpus_manager.cmx save_corpus.cmi
save_corpus_cgi.cmo : save_corpus.cmi params.cmi cgi.cmo
save_corpus_cgi.cmx : save_corpus.cmx params.cmx cgi.cmx
save_corpus_cgi.cmo : web.cmo params.cmi corpus_manager.cmi corpus.cmi \
cgi.cmo
save_corpus_cgi.cmx : web.cmx params.cmx corpus_manager.cmx corpus.cmx \
cgi.cmx
......@@ -301,8 +301,8 @@ mk_sandhi_page: mk_sandhi_page.cmx
SCLpaths.cmx web.cmx mk_sandhi_page.cmx -o mk_sandhi_page
mk_corpus_page: mk_corpus_page.cmx
$(LINK) paths.cmx version.cmx date.cmx SCLpaths.cmx html.cmx \
web.cmx $< -o $@
$(LINK) gen.cmx paths.cmx version.cmx date.cmx SCLpaths.cmx \
html.cmx web.cmx $< -o $@
# site_pages must be recomputed after configuration and creation of DICO dir
# the style sheet must be recomputed, since it contains absolute URLs as well
......
(*************)
(* Utilities *)
(*************)
value rec first_gap = fun
[ [] -> 1
| [ h ] -> h + 1
| [ x ; y :: t ] -> if y = x + 1 then first_gap [ y :: t ] else x + 1
]
;
value until_nth n l =
if n < 0 then invalid_arg "until_nth" else aux n l
where rec aux n = fun
[ [] -> []
| [ h :: t ] -> if n = 0 then [ h ] else [ h :: aux (n - 1) t ] ]
| [ h :: t ] -> if n = 0 then [ h ] else [ h :: aux (n - 1) t ]
]
;
(* Type representing interval of missing integers in a sorted list. *)
type gap = { start : int; stop : int }
;
(* The following functions assume that the given list is sorted in
increasing order and represents a subset of positive integers. In
particular, the lowest bound of a gap is at least [1] and the
greatest at most [max_int]). We call "group" a list of consecutive
integers. *)
(* Return a triple [(g, gap, rest)] where [g] is the first group of the
given list, [gap] the gap to the next group and [rest] the given
list without its first group. *)
value rec first_group = fun
[ [ x :: ([ y :: _ ] as t) ] ->
if y = x + 1 then
let (group, gap, rest) = first_group t in
([ x :: group ], gap, rest)
else
([ x ], { start = x + 1; stop = y - 1 }, t)
| [] -> ([], { start = 1; stop = max_int }, [])
| [ x ] as l ->
(l, { start = x + 1; stop = max_int }, [])
]
;
value groups_with_gaps l =
let rec aux l =
let (group, gap, rest) = first_group l in
let group_gap = (group, gap) in
match rest with
[ [] -> [ group_gap ]
| _ -> [ group_gap :: aux rest ]
]
in
aux l
;
value add_init_gap groups =
let init_gap = fun
[ [ ([ x :: _ ], _) :: _ ] ->
if x <> 1 then Some { start = 1; stop = x - 1 } else None
| _ -> None
]
in
match init_gap groups with
[ None -> groups
| Some gap -> [ ([], gap) :: groups ]
]
;
(*******************)
(* Page generation *)
(*******************)
value top_link = Html.anchor_ref Web.corpus_manager_cgi "Top"
;
value link dir =
let url =
let corpdir =
match dir with
[ None -> ""
| Some dir -> "?corpdir=" ^ Dir.url_encode dir ^ Dir.url_encoded_dir_sep]
| Some dir -> "?corpdir=" ^ Dir.url_encode dir ^ Dir.url_encoded_dir_sep
]
in
Web.corpus_manager_cgi ^ corpdir
in
Html.anchor_ref url ".." |> Html.span2_center
let label =
match dir with
[ None -> "Home"
| Some dir -> Filename.basename dir
]
in
Html.anchor_ref url label
;
value uplink dir =
if dir = "" then None else
let updir = Filename.dirname dir in
let updir =
if updir = Filename.current_dir_name then None else Some updir
in
Some (link updir)
;
value string_of_uplink = fun
[ None -> ""
| Some uplink -> uplink ^ " / "]
;
(* value quick_links dir = *)
(* let updirs = Dir.split dir in *)
(* let updirs = *)
(* List.mapi (fun i x -> *)
(* String.concat Filename.dir_sep (until_nth i updirs) *)
(* ) updirs *)
(* in *)
(* List.map link updirs *)
(* ; *)
link updir
;
value uplinks' dir =
let updirs = Dir.split dir in
let updirs =
List.mapi (fun i x ->
String.concat Filename.dir_sep (until_nth i updirs)
) updirs
in
List.map uplink updirs
;
value uplinks dir final_sep =
let dir_sep = " / " in
let links = uplinks' dir in
let cur_dir =
match links with
[ [] -> ""
| _ -> dir_sep ^ Filename.basename dir
]
in
String.concat dir_sep links ^ cur_dir ^ if final_sep then dir_sep else ""
;
(* Display sentences with format "sentence || sentno" like in citations
file. *)
value sentence_links dir files =
let to_anchor_ref file =
let metadata = Corpus.gobble_sentence_metadata dir file in
let metadata =
Corpus.gobble_sentence_metadata (Web.corpus_dir ^ dir) file
in
let font = Multilingual.font_of_string (Paths.default_display_font) in
let words =
List.map (
match Multilingual.font_of_string (Paths.default_display_font) with
match font with
[ Multilingual.Deva -> Canon.unidevcode
| Multilingual.Roma -> Canon.uniromcode ]
| Multilingual.Roma -> Canon.uniromcode
]
) metadata.Corpus.text
in
let display =
match font with
[ Multilingual.Deva -> Html.deva16_blue
| Multilingual.Roma -> Html.span Html.Trans16
]
in
let sentence = String.concat " " words in
Html.anchor_ref (Web.corpus_url ^ dir ^ file) (Html.span2_center sentence)
Html.anchor_ref (Web.corpus_url ^ dir ^ file) sentence |> display
in
List.map to_anchor_ref files
;
......@@ -76,86 +139,87 @@ value subdir_selection dir subdirs =
in
Html.option_select_label Params.corpus_dir options
;
type gap = { start : int; stop : int }
;
value rec first_group = fun
[ [ x :: ([ y :: _ ] as t) ] ->
let idx = Corpus.sentence_id x in
let idy = Corpus.sentence_id y in
if idy = idx + 1 then
let ((group, gap), rest) = first_group t in
(([ x :: group ], gap), rest)
else
(([ x ], { start = idx + 1; stop = idy - 1 }), t)
| [] -> (([], { start = 1; stop = max_int }), [])
| [ x ] as l ->
((l, { start = Corpus.sentence_id x + 1; stop = max_int }), []) ]
;
value very_first_group = fun
[ [ ([ x :: _ ], _) :: _ ] ->
let idx = Corpus.sentence_id x in
if idx <> 1 then
Some ([], { start = 1; stop = idx - 1 })
else
None
| _ -> None ]
;
value groups l =
let rec aux l =
let (group, rest) = first_group l in
match rest with
[ [] -> [ group ]
| _ -> [ group :: aux rest ] ]
in
let groups = aux l in
match very_first_group groups with
[ None -> groups
| Some x -> [ x :: groups ] ]
;
value add_sentence_form dir gap =
Web.cgi_begin (Web.cgi_bin "skt_heritage") "" ^
string_of_uplink (uplink dir) ^
uplinks dir True ^ "Sentence number: " ^
Html.hidden_input Params.corpus_dir dir ^
Html.int_input ~name:Params.sentence_no ~step:1 ~min:gap.start ~max:gap.stop
~val:gap.start ~id:Params.sentence_no ^
Html.submit_input "Add sentence" ^
Html.int_input
~name:Params.sentence_no
~step:1
~min:gap.start
~max:gap.stop
~val:gap.start
~id:Params.sentence_no ^
Html.submit_input "Add" ^
Web.cgi_end
;
value htmlify_group dir (group, gap) =
let ol =
let (ol, group_id) =
match group with
[ [] -> ""
[ [] -> ("", "")
| [ h :: _ ] ->
Html.ol ~start:(Corpus.sentence_id h) (sentence_links dir group) ]
let id = Corpus.sentence_id h in
(Html.ol ~start:id ~items:(sentence_links dir group), string_of_int id)
]
in
let div_id = "group" ^ group_id in
ol ^
Html.button
~id:"foo"
~cl:Html.Center_
~onclick:{ Html.js_funid = "hideShowElement"; Html.js_funargs = [ div_id ] }
~label:"Hide/Show form to fill gap" ^
Html.elt_begin_attrs [ ("id", div_id) ] "div" Html.Hidden_ ^
Html.html_paragraph ^
add_sentence_form dir gap ^
Html.div_end
;
value sentence_file dir no = string_of_int no ^ ".html"
;
value group_sentences dir files =
let groups =
files
|> List.map Corpus.sentence_id
|> groups_with_gaps
|> add_init_gap
in
ol ^ add_sentence_form dir gap
List.map (fun (x, y) -> (List.map (sentence_file dir) x, y)) groups
;
value body dir =
match Corpus.content dir with
match Corpus.content (Web.corpus_dir ^ dir) with
[ Corpus.Sentences files ->
let groups = group_sentences dir files in
do
{ List.map (htmlify_group dir) (groups files) |> List.iter Web.pl }
{ Html.h2_begin Html.B2 |> Web.pl
; uplinks dir False |> Web.pl
; Html.h2_end |> Web.pl
; groups |> List.map (htmlify_group dir) |> List.iter Web.pl
; Html.html_break |> Web.pl
}
| Corpus.Sections subdirs ->
let selection_prompt =
uplinks dir (dir <> "") ^ subdir_selection dir subdirs ^
Html.submit_input "Select"
in
do
{ Web.cgi_begin Web.corpus_manager_cgi "" |> Web.pl
; uplink dir |> string_of_uplink |> Web.pl
; subdir_selection dir subdirs |> Web.pl
(* Submit button or links to subdirs? *)
; Html.submit_input "Select" |> Web.pl
; Web.cgi_end |> Web.pl } ]
; Html.h2_begin Html.C2 |> Web.pl
; selection_prompt |> Web.pl
; Html.h2_end |> Web.pl
; Web.cgi_end |> Web.pl
}
]
;
value make dir =
let title = "Corpus Manager" in
let meta_title = Html.title title in
let style = Html.background Html.Chamois in
let title = "Sanskrit Corpus" in
do
{ Web.maybe_http_header ()
; Web.page_begin meta_title
; Html.body_begin style |> Web.pl
; Web.page_begin (Html.title title)
; Html.body_begin Html.Chamois_back |> Web.pl
; Web.open_page_with_margin 15
; Html.h1_title title |> Web.print_title (Some Html.default_language)
; Html.center_begin |> Web.pl
; body dir
; Html.center_end |> Web.pl
; Web.page_end Html.default_language True }
; Web.close_page_with_margin ()
; Web.page_end Html.default_language True
}
;
......@@ -51,7 +51,7 @@ value sheets = (* cascading style sheets data *)
; ("td",Grey_back); ("td",Pink_back); ("td",Spacing20)
; ("td",Light_blue_back); ("td",Lavender_back); ("td",Lawngreen_back)
; ("th",Cell5); ("th",Cell10); ("th",Border2); ("td",Center_)
; ("table",Centered); ("table",Tcenter)
; ("table",Centered); ("table",Tcenter) ; ("", Hidden_)
];
value css_decls =
......
......@@ -109,16 +109,29 @@ value option_select_default_id id label list_options =
value text_input id control =
xml_empty_with_att "input" [ ("id",id); ("type","text"); ("name",control) ]
;
value int_input ~id ~name ~step ~min ~max ~val =
value add_opt_attrs opt_attrs attrs =
List.fold_left (fun acc (label, v) ->
match v with
[ None -> acc
| Some v -> [ (label, v) :: acc ]
]
) attrs opt_attrs
;
value int_input ?id ?val ?(step = 1) ?(min = min_int) ?(max = max_int) ~name =
let attrs =
[ ("type", "number")
; ("id", id)
; ("name", name)
; ("step", string_of_int step)
; ("min", string_of_int min)
; ("max", string_of_int max)
; ("value", string_of_int val) ]
]
in
let opt_attrs =
[ ("id", id)
; ("value", Gen.opt_app string_of_int val)
]
in
let attrs = add_opt_attrs opt_attrs attrs in
xml_empty_with_att "input" attrs
;
value radio_input control v label =
......@@ -154,10 +167,12 @@ value hidden_input name label =
value li item = xml_empty "li" ^ item
;
(* Ordered list *)
value ol ~start items =
value ol ?(start = 1) ~items =
let ol = "ol" in
let list = String.concat "\n" (List.map li items) in
xml_begin_with_att ol [ ("start", string_of_int start) ] ^ list ^ xml_end ol
xml_begin_with_att ol [ ("start", string_of_int start) ] ^ "\n" ^
list ^ "\n" ^
xml_end ol
;
value fieldn name content = [ ("name",name); ("content",content) ]
......@@ -209,6 +224,7 @@ type basic_style =
| Border_sep
| Border_col
| Border_sp of int
| Hidden
] (* font-weight not supported *)
;
value rgb = fun (* a few selected HTML colors in rgb data *)
......@@ -305,6 +321,7 @@ value style_sheet = fun
| Border_sep -> "border-collapse:separate"
| Border_col -> "border-collapse:collapse"
| Border_sp n -> "border-spacing:" ^ points n
| Hidden -> "display: none"
]
;
(* Style of enpied bandeau with fixed position at bottom of page - fragile *)
......@@ -324,7 +341,7 @@ type style_class =
| Pink_back | Chamois_back | Cyan_back | Brown_back | Lime_back | Grey_back
| Deep_sky_back | Carmin_back | Orange_back | Red_back | Mauve_back
| Lavender_back | Lavender_cent | Green_back | Lawngreen_back | Magenta_back
| Aquamarine_back
| Aquamarine_back | Hidden_
(*[ | Pict_om | Pict_om2 | Pict_om3 | Pict_om4 | Pict_gan | Pict_hare | Pict_geo ]*)
]
;
......@@ -434,6 +451,7 @@ value styles = fun
| Cell5 -> [ Padding 5 ]
| Cell10 -> [ Padding 10 ]
| Border2 -> [ Border 2 ]
| Hidden_ -> [ Hidden ]
]
;
(* Compiles a class into its style for non-css compliant browsers *)
......@@ -509,6 +527,7 @@ value class_of = fun
| Cell10 -> "cell10"
| Border2 -> "border2"
| Body -> "body"
| Hidden_ -> "hidden"
]
;
(* Allows css style compiling even when browser does not support css *)
......@@ -702,6 +721,7 @@ and dico_index_page = wrap_ext "index"
and dico_reader_page = wrap_ext "reader"
and dico_grammar_page = wrap_ext "grammar"
and dico_sandhi_page = wrap_ext "sandhi"
and dico_corpus_page = wrap_ext "corpus"
and faq_page = wrap_ext "faq"
and portal_page = wrap_ext "portal"
;
......@@ -740,3 +760,30 @@ value ocaml_site = url "ocaml.org"
and inria_site = url "www.inria.fr/"
and tomcat = url "localhost:8080/" (* Sanskrit Library runs Tomcat *)
;
(**********)
(* Button *)
(**********)
value js_string_arg s =
let delim delim s = delim ^ s ^ delim in
delim "'" s
;
type js_funcall = { js_funid : string; js_funargs : list string }
;
value string_of_js_funcall f =
let js_funargs = List.map js_string_arg f.js_funargs in
f.js_funid ^ "(" ^ String.concat ", " js_funargs ^ ")"
;
value button ?id ?cl ?onclick ~label =
let button = "button" in
let attrs =
add_opt_attrs
[ ("onclick", Gen.opt_app string_of_js_funcall onclick)
; ("id", id)
; ("class", Gen.opt_app class_of cl)
] []
in
let button_begin = xml_begin_with_att button attrs in
let button_end = xml_end button in
button_begin ^ label ^ button_end
;
......@@ -366,6 +366,11 @@ value deva_read_script dyn =
else deva_reader in
javascript ref
;
value js_util_script dyn =
let js_util_file = "util.js" in
let prefix = if dyn then dico_page_url else (fun x -> x) in
javascript (prefix js_util_file)
;
value css_link dyn =
let ref = if dyn then style_sheet_url (* dynamic page, absolute URL *)
else style_sheet (* static page in DICO, relative URL *) in
......@@ -397,6 +402,7 @@ value page_begin_dyn dyn title = do
; pl (css_link dyn) (* . *)
; pl (favicon dyn) (* . *)
; pl (deva_read_script dyn) (* devanagari input *)(* . *)
; pl (js_util_script dyn)
; pl (xml_end "head") (* ) *)
}
;
......
......@@ -97,7 +97,7 @@ DOC_IMAGES=IMAGES/lexer10.jpg IMAGES/lexer17.jpg IMAGES/lexer40.jpg # Copy GH
# NB. Use of gif vs others formats such as jpg is due to browser compatibility
# Scripts
SCRIPTS=JAVASCRIPT/utf82VH.js JAVASCRIPT/dragtable.js
SCRIPTS=JAVASCRIPT/utf82VH.js JAVASCRIPT/dragtable.js JAVASCRIPT/util.js
# Next are copyright specific images
SITE_IMAGES=IMAGES/yinyang.gif IMAGES/panini.jpg IMAGES/spin-new.gif \
......
......@@ -17,6 +17,8 @@ value optional f = fun [ None -> () | Some d -> f d ]
;
value active = fun [ None -> False | Some _ -> True ]
;
value opt_app f = fun [ Some x -> Some (f x) | None -> None ]
;
(* Dump value [v] on [file]. *)
value dump v file =
......
......@@ -27,7 +27,6 @@ makefile_keys=["TEMPLATE","PLATFORM","TRANSLIT","LEXICON","DISPLAY","WARN",
#"SCLURL","SCLINSTALLDIR","TEMPAREA","OUTPUTFONT",
counter_keys=["CAPTION"]
version_keys=["VERSION","DATE"]
cgi_keys = ["CGIBINURL", "CGIEXT"]
TEMPLATE='#'
WARN='# WARNING - Produced from MMakefile by configure - Do not edit manually'
......@@ -80,8 +79,6 @@ def generate(config_path):
site_entry_page_content = site_entry_page_content.replace('#'+key,items[key])
for key in version_keys:
site_entry_page_content = site_entry_page_content.replace('#'+key,items[key])
for key in cgi_keys:
site_entry_page_content = site_entry_page_content.replace('#'+key,items[key])
# ENGLISH INDEX PAGE
sitepage_en = open(sitepage_en_path,'w')
......
Markdown is supported
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