swish/commit

Copied upstream files

diff --git a/examples/htmlcell.swinb b/examples/htmlcell.swinb
index 3db8e5d..77178d4 100644
--- a/examples/htmlcell.swinb
+++ b/examples/htmlcell.swinb
@@ -27,6 +27,11 @@
     binding Prolog variables in the query to specified values.
     </dd><dt>.swish(options)</dt><dd>Wrapper around <code>new Pengine()</code> that fetches the sources
     using the same algorithm as a query cell and sets the <code>application</code> to <code>swish</code>.
+    </dd><dt>.submit(form, options)</dt><dd>Submit a (Bootstrap) form to a predicate.  This provides a
+    wrapper around <code>.swish</code> that collects the content of the indicated <code>form</code> (a
+    jQuery selector), calls <code>options.predicate</code> with a single argument that is a dict that
+    contains the fields of the form.  On success, <code>options.onsuccess</code> is called.  If an
+    error occurs, this is displayed.
   </dd></dl>
 </div>
 
diff --git a/lib/swish/form.pl b/lib/swish/form.pl
index 3ca44e7..b93e755 100644
--- a/lib/swish/form.pl
+++ b/lib/swish/form.pl
@@ -27,17 +27,247 @@
     the GNU General Public License.
 */
 
-:- module(swish_form, []).
-:- use_module(library(http/http_dispatch)).
-:- use_module(library(http/http_server_files)).
+:- module(swish_form,
+	  [ validate_form/2,		% +Dict, +Fields
+	    validate_field/4,		% +Dict, +Field, -Value, +Options
+	    input_error/2		% +Field, +Error
+	  ]).
 
-/** <module> Show forms in SWISH
+/** <module> Form handling utilities
 
-This module serves forms for SWISH.
+This module simplifies handling input from forms in the SWISH interface.
+The  values  from  a  form  can   be    turned   into  an  object  using
+`notebook.formData(form)`.  The  returned  dict  may   be  passed  to  a
+predicate inside SWISH.
 */
 
-:- http_handler(swish(form), serve_files_in_directory(swish_form),
-		[id(form),prefix]).
 
-user:file_search_path(swish_form, swish(web/form)).
+%%	validate_form(+Dict, +Fields) is det.
+%
+%	Run validate_field/4 on all  specified   fields,  combining  the
+%	error message.  Fields is a list of terms of the form
+%
+%	    field(Name, Value, Options)
 
+validate_form(Dict, Fields) :-
+	validate_form(Fields, Dict, Errors),
+	(   Errors == []
+	->  true
+	;   throw(error(form_error(Errors), _))
+	).
+
+validate_form([], _, []).
+validate_form([field(Field, Value, Options)|T], Dict, Errors) :-
+	catch(validate_field(Dict, Field, Value, Options),
+	      error(input_error(Field, Error),_),
+	      true),
+	(   var(Error)
+	->  Errors = Errors1
+	;   Errors = [input_error(Field, Error)|Errors1]
+	),
+	validate_form(T, Dict, Errors1).
+
+
+%%	validate_field(+Dict, +Field, -Value, +Options) is det.
+%
+%	True when Value is a valid value   for Field from Dict according
+%	to Options. Options is  a  list   of  processing  steps taken to
+%	convert and validate the value.  Defined steps are:
+%
+%	  - alnum
+%	  All characters must be alphanumeric
+%	  - alnum_and_spaces
+%	  All characters must be alphanumeric or spaces
+%	  - atom
+%	  Convert input to an atom
+%	  - default(Term)
+%	  Use Term as value if no value appears in the input.
+%	  - downcase
+%	  Convert input to lower case
+%	  - email
+%	  Input must be a value E-mail address.
+%	  - float
+%	  Value is converted to a floating point number.
+%	  - integer
+%	  Value is converted to an integer.
+%	  - length > N
+%	  The value must have at more than N characters
+%	  - length >= N
+%	  The value must have at least N characters
+%	  - length =< N
+%	  The value must have at most N characters
+%	  - length < N
+%	  The value must have at less than N characters
+%	  - number
+%	  Value is converted to a number (integer or float)
+%	  - oneof(List)
+%	  Input must be a member of List.
+%	  - password
+%	  Input must be a reasonable password.
+%	  - strip
+%	  Strip leading and trailing white space and normalize
+%	  internal white space to a single space.
+
+
+validate_field(Dict, Field, Value, Options) :-
+	(   Value0 = Dict.get(Field)
+	->  validate_value(Options, Value0, Value, Field)
+	;   memberchk(default(Value), Options)
+	->  true
+	;   input_error(Field, required)
+	).
+
+validate_value([], Value, Value, _).
+validate_value([H|T], Value0, Value, Field) :-
+	(   validate_step(H, Value0, Value1)
+	->  true
+	;   validate_failed(H, Value0, Field)
+	),
+	validate_value(T, Value1, Value, Field).
+
+%%	validate_step(+Step, +Value0, -Value) is semidet.
+
+validate_step(alnum, Value, Value) :-
+	forall(sub_atom(Value, _, 1, _, Char),
+	       char_type(Char, alnum)).
+validate_step(length >= N, Value, Value) :-
+	string_length(Value, Len),
+	Len >= N.
+validate_step(length > N, Value, Value) :-
+	string_length(Value, Len),
+	Len > N.
+validate_step(length < N, Value, Value) :-
+	string_length(Value, Len),
+	Len < N.
+validate_step(length =< N, Value, Value) :-
+	string_length(Value, Len),
+	Len =< N.
+validate_step(strip, Value0, Value) :-
+	normalize_space(string(Value), Value0).
+validate_step(alnum_and_spaces, Value, Value) :-
+	forall(sub_atom(Value, _, 1, _, Char),
+	       alnum_or_space(Char)).
+validate_step(email, Value, Value) :-
+	string_codes(Value, Codes),
+	phrase(email, Codes).
+validate_step(downcase, Value0, Value) :-
+	string_lower(Value0, Value).
+validate_step(atom, Value0, Value) :-
+	atom_string(Value, Value0).
+validate_step(number, Value0, Value) :-
+	number_string(Value, Value0).
+validate_step(integer, Value0, Value) :-
+	number_string(Value, Value0),
+	integer(Value).
+validate_step(float, Value0, Value) :-
+	number_string(Value1, Value0),
+	Value is float(Value1).
+validate_step(oneof(List), Value, Value) :-
+	memberchk(Value, List).
+validate_step(password, Value, Value) :-
+	string_length(Value, Len),
+	Len >= 6.
+validate_step(default(_), Value, Value).
+
+alnum_or_space(' ') :- !.
+alnum_or_space(Char) :-
+	char_type(Char, alnum).
+
+email --> user_name, "@", domain_name.
+user_name --> user_name_char, user_name_chars.
+domain_name --> domain_name_segment, ".", domain_name_segments.
+
+user_name_chars --> user_name_char, !, user_name_chars.
+user_name_chars --> "".
+
+user_name_char -->
+	[C],
+	{ between(1, 127, C),
+	  (   code_type(C, alnum)
+	  ->  true
+	  ;   name_special(C)
+	  )
+	}.
+
+name_special(0'.).
+name_special(0'-).
+
+domain_name_segment --> domain_name_char, domain_name_chars.
+domain_name_segments -->
+	domain_name_segment,
+	(   "."
+	->  domain_name_segments
+	;   ""
+	).
+
+domain_name_chars --> domain_name_char, !, domain_name_chars.
+domain_name_chars --> "".
+
+domain_name_char -->
+	[C],
+	{ between(1, 127, C),
+	  (   code_type(C, alnum)
+	  ->  true
+	  ;   domain_special(C)
+	  )
+	}.
+
+domain_special(0'-).
+domain_special(0'_).
+
+validate_failed(H, _Value0, Field) :-
+	input_error(Field, H).
+
+input_error(Field, Error) :-
+	throw(error(input_error(Field, Error), _)).
+
+
+		 /*******************************
+		 *	     MESSAGES		*
+		 *******************************/
+
+:- multifile prolog:error_message//1.
+
+prolog:error_message(input_error(Field, Expected)) -->
+	[ '~w: '-[Field] ],
+	expected(Expected).
+prolog:error_message(form_error(Errors)) -->
+	field_errors(Errors).
+
+field_errors([]) --> [].
+field_errors([H|T]) -->
+	prolog:error_message(H),
+	(   {T==[]}
+	->  []
+	;   [nl],
+	    field_errors(T)
+	).
+
+
+expected(oneof(List)) --> !,
+	[ 'One of '-[] ],
+	oneof(List).
+expected(required) --> !,
+	[ 'This field is required'-[] ].
+expected(length > N) --> !,
+	[ 'Needs at more than ~d characters'-[N] ].
+expected(length >= N) --> !,
+	[ 'Needs at least ~d characters'-[N] ].
+expected(length =< N) --> !,
+	[ 'Needs at most ~d characters'-[N] ].
+expected(length < N) --> !,
+	[ 'Needs less than ~d characters'-[N] ].
+expected(matching_password) -->
+	[ 'The password does not match'-[] ].
+expected(new_user) -->
+	[ 'A user with this name already exists'-[] ].
+expected(Expected) --> !,
+	[ 'This field must hold a valid ~w'-[Expected] ].
+
+oneof([One]) --> !,
+	[ '~w'-[One] ].
+oneof([One, Two]) --> !,
+	[ '~w or ~w'-[One, Two] ].
+oneof([H|T]) -->
+	[ '~w, '-[H] ],
+	oneof(T).
diff --git a/lib/swish/page.pl b/lib/swish/page.pl
index 702f355..6c42c75 100644
--- a/lib/swish/page.pl
+++ b/lib/swish/page.pl
@@ -60,7 +60,6 @@
 
 :- use_module(config).
 :- use_module(help).
-:- use_module(form).
 :- use_module(search).
 
 /** <module> Provide the SWISH application as Prolog HTML component
@@ -104,7 +103,7 @@ swish_reply(Options, Request) :-
 
 swish_reply2(Options, Request) :-
 	option(method(Method), Request),
-	Method \== get, !,
+	Method \== get, Method \== head, !,
 	swish_rest_reply(Method, Request, Options).
 swish_reply2(_, Request) :-
 	serve_resource(Request), !.
@@ -251,7 +250,7 @@ source_metadata(Path, _Code, modified_since_loaded, true) :-
 	ModifiedWhenLoaded \== Modified.
 source_metadata(Path, _Code, module, Module) :-
 	file_name_extension(_, Ext, Path),
-	prolog_file_type(Ext, prolog),
+	user:prolog_file_type(Ext, prolog),
 	xref_public_list(Path, _, [module(Module)]).
 
 confirm_access(Path, Options) :-
diff --git a/lib/swish/render.pl b/lib/swish/render.pl
index 2fa89d0..e4e1679 100644
--- a/lib/swish/render.pl
+++ b/lib/swish/render.pl
@@ -90,7 +90,7 @@ user:file_search_path(render, swish('lib/render')).
 %
 %	@see use_rendering/2.
 
-:- multifile user:term_expansion/2.
+:- multifile system:term_expansion/2.
 
 use_rendering(Rendering) :-
 	use_rendering(Rendering, []).
@@ -111,9 +111,9 @@ use_rendering(Rendering, Options) :-
 	retractall(Into:'swish renderer'(Renderer, _)),
 	assertz(Into:'swish renderer'(Renderer, Options)).
 
-user:term_expansion((:- use_rendering(Renderer)), Expanded) :-
+system:term_expansion((:- use_rendering(Renderer)), Expanded) :-
 	expand_rendering(Renderer, [], Expanded).
-user:term_expansion((:- use_rendering(Renderer, Options)), Expanded) :-
+system:term_expansion((:- use_rendering(Renderer, Options)), Expanded) :-
 	expand_rendering(Renderer, Options, Expanded).
 
 expand_rendering(Module:Renderer, Options,
@@ -224,6 +224,6 @@ register_renderer(Name, Comment) :-
 	throw(error(context_error(nodirective, register_renderer(Name, Comment)),
 		    _)).
 
-user:term_expansion((:- register_renderer(Name, Comment)),
+system:term_expansion((:- register_renderer(Name, Comment)),
 		    swish_render:renderer(Name, Module, Comment)) :-
 	prolog_load_context(module, Module).
diff --git a/lib/swish/template_hint.pl b/lib/swish/template_hint.pl
index eba917e..0272c88 100644
--- a/lib/swish/template_hint.pl
+++ b/lib/swish/template_hint.pl
@@ -441,8 +441,8 @@ file_type(Path, _, Type) :-
 	Type = directory.
 file_type(_, Name, Type) :-
 	file_name_extension(_, Ext, Name),
-	prolog_file_type(Ext, prolog),
-	\+ prolog_file_type(Ext, qlf),
+	user:prolog_file_type(Ext, prolog),
+	\+ user:prolog_file_type(Ext, qlf),
 	Type = prolog.
 
 %%	library_template_from(+From:list, -Template) is det.