(*
* <COPYRIGHT>
* Copyright 2002 Joachim Schrod Network and Publication Consultance GmbH, 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_types.ml,v 3.9 2005-06-11 14:24:14 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
type (+'a) dict = 'a Wd_dictionary.t
type event =
Button of string
| Image_button of (string * int * int)
| Indexed_button of (string * string)
| Indexed_image_button of (string * string * int * int)
| No_event
| Popup_request of string
(* event:
* Button n: The button with name n has been pressed
* (<ui:button name="n" ...>)
* Image_button (n,x,y): The image button with name n has been pressed
* at the coordinates (x,y). (<ui:imagebutton name="n" ...>)
* Indexed_button (n,i): The button with name n and index i has been pressed
* (<ui:button name="n" index="i" ...>)
* Indexed_image_button (n,i,x,y): The image button with name n and index i
* has been pressed at the coordinates (x,y).
* (<ui:imagebutton name="n" index="i" ...)
* No_event: This value indicates that there was no event (or no
* recognized event)
* Popup_request s: A server popup window has just popped up, and the contents
* for the window have been requested. The argument is the second argument
* of the "open" function.
*)
type interactors =
{ mutable ui_buttons : string option Wd_interactor.t;
mutable ui_imagebuttons : string option Wd_interactor.t;
mutable ui_anchors : string option Wd_interactor.t;
mutable ui_indexed_buttons : string option Wd_interactor.t;
mutable ui_indexed_imagebuttons :string option Wd_interactor.t;
mutable ui_indexed_anchors : string option Wd_interactor.t;
mutable ui_vars : unit Wd_interactor.t;
mutable ui_enumvars : (string * string option * string) list;
mutable ui_uploads : unit Wd_interactor.t;
}
(* Values of this type store the mapping from the (name,index) pairs
* of interactor elements to the real CGI parameter names together
* with an auxiliary component.
*
* What's the problem? Interactor elements like ui:a allow the programmer
* to identify these either by a single name (which is an arbitrary
* string) or by a pair of a "name" and an "index" (i.e. two arbitrary
* strings). In contrast to this, CGI parameter names are much more
* restricted. First, these names are only strings; there is no
* built-in representation for pairs of strings. Second, you cannot
* use arbitrary characters within these names because of limitations
* of the transport protocol and because of bugs in browsers. (As
* the "multipart/form-data" representation used in the transport
* protocol bases on the RFC 822 mail format, it is neither possible to
* pass 8 bit values, nor to pass control characters. A known bug
* in Netscape browsers is that the double-quote and backslash characters
* are incorrectly represented.)
*
* The solution is to generate the CGI parameter names using only
* unproblematic characters, and to keep the mapping of the original
* string or string * string to the generated CGI name. This record
* stores the mappings for the various namespaces. The mapping is
* encapsulated in the Wd_interactor module, and the type
* 'a Wd_interactor.t (where 'a is arbitrary) represents such a mapping. The
* CGI names are simply enumerated, and the Wd_interactor.t value stores only
* the numbers (IDs) of the CGI parameters. The complete CGI name is formed
* using a prefix and the number stored in Wd_interactor.t. For example,
* ui:buttons without index have the prefix "button_"; and if the
* ui_button record component contains entries for the IDs 0, 1, and 2,
* the complete CGI names are "button_0", "button_1", and "button_2",
* respectively.
*
* The type parameter 'a of 'a Wd_interactor.t is the type of the
* auxiliary component stored with every entry. See below for the
* meanings in every case.
*
* The Wd_interactor.t structure always maps from pairs string * string to
* numerical IDs. Because of this, there are usually two mappings, one
* for the (name,index) PAIRS, and one for the simple names. The record
* components listed below that have a name with "indexed" are responsible
* for the pairs, the corresponding component without "indexed" stores
* the mapping for the simple case.
*
* The simple case is represented as Wd_interactor.t by using always the
* empty string "" as index.
*
* THE COMPONENTS ARE:
*
* (A) BUTTON-TYPE INTERACTORS:
*
* ui_buttons: Enumerates the ui:button interactors
* that have only a name, not an index.
* CGI prefix: "button_".
* ui_indexed_buttons: Enumerates the ui:button interactors
* that have both a name and an index.
* CGI prefix: "xbutton_".
* ui_imagebuttons: Enumerates the ui:imagebutton interactors
* that have only a name, not an index.
* CGI prefix: "imagebutton_".
* ui_indexed_imagebuttons: Enumerates the ui:imagebutton interactors
* that have both a name and an index.
* CGI prefix: "ximagebutton_".
* ui_anchors: Enumerates the ui:a interactors
* that have only a name, not an index.
* CGI prefix: "anchor_".
* ui_indexed_anchors: Enumerates the ui:a interactors
* that have both a name and an index.
* CGI prefix: "xanchor_".
*
* These components use the auxiliary component to store the "goto"
* attribute of the interactor, if present.
*
* (B) BOX-LIKE INTERACTORS:
*
* ui_vars: Enumerates the interactors that are bound
* to an object variable (i.e. they have a
* "variable" attribute, like ui:text).
* As variables allow either only non-indexed
* names or only indexed names, this component
* contains both interactors identified by a simple
* string name and interactors identified by
* (name,index) pairs; it is not possible that
* there are conflicts between the two naming
* methods.
* CGI prefix: "var_".
* This component does not have an auxiliary
* component.
*
* ui_enumvars: This list enumerates the simple names
* (name, None, pg) or pairs (name, Some index, pg)
* that occur in checkbox, radiobutton and select
* list interactors. pg is the name of the page
* where the interactor occurs (knowing the page
* is necessary for popup dialogues).
*
* ui_uploads: Enumerates the ui:file interactors. These
* may only have a simple name.
* CGI prefix: "upload_".
* This component does not have an auxiliary
* component.
*)
type 'dlg poly_var_value =
String_value of string
| Enum_value of string list
| Dialog_value of 'dlg option
| Dyn_enum_value of (string * string) list
| Alist_value of (string * 'dlg poly_var_value) list
(* (poly_)var_value is the type of instance variables of uiobjects. There are
* six possibilities for var_values:
* - String_value s: The instance variable contains the string s
* - Enum_value [x1;x2;...]: The instance variable contains an enumerator
* value with the internal items x1, x2, etc. (As variables are declared
* it is known which items are possible, and whether there are corresponding
* external values.)
* - Dialog_value None: The instance variable does not contain a dialog.
* - Dialog_value (Some obj): The variable contains the dialog obj.
* - Dyn_enum_value [(x1,y1);(x2,y2);...]: The variable contains the enumerator
* with internal items x1, x2,... and the corresponding external values
* y1, y2, ...
* - Alist_value [(i1,v1); (i2,v2); ...]: The variable contains the associative
* list where the index i1 is mapped to the value v1, i2 is mapped to v2 etc.
*
* See also [var_value] below.
*)
type enum_decl =
{ enum_name : string;
mutable (* XXX *) enum_definition : (string * string) list;
}
type var_type_name =
String_type
| Enum_type of enum_decl
| Dialog_type
| Dyn_enum_type
type 'dlg poly_var_decl =
{ var_name : string;
var_type : var_type_name;
var_default : 'dlg poly_var_value option;
var_temporary : bool;
var_associative : bool;
var_protected : bool;
}
type response_header =
{ mutable rh_status : Nethttp.http_status;
mutable rh_content_type : string;
mutable rh_cache : Netcgi_common.cache_control;
mutable rh_filename : string option;
mutable rh_language : string option;
mutable rh_script_type : string option;
mutable rh_style_type : string option;
mutable rh_set_cookie : Nethttp.cookie list;
mutable rh_fields : (string * string list) list;
}
type debug_mode_style =
[ `Fully_encoded
| `Partially_encoded
]
type environment =
{ (* Overall way of operation: *)
debug_mode : bool;
debug_mode_style : debug_mode_style;
prototype_mode : bool;
server_popup_mode : bool;
(* Web variables *)
self_url : string;
response_header : response_header;
cgi : Netcgi.cgi_activation;
}
type trans_vars =
{ mutable within_popup : bool;
mutable current_page : string;
mutable popup_env_initialized : bool;
mutable condition_code : bool;
(* last result of <ui:if>, <ui:ifvar>, <ui:iflang> *)
mutable serialize_session : unit -> string;
}
(* Some local variables that are used in the recursive transformation.
* By putting them all into a record it is simpler to pass them to the
* subsequent transformers.
*)
type ('universe,'dialog,'environment) poly_ds_buf =
('universe,'dialog,'environment) Wd_serialize_types.poly_ds_buf =
{ ds_str : string; (* String to deserialize *)
mutable ds_pos : int; (* Current position *)
ds_end : int; (* End position *)
ds_universe : 'universe;
ds_environment : 'environment;
ds_dialogs : (int, 'dialog) Hashtbl.t;
(* maps dialog IDs to dialogs *)
}
class type dialog_decl_type =
object ('self)
(* PUBLIC *)
method name : string
method enumeration : string -> enum_decl
method variable_names : string list
method variable : string -> dialog_type poly_var_decl
method page_names : string list
method page : string -> syntax_tree_type
method page_is_declared_as_popup : string -> bool
method start_page : string
method default_context : syntax_tree_type dict
method language_variable : string option
(* RESTRICTED *)
method set_name : string -> unit
method set_start_page : string -> unit
method add_enumeration : enum_decl -> unit
method add_variable : dialog_type poly_var_decl -> unit
method add_page : string -> syntax_tree_type -> unit
method set_default_context : syntax_tree_type dict -> unit
method set_language_variable : string -> unit
end
and virtual dialog_type =
object ('self)
method copy : dialog_type
(* return a copy of the dialog *)
method name : string
(* return the name of the dialog *)
method page_name : string
(* return the name of the current page *)
method page_names : string list
(* returns the names of all defined pages of this dialog *)
method variable : string -> dialog_type poly_var_value
(* variable n: Get the variable with name n, or raise No_such_variable *)
method variable_decl : string -> dialog_type poly_var_decl
method string_variable : string -> string
(* string_variable n: Get the contents of the string variable n.
* Raise No_such_variable if the variable does not exist. Runtime_error
* if the variable is not a string.
*)
method enum_variable : string -> string list
(* enum_variable n: Get the contents of the enumerator variable n.
* The enumerator must have been declared. The returned list contains
* only the external values.
* Raise No_such_variable if the variable does not exist. Runtime_error
* if the variable is not a declared enumerator.
*)
method dyn_enum_variable : string -> (string * string) list
(* dyn_enum_variable n: Get the contents of the enumerator variable n.
* The enumerator may be dynamic or may be declared. The returned
* list contains both the internal and the external values.
* Raise No_such_variable if the variable does not exist. Runtime_error
* if the variable is not an enumerator.
*)
method dialog_variable : string -> dialog_type option
(* dialog_variable n: Get the contents of the dialog variable n.
* Raise No_such_variable if the variable does not exist.
* Runtime_error if the variable is not a dialog.
*)
method alist_variable : string -> (string * dialog_type poly_var_value) list
(* alist_variable n: Get the contents of the associative variable n.
* Raise No_such_variable if the variable does not exist.
* Runtime_error if the variable is not an alist.
*)
method lookup_string_variable : string -> string -> string
method lookup_enum_variable : string -> string -> string list
method lookup_dyn_enum_variable : string -> string -> (string * string) list
method lookup_dialog_variable : string -> string -> dialog_type option
(* lookup_*_variable n x: Get the contents of the associative
* variable n at index x.
* No_such_variable if the variable does not exist.
* Not_found if the variable is undefined at x.
* Runtime_error if the variable has the wrong type.
*)
method set_variable : string -> dialog_type poly_var_value -> unit
(* set_variable n v: Sets the variable n to the value v. The value v
* must be compatible to the declared type of the variable.
* No_such_variable if the variable does not exist.
* Runtime_error if the variable is not compatible.
*)
method unset_variable : string -> unit
(* unset_variable n: Sets the variable n to the declared default
* value.
* If the default is not declared, the following default values apply:
* For strings: the default is the empty string.
* For enumerators: the default is the empty list.
* For dialogs: the default is that the value does not exist.
*)
method lookup_uploaded_file : string -> Netcgi.cgi_argument option
(* lookup_uploaded_file name:
* Checks whether the file upload box 'name' was used. If so,
* 'Some arg', where 'arg' is the transporting CGI argument is returned.
* If the box was not used, but the box exists, None is returned.
* Raises a Runtime_error if the named box does not exist.
*
* IMPORTANT NOTE: Uploaded files are not persistent. This means that
* they are only existent in the 'handle' phase, not during initialization
* nor the 'prepare_page' phase. You get a failure
* "Upload.get: not initialized" if you try to access uploaded files
* in the wrong moment.
*)
method dump : Format.formatter -> unit
(* dump f: output a textual description of the current state into
* formatter f.
*)
method next_page : string
(* Returns the name of the designated next page. *)
method set_next_page : string -> unit
(* Sets the name of the designated next page *)
method event : event
(* returns the event that just has happened *)
method is_server_popup_request : bool
(* Returns whether someone invoked set_server_popup_request before.
* This is usually done if an dialog is restored for a server-driven
* popup window (tag ui:server-popup).
*)
method serialize : (dialog_type,unit) Hashtbl.t -> Buffer.t -> unit
(* Returns the state of this dialog as string *)
method unserialize : (universe_type,dialog_type,environment) poly_ds_buf -> unit
(* Sets the state of this dialog from the string which must be a
* previously serialized dialog.
*)
method enter_session_scope : session_type -> unit
method leave_session_scope : unit -> unit
method session : session_type
method environment : environment
method declaration : dialog_decl_type
method application : application_type
method universe : universe_type
(*********************************************************************)
(* The following methods needs to be defined in subclasses: *)
method virtual prepare_page : unit -> unit
(* This method is invoked just before a new output page is generated.
*
* PRECONDITIONS:
* The method 'page_name' returns the name of this page.
* The method 'event' still returns the action last happened, but
* the name of the page where this action happened is lost. It may
* be interesting whether the last event was 'No_event' because this
* indicates that the page is initially entered.
*
* This method should set any variables which are necessary to
* generate the new page (mostly variable containing HTML fragments).
* Furthermore, any state that needs to be saved should be put into
* variables, too.
*)
method virtual handle : unit -> unit
(* This method is invoked just after the user triggered an event (e.g.
* pressed a button).
*
* PRECONDITIONS:
* The method 'page_name' returns the name of the page that was visible
* while the event was triggered.
* The method 'event' returns the description of the event.
*
* POSTCONDITIONS:
* The method may set the next page to display by invoking
* 'set_next_page'; if it does not then the default will be used.
* The default is either specified by the XML element describing
* the interactor that triggered the event, or the default is
* otherwise this page again.
*
* This method should modify the variables according to the event
* that happened, and optionally set the next page to display.
*
* There is also an alternate way to go to another page: raising
* the exception Change_page.
*
* By raising the exception Change_dialog this method may force to go to
* another dialog.
*)
(*********************************************************************)
(* Internal methods *)
method set_event : event -> unit
(* set_event e: Sets the current event to e. *)
method set_server_popup_request : unit -> unit
(* Sets that this dialog is restored for a server popup window *)
method init : string -> unit
(* MOSTLY INTERNAL USE:
* init p: re-initializes the dialog in order to go to page p.
*)
method interactors : interactors
(* ONLY INTERNAL USE *)
(* -- class [dialog] also has a private method:
* method private put_tree : string -> Template.tree -> unit
*)
end
and application_type =
object ('self)
(* PUBLIC *)
method start_dialog_name : string
method dialog_names : string list
method dialog_declaration : string -> dialog_decl_type
method template_names : string list
method template : string -> template_type
method study : unit -> unit
method output_encoding : string -> (string -> string)
method var_function :
string ->
( dialog_type ->
dialog_type poly_var_value list ->
dialog_type poly_var_value)
method lazy_var_function :
string ->
( dialog_type ->
dialog_type poly_var_value Lazy.t list ->
dialog_type poly_var_value)
method dtd : Pxp_dtd.dtd
method charset : Pxp_types.rep_encoding
method debug_mode : bool
method debug_mode_style : debug_mode_style
method prototype_mode : bool
method onstartup_call_handle : bool
method add_var_function :
string ->
( dialog_type ->
dialog_type poly_var_value list ->
dialog_type poly_var_value) ->
unit
method add_lazy_var_function :
string ->
( dialog_type ->
dialog_type poly_var_value Lazy.t list ->
dialog_type poly_var_value) ->
unit
(* RESTRICTED *)
method set_start_dialog_name : string -> unit
method add_dialog_declaration : dialog_decl_type -> unit
method add_template : ?lib:bool -> string -> template_type -> unit
method add_output_encoding : string -> (string -> string) -> unit
method set_debug_mode : bool -> debug_mode_style -> unit
method set_prototype_mode : bool -> unit
method set_onstartup_call_handle : bool -> unit
end
and template_type =
object
method study : application_type -> unit
method instantiate :
?context: syntax_tree_type dict ->
?vars: trans_vars ->
?params: syntax_tree_type dict ->
dialog_type ->
syntax_tree_type
(* Note: Raises Instantiation_error if something goes wrong *)
end
and syntax_tree_type =
object ('self)
(* PXP *)
inherit [syntax_tree_type Pxp_document.node] Pxp_document.extension
(* TEMPLATES *)
inherit template_type
(* SCANNERS *)
(* The side-effect of the scanners is to put the result into the passed
* argument.
*)
method scan_application : application_type -> unit
method scan_dialog : application_type -> dialog_decl_type -> unit
method scan_enumeration : enum_decl -> unit
(* This one is functional: *)
method scan_literal : unit -> dialog_type poly_var_value
(* ACCESS *)
method escaped_data : string
(* OUTPUT *)
method to_html :
?context: syntax_tree_type dict ->
?vars: trans_vars ->
dialog_type ->
Netchannels.out_obj_channel ->
unit
(* TODO: to_xhtml *)
method to_text :
?context: syntax_tree_type dict ->
?vars: trans_vars ->
dialog_type ->
Netchannels.out_obj_channel ->
unit
end
and universe_type =
object ('self)
method application : application_type
method register : string -> (universe_type -> string -> environment -> dialog_type) -> unit
method create : environment -> string -> dialog_type
end
and session_manager_type =
object
method create : dialog_type -> session_type
method unserialize : universe_type -> environment -> string -> session_type
end
and session_type =
object
method session_id : string
method dialog_name : string
method dialog : dialog_type
(* Returns the dialog *)
method commit_changes : unit -> unit
(* Causes that [serialize] returns the current state of the dialog *)
method serialize : string
(* Returns the state of the dialog at the time of the last [commit_change]
* or the state of the initial dialog
*)
method change_dialog : dialog_type -> unit
(* Continue with a new dialog. The methods [dialog_name] and [dialog] will
* immediately reflect the change. However, you have to call [commit_changes]
* to make [serialize] return the state of the new dialog.
*)
end
type var_value = dialog_type poly_var_value
type var_decl = dialog_type poly_var_decl
type ds_buf = (universe_type,dialog_type,environment) poly_ds_buf
exception Change_dialog of dialog_type
(* The implementation of the 'handle' method of a dialog may raise
* Change_dialog to drop the current dialog and continue with another
* dialog.
*)
exception Change_page of string
(* The implementation of the 'handle' method of a dialog may raise
* Change_page to set the next page to display for the current dialog.
*)
exception Formal_user_error of string
exception Runtime_error of string
exception No_such_variable of string
exception Instantiation_error of string
(* An error generated by the [instantiate] method. The caller should
* catch this exception and report the error from its own view
*)
let revision_types = "$Revision: 3.9 $" ;;
(* Intentionally the CVS revision string! *)
(* ======================================================================
* History:
*
* $Log: wd_types.ml,v $
* Revision 3.9 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
* expressions.
* New: ui:ifexpr
* Parsing of bracket expressions is now done with ulex. Private interfaces
* of PXP are no longer used for this purpose.
* Serialization has been rewritten, and it is now safe.
* Fix: In ui:context there may now be macro references at any location.
* Also documented all these changes.
*
* Revision 3.8 2004/12/12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 3.7 2003/02/16 23:48:15 stolpmann
* Improved wd-debug-mode: there are now two styles
*
* Revision 3.6 2003/01/04 21:55:25 stolpmann
* new record response_header
*
* Revision 3.5 2002/11/09 11:41:19 stolpmann
* Fix: ui:select accepts dot notation. A new method
* variable_decl needs to be defined for dialogs. This method
* returns the var_decl record and interprets the dot notation.
*
* Revision 3.4 2002/10/20 19:39:17 stolpmann
* New feature: The brackets $[...] can contain expressions,
* not only variables
*
* Revision 3.3 2002/04/10 20:04:05 stolpmann
* The CVS revision number is exported.
*
* Revision 3.2 2002/02/14 16:15:21 stolpmann
* Added copyright notice.
*
* Revision 3.1 2002/02/12 20:29:21 stolpmann
* Initial release at sourceforge.
*
* Revision 2.9 2002/02/11 11:14:21 gerd
* Fix: It is now possible to change the dialog of sessions (required
* for the Change_dialog exception)
*
* Revision 2.8 2002/02/07 18:49:59 gerd
* Standard library
*
* Revision 2.7 2002/02/05 18:43:04 gerd
* New: var_protected
* New: page_is_declared_as_popup
* New: debug_mode, prototype_mode, onstartup_call_handle
* New: Session management
*
* Revision 2.6 2002/01/31 23:06:40 gerd
* Revised conditional expansion (ui:if, ui:ifvar, ui:iflang,
* ui:cond).
* Added some support for internationalization (xml:lang).
*
* Revision 2.5 2002/01/30 15:16:10 gerd
* New: charset
* New argument application_type for [study]
* New argument application_type for [scan_dialog]
*
* Revision 2.4 2002/01/28 02:12:54 gerd
* Added support for output encodings.
*
* Revision 2.3 2002/01/26 22:38:27 gerd
* Changed the type for passing parameters to templates. It is
* now syntax_tree dict instead of a simple list. Furthermore, the
* method [instantiate] no longer returns the new context. The new element
* ui:context creates the new contexts now.
*
* Revision 2.2 2002/01/24 23:35:18 gerd
* New exception: [Instantiation_error]
*
* Revision 2.1 2002/01/21 14:29:04 gerd
* Initial revision.
*
*
*)
