Commit 9f8bdd65 authored by stolpmann's avatar stolpmann

Limited support for catalogs:

The syntax <ui:catalog>...</ui:catalog> is supported, and it is
possible to define catalogs in ui files.

The syntax $[m(token)] looks up the token in the current catalog.

The function cat-translate is also available.

ui:select has the "display" attribute.


git-svn-id: https://godirepo.camlcity.org/svn/wdialog/trunk@228 f54c9a64-0731-4a92-b797-30fd5898f27c
parent dbbabc0a
# $Id: Makefile.code,v 1.10 2006-03-08 00:56:45 stolpmann Exp $
# $Id: Makefile.code,v 1.11 2006-03-08 16:05:02 stolpmann Exp $
TOP_DIR=../..
......@@ -7,7 +7,7 @@ OBJECTS = wd_ocamlversion.cmo \
wd_types.cmo wd_serialize.cmo wd_interactor.cmo \
wd_encoding.cmo wd_stdlib.cmo wd_var_functions.cmo \
wd_brexpr_lex.cmo wd_brexpr.cmo wd_brexpr_eval.cmo \
wd_init_expr.cmo wd_table.cmo \
wd_init_expr.cmo wd_table.cmo wd_catalog.cmo \
wd_upload.cmo wd_templrep.cmo wd_application_dtd.cmo \
wd_dialog_decl.cmo wd_application.cmo wd_transform.cmo \
wd_template.cmo wd_dialog.cmo \
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_application.ml,v 3.10 2006-03-08 00:56:45 stolpmann Exp $
(* $Id: wd_application.ml,v 3.11 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -105,6 +105,7 @@ class application init_dtd : application_type =
self # add_var_function "translate" Wd_var_functions.translate;
self # add_var_function "rev_translate" Wd_var_functions.rev_translate; (* legacy *)
self # add_var_function "rev-translate" Wd_var_functions.rev_translate;
self # add_var_function "cat-translate" Wd_var_functions.cat_translate;
self # add_var_function "eq" Wd_var_functions.eq;
self # add_var_function "ne" Wd_var_functions.ne;
......@@ -349,7 +350,19 @@ class application init_dtd : application_type =
* History:
*
* $Log: wd_application.ml,v $
* Revision 3.10 2006-03-08 00:56:45 stolpmann
* Revision 3.11 2006-03-08 16:05:02 stolpmann
* Limited support for catalogs:
*
* The syntax <ui:catalog>...</ui:catalog> is supported, and it is
* possible to define catalogs in ui files.
*
* The syntax $[m(token)] looks up the token in the current catalog.
*
* The function cat-translate is also available.
*
* ui:select has the "display" attribute.
*
* Revision 3.10 2006/03/08 00:56:45 stolpmann
* Addition of Table_value, Matrix_value and Function_value.
*
* New parser for initial expressions. It is now possible to
......
<?xml version="1.0" encoding="ISO8859-1"?>
<!-- $Id: wd_application_2.dtd,v 3.6 2005-06-11 14:24:14 stolpmann Exp $ -->
<!-- $Id: wd_application_2.dtd,v 3.7 2006-03-08 16:05:02 stolpmann Exp $ -->
<!-- This DTD should be referred to by the PUBLIC identifier:
PUBLIC "-//NPC//DTD WDIALOG 2.3//EN"
PUBLIC "-//NPC//DTD WDIALOG 2.4//EN"
Version numbers: have the form major.minor; a change in a major
number means that the versions are incompatible, while a
......@@ -21,6 +21,7 @@
>= 2.1 "-//NPC//DTD WDIALOG 2.1//EN"
>= 3.2 "-//NPC//DTD WDIALOG 2.2//EN"
>= 3.6 "-//NPC//DTD WDIALOG 2.3//EN"
>= 3.7 "-//NPC//DTD WDIALOG 2.4//EN"
-->
<!-- TODO:
......@@ -104,6 +105,15 @@
- New: ui:ifexpr
-->
<!-- Changes between 2.3 and 2.4:
- new: <ui:matrix-value>, <ui:any-value>, <ui:map-value>, <ui:ds-value>
to set the initial values for variables
- new: ui:catalog, ui:msgs to define catalogs
- ui:select has new attribute "display"
-->
<!ENTITY % major-version "2">
......@@ -146,6 +156,7 @@
<!ELEMENT ui:dialog ( ( ui:enumeration |
ui:variable |
ui:context |
ui:catalog |
ui:page )* ) >
<!ATTLIST ui:dialog
......@@ -224,6 +235,20 @@
- ui:select: to solve this problem, use the attribute "base"
-->
<!ELEMENT ui:catalog (ui:msg)* >
<!ATTLIST ui:catalog
uplink NMTOKENS #IMPLIED >
<!ELEMENT ui:msg EMPTY>
<!ATTLIST ui:msg
lang NMTOKEN #REQUIRED
internal NMTOKEN #REQUIRED
external CDATA #IMPLIED >
<!-- VALUE LITERALS:
necessary to specify default values in variable declarations
-->
......@@ -257,6 +282,31 @@
<!ATTLIST ui:alist-item
index CDATA #REQUIRED>
<!ELEMENT ui:matrix-value ((ui:matrix-head)*, (ui:matrix-row)*) >
<!ELEMENT ui:matrix-head EMPTY >
<!ATTLIST ui:matrix-head
column CDATA #REQUIRED >
<!ELEMENT ui:matrix-row (ui:matrix-cell)* >
<!ELEMENT ui:matrix-cell (#PCDATA)* >
<!ATTLIST ui:matrix-cell
column CDATA #REQUIRED >
<!ELEMENT ui:map-value %value-literal; >
<!ATTLIST ui:map-value
mapping CDATA #REQUIRED >
<!ELEMENT ui:any-value (#PCDATA)* >
<!ELEMENT ui:ds-value (#PCDATA)* >
<!ATTLIST ui:ds-value
ds CDATA #REQUIRED >
<!-- ************************************************************ -->
......@@ -512,6 +562,7 @@
base %nametoken; #IMPLIED
baseindex CDATA #IMPLIED
cgi (auto|keep) "auto"
display CDATA #IMPLIED
>
<!-- 'base' is the name of a variable containing the base set.
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_brexpr_eval.ml,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
(* $Id: wd_brexpr_eval.ml,v 3.2 2006-03-08 16:05:02 stolpmann Exp $ *)
open Wd_types
open Wd_brexpr
......@@ -152,6 +152,18 @@ let eval_expr ?(local_bindings = []) (dlg : dialog_type) (e : expr) =
)
args) in
String_value s
| `Expr_apply ( `Expr_fun_name "m", args) ->
let s =
match args with
| [ `Expr_var var_name ] ->
var_name
| _ ->
failwith "Function `m': bad usage"
in
let fn =
try dlg # application # var_function "cat-translate"
with Not_found -> failwith "function cat-translate not found" in
fn dlg [ String_value s ]
| `Expr_apply ( `Expr_fun_name fn_name, args) ->
let args' = List.map (fun arg -> lazy(eval var_bindings arg)) args in
let fn =
......
(*
* <COPYRIGHT>
* Copyright 2006 Gerd Stolpmann
*
* <GPL>
* This file is part of WDialog.
*
* WDialog is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WDialog 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: wd_catalog.ml,v 3.1 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
open Wd_types
open Wd_util
open Pxp_types
type parsed_catalog =
{ pc_uplinks : string list;
pc_messages : (string * string * string) list
}
let parse_catalog ev_list =
let rec parse_messages ev_stream =
match ev_stream with parser
| [< 'E_start_tag("ui:msg",atts,_,_);
'E_end_tag("ui:msg",_);
msgs = parse_messages;
>] ->
let lang =
try List.assoc "lang" atts
with Not_found ->
raise(Formal_user_error("Attribute 'lang' required for <ui:msg>")) in
let internal =
try List.assoc "internal" atts
with Not_found ->
raise(Formal_user_error("Attribute 'internal' required for <ui:msg>")) in
let external_ =
try List.assoc "external" atts
with Not_found -> internal in
(lang, internal, external_) :: msgs
| [< >] ->
[]
in
try
( let ev_stream = Stream.of_list ev_list in
match ev_stream with parser
| [< 'E_start_tag("ui:catalog",atts,_,_);
msgs = parse_messages;
'E_end_tag("ui:catalog",_);
'E_end_of_stream
>] ->
let uplinks =
try split(List.assoc "uplink" atts)
with Not_found -> [] in
{ pc_messages = msgs;
pc_uplinks = uplinks
}
)
with
| Stream.Failure
| Stream.Error "" ->
raise(Formal_user_error "Syntax error in catalog")
| Stream.Error msg ->
raise(Formal_user_error("Syntax error in catalog: " ^ msg))
;;
class catalog ?(uplinks=[]) domain : extensible_message_catalog =
object(self)
val mutable msgs = Wd_dictionary.empty
method domain = domain
method uplinks = uplinks
method lookup ~language int =
try
let langcat = Wd_dictionary.find language msgs in
Wd_dictionary.find int langcat
with
| Not_found ->
raise (Not_found_in_catalog(domain, language, int))
method as_table =
assert false (* TODO *)
method add_message ~language int ext =
let langcat =
try Wd_dictionary.find language msgs
with Not_found -> Wd_dictionary.empty in
let langcat' =
Wd_dictionary.add int ext langcat in
(* CHECK: duplicates? *)
msgs <- Wd_dictionary.add language langcat' msgs
end
(*
* <COPYRIGHT>
* Copyright 2005 Gerd Stolpmann
*
* <GPL>
* This file is part of WDialog.
*
* WDialog is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WDialog 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: wd_catalog.mli,v 3.1 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
(** The default catalog implementation *)
open Wd_types
type parsed_catalog =
{ pc_uplinks : string list;
pc_messages : (string * string * string) list (* lang, int, ext triples *)
}
val parse_catalog : Pxp_types.event list -> parsed_catalog
(** Parses the <catalog>...</catalog> XML element
*)
class catalog : ?uplinks:string list -> string -> extensible_message_catalog
(** [new catalog domain] creates a new catalog identified by [domain].
* If [uplinks] are given, these are entered into the catalog.
*)
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_init_expr.ml,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
(* $Id: wd_init_expr.ml,v 3.2 2006-03-08 16:05:02 stolpmann Exp $ *)
open Wd_types
open Wd_util
......@@ -167,7 +167,7 @@ let parse_init_expr enc ev_list : init_expr =
try
Wd_brexpr.parse_expr_string
~enable_param:false ~enable_brexpr:true enc
(List.assoc "internal" atts)
(List.assoc "external" atts)
with
| Not_found -> int in
(int, ext) :: items
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_transform.ml,v 3.27 2006-03-08 00:56:45 stolpmann Exp $
(* $Id: wd_transform.ml,v 3.28 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -30,6 +30,7 @@ open Wd_types
open Pxp_types
open Pxp_document
open Printf
open Wd_util
module D = Wd_dictionary
......@@ -95,10 +96,6 @@ let only_whitespace s =
let escape_js = Wd_encoding.encode_as_js_string ;;
let split_re = Pcre.regexp "[ \t\r\n]+";;
let split s = Netstring_pcre.split split_re s;;
let list_mapi f l =
let rec loop k l =
match l with
......@@ -1749,6 +1746,41 @@ class uivariable =
;;
class uicatalog =
object (self)
inherit dialog_tree
method scan_dialog app obj =
let node = self # node in
(* PXP bug: liquefy runs too far for pxp-1.1.96. Solved by clone *)
let node = node # orphaned_clone in
let f_events =
Pxp_document.liquefy
~omit_end:false ~omit_positions:true (`Node node) in
let events = Pxp_event.to_list f_events in
let pc = Wd_catalog.parse_catalog events in
let () =
try
let cat = app # catalog obj#name in
if pc.Wd_catalog.pc_uplinks <> [] then
raise(Formal_user_error("ui:catalog: Uplinks can only be defined in the first catalog for the dialog"));
()
with
| Not_found ->
let cat =
new Wd_catalog.catalog
~uplinks:pc.Wd_catalog.pc_uplinks
obj#name in
app # add_extensible_catalog cat in
List.iter
(fun (language,int,ext) ->
app # add_message ~domain:obj#name ~language int ext)
pc.Wd_catalog.pc_messages;
end
;;
class uipage =
object (self)
inherit dialog_tree
......@@ -2565,6 +2597,20 @@ class uiselect =
Value s -> "size=\"" ^ escape_html s ^ "\""
| Implied_value -> ""
| _ -> assert false in
let display_fn =
match self # node # attribute "display" with
| Value s ->
( try dlg#application#var_function s
with
| Not_found ->
raise(Runtime_error("Display function for ui:select not found: " ^ s))
)
| Implied_value ->
(fun dlg args ->
match args with
| [ int; ext ] -> ext
| _ -> assert false)
| _ -> assert false in
(* Interactors: *)
let ia = dlg # interactors in
let pg = vars.current_page in
......@@ -2602,6 +2648,18 @@ class uiselect =
end
in
let base_set =
List.map
(fun (int,ext) ->
( match display_fn dlg [ String_value int; String_value ext ] with
| String_value ext' ->
(int, ext')
| _ ->
raise(Runtime_error("Display function does not return string for ui:select"))
)
)
base_set in
let out = outch # output_string in
out (sprintf
......@@ -2610,7 +2668,9 @@ class uiselect =
(if multiple then "multiple" else "")
size
(self # other_attributes ["name"; "variable"; "index"; "multiple";
"size"; "base"; "baseindex"; "cgi" ]));
"size"; "base"; "baseindex"; "cgi";
"display"
]));
List.iter
(fun (intern,extern) ->
let selected = List.mem_assoc intern v in
......@@ -3341,6 +3401,7 @@ let mk_tag_map () =
"ui:enumeration", (make (new uienumeration));
"ui:enum", (make (new uienum));
"ui:variable", (make (new uivariable));
"ui:catalog", (make (new uicatalog));
(* This block is now parsed in Wd_init_expr: *)
"ui:string-value",(make (new default_node));
......@@ -3883,6 +3944,7 @@ let catalog =
"-//NPC//DTD WDIALOG 2.1//EN", Wd_application_dtd.dtd_2;
"-//NPC//DTD WDIALOG 2.2//EN", Wd_application_dtd.dtd_2;
"-//NPC//DTD WDIALOG 2.3//EN", Wd_application_dtd.dtd_2;
"-//NPC//DTD WDIALOG 2.4//EN", Wd_application_dtd.dtd_2;
];;
let xml_parse_uiapplication charset filename =
......@@ -4118,7 +4180,19 @@ let pxp_spec() = !tag_map;;
* History:
*
* $Log: wd_transform.ml,v $
* Revision 3.27 2006-03-08 00:56:45 stolpmann
* Revision 3.28 2006-03-08 16:05:02 stolpmann
* Limited support for catalogs:
*
* The syntax <ui:catalog>...</ui:catalog> is supported, and it is
* possible to define catalogs in ui files.
*
* The syntax $[m(token)] looks up the token in the current catalog.
*
* The function cat-translate is also available.
*
* ui:select has the "display" attribute.
*
* Revision 3.27 2006/03/08 00:56:45 stolpmann
* Addition of Table_value, Matrix_value and Function_value.
*
* New parser for initial expressions. It is now possible to
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_util.ml,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
(* $Id: wd_util.ml,v 3.2 2006-03-08 16:05:02 stolpmann Exp $ *)
let duplicates name_list =
......@@ -44,3 +44,7 @@ let duplicates name_list =
;;
let split_re = Pcre.regexp "[ \t\r\n]+";;
let split s = Netstring_pcre.split split_re s;;
......@@ -21,8 +21,11 @@
* </>
*)
(* $Id: wd_util.mli,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
(* $Id: wd_util.mli,v 3.2 2006-03-08 16:05:02 stolpmann Exp $ *)
val duplicates : string list -> string list
(** [duplicates names] returns the names occuring several times in [names].
*)
val split : string -> string list
(** Splits a string into whitespace-separated words *)
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_var_functions.ml,v 1.6 2005-06-11 14:24:14 stolpmann Exp $
(* $Id: wd_var_functions.ml,v 1.7 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -701,6 +701,38 @@ let language =
| None ->
String_value ""
)
let cat_translate (dlg : dialog_type) args =
match args with
| [ String_value s ]
| [ String_value s; _ ] -> (* Optional second arg is ignored *)
let language =
match dlg # declaration # language_variable with
| Some v ->
( try
dlg # string_variable v
with
No_such_variable msg ->
failwith ("function `cat-translate': no such variable: `" ^ msg ^ "'")
)
| None -> "" in
let s' =
try
dlg # application # lookup_message
~domain:dlg#name
~language
s
with
| Not_found_in_catalog(_,_,_) ->
(* TODO: Proper logging *)
prerr_endline("Message not found: language=" ^ language ^
" internal=" ^ s);
s in
String_value s'
| _ ->
failwith ("function `cat-translate': bad arguments");
;;
let self_base_url =
......@@ -743,7 +775,19 @@ let create_xanchor_event =
* History:
*
* $Log: wd_var_functions.ml,v $
* Revision 1.6 2005-06-11 14:24:14 stolpmann
* Revision 1.7 2006-03-08 16:05:02 stolpmann
* Limited support for catalogs:
*
* The syntax <ui:catalog>...</ui:catalog> is supported, and it is
* possible to define catalogs in ui files.
*
* The syntax $[m(token)] looks up the token in the current catalog.
*
* The function cat-translate is also available.
*
* ui:select has the "display" attribute.
*
* Revision 1.6 2005/06/11 14:24:14 stolpmann
* Extension of bracket expressions: many new functions.
* Functions in bracket expressions may now lazily evaluate their arguments.
* ui:if and ui:ifvar may refer to any functions defined for bracket
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_var_functions.mli,v 1.6 2005-06-11 14:24:14 stolpmann Exp $
(* $Id: wd_var_functions.mli,v 1.7 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -294,6 +294,9 @@ val page : dialog_type -> var_value list -> var_value
val language : dialog_type -> var_value list -> var_value
(** Returns the current language, or "" if none selected (no arguments) *)
val cat_translate : dialog_type -> var_value list -> var_value
(** Translates the token according to the current language *)
val self_base_url : dialog_type -> var_value list -> var_value
(** Returns the URL pointing to the current script without session state *)
......@@ -311,7 +314,19 @@ val create_xanchor_event : dialog_type -> var_value list -> var_value
* History:
*
* $Log: wd_var_functions.mli,v $
* Revision 1.6 2005-06-11 14:24:14 stolpmann
* Revision 1.7 2006-03-08 16:05:02 stolpmann
* Limited support for catalogs:
*
* The syntax <ui:catalog>...</ui:catalog> is supported, and it is
* possible to define catalogs in ui files.
*
* The syntax $[m(token)] looks up the token in the current catalog.
*
* The function cat-translate is also available.
*
* ui:select has the "display" attribute.
*
* Revision 1.6 2005/06/11 14:24:14 stolpmann
* Extension of bracket expressions: many new functions.
* Functions in bracket expressions may now lazily evaluate their arguments.
* ui:if and ui:ifvar may refer to any functions defined for bracket
......
#! /bin/sh
# (*
exec ocaml "$0" "$@"
*) use "topfind";;
#directory "../../../src/wdialog";;
#require "pxp";;
#require "netstring";;
#require "cgi";;
#require "pcre";;
#load "wdialog.cma";;
#use "index.ml";;
(* $Id: index.ml,v 1.1 2006-03-08 16:05:02 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
open Wd_dialog
open Wd_run_cgi
open Wd_types
class obj1 universe name env =
object (self)
inherit dialog universe name env
method prepare_page() =
()
method handle() =
match self # event with
No_event -> ()
| Button "count" ->
self # set_variable
"v1"
(String_value
(string_of_int
(int_of_string (self # string_variable "v1") + 1)))
| _ -> ()
end
;;
(*
Unix.close Unix.stdin;
ignore(Unix.openfile "/tmp/in" [ Unix.O_RDONLY ] 0 );
*)
run
~charset:`Enc_utf8
~reg:(fun universe ->
universe # register "obj1" (new obj1)
)
()
;;
(* ======================================================================
* History:
*
* $Log: index.ml,v $
* Revision 1.1 2006-03-08 16:05:02 stolpmann
* Limited support for catalogs:
*
* The syntax <ui:catalog>...</ui:catalog> is supported, and it is
* possible to define catalogs in ui files.
*
* The syntax $[m(token)] looks up the token in the current catalog.
*
* The function cat-translate is also available.
*
* ui:select has the "display" attribute.
*