Chris@0: /*  This file is part of ClioPatria.
Chris@0: 
Chris@0:     Author:	Jan Wielemaker <wielemak@science.uva.nl>
Chris@0:     HTTP:	http://e-culture.multimedian.nl/
Chris@0:     GITWEB:	http://gollem.science.uva.nl/git/ClioPatria.git
Chris@0:     GIT:	git://gollem.science.uva.nl/home/git/ClioPatria.git
Chris@0:     GIT:	http://gollem.science.uva.nl/home/git/ClioPatria.git
Chris@0:     Copyright:  2007, E-Culture/MultimediaN
Chris@0: 
Chris@0:     ClioPatria is free software: you can redistribute it and/or modify
Chris@0:     it under the terms of the GNU General Public License as published by
Chris@0:     the Free Software Foundation, either version 2 of the License, or
Chris@0:     (at your option) any later version.
Chris@0: 
Chris@0:     ClioPatria is distributed in the hope that it will be useful,
Chris@0:     but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@0:     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@0:     GNU General Public License for more details.
Chris@0: 
Chris@0:     You should have received a copy of the GNU General Public License
Chris@0:     along with ClioPatria.  If not, see <http://www.gnu.org/licenses/>.
Chris@0: */
Chris@0: 
Chris@0: :- module(html_head,
Chris@0: 	  [ html_resource/2,		% +Resource, +Attributes
Chris@0: 	    html_requires//1,		% +Resource
Chris@0: 	    absolute_http_location/2	% +Spec, -Path
Chris@0: 	  ]).
Chris@0: :- use_module(library(http/html_write)).
Chris@0: :- use_module(library(http/mimetype)).
Chris@0: :- use_module(library(error)).
Chris@0: :- use_module(library(settings)).
Chris@0: :- use_module(library(lists)).
Chris@0: :- use_module(library(option)).
Chris@0: :- use_module(library(ordsets)).
Chris@0: :- use_module(library(assoc)).
Chris@0: :- use_module(library(ugraphs)).
Chris@0: :- use_module(library(broadcast)).
Chris@0: :- use_module(library(apply)).
Chris@0: :- use_module(library(debug)).
Chris@0: 
Chris@0: 
Chris@0: /** <module> Deal with CSS and scripts
Chris@0: 
Chris@0: This module is to clean up the   mess related to managing Javascript and
Chris@0: CSS files. It defines relations between scripts and style files.
Chris@0: 
Chris@0: Declarations  come  in  two   forms.   First    of   all,   clauses  for
Chris@0: http:location_path/2  define  HTTP  locations    globally,   similar  to
Chris@0: file_search_path/2. Second, html_resource/2 specifies  HTML resources to
Chris@0: be used in the =head= and   their  dependencies. Resources are currently
Chris@0: limited to Javascript files (.js) and style sheets (.css). It is trivial
Chris@0: to add support for other material in the head.  See html_include//1.
Chris@0: 
Chris@0: For usage in HTML generation, there is the DCG rule html_requires/1 that
Chris@0: demands named resources in the HTML head. For general purpose reasoning,
Chris@0: absolute_http_location/2  translates  a  path    specification  into  an
Chris@0: absolute HTTP location on the server.
Chris@0: 
Chris@0: ---++ About resource ordering
Chris@0: 
Chris@0: All calls to html_requires//1 for the page are collected and duplicates
Chris@0: are removed.  Next, the following steps are taken:
Chris@0: 
Chris@0:     1. Add all dependencies to the set
Chris@0:     2. Replace multiple members by `aggregate' scripts or css files.
Chris@0:        see use_agregates/4.
Chris@0:     3. Order all resources by demanding that their dependencies
Chris@0:        preceede the resource itself.  Note that the ordering of
Chris@0:        resources in the dependency list is *ignored*.  This implies
Chris@0:        that if the order matters the dependency list must be split
Chris@0:        and only the primary dependency must be added.
Chris@0: 
Chris@0: ---++ Debugging dependencies
Chris@0: 
Chris@0: Use ?- debug(html(script)). to  see  the   requested  and  final  set of
Chris@0: resources. All declared resources  are   in  html_resource/3. The edit/1
Chris@0: command recognises the names of HTML resources.
Chris@0: 
Chris@0: @see	For ClioPatria, the resources are defined in server/html_resource.pl
Chris@0: @tbd	Possibly we should add img//2 to include images from symbolic
Chris@0: 	path notation.
Chris@0: @tbd	It would be nice if the HTTP file server could use our location
Chris@0: 	declarations.
Chris@0: */
Chris@0: 
Chris@0: :- dynamic
Chris@0: 	html_resource/3.		% Resource, Source, Properties
Chris@0: 
Chris@0: %%	html_resource(+About, +Properties) is det.
Chris@0: %
Chris@0: %	Register an HTML head resource.  About   is  either an atom that
Chris@0: %	specifies an HTTP location or  a   term  Alias(Sub).  This works
Chris@0: %	similar to absolute_file_name/2.  See   http:location_path/2  for
Chris@0: %	details.  Recognised properties are:
Chris@0: %	
Chris@0: %		* requires(+Requirements)
Chris@0: %		Other required script and css files.  If this is a plain
Chris@0: %		file name, it is interpreted relative to the declared
Chris@0: %		resource.  Requirements can be a list, which is equivalent
Chris@0: %		to multiple requires properties.
Chris@0: %		
Chris@0: %		* virtual(+Bool)
Chris@0: %		If =true= (default =false=), do not include About itself,
Chris@0: %		but only its dependencies.  This allows for defining an
Chris@0: %		alias for one or more resources.
Chris@0: %		
Chris@0: %		* aggregate(+List)
Chris@0: %		States that About is an aggregate of the resources in
Chris@0: %		List.
Chris@0: 
Chris@0: html_resource(About, Properties) :-
Chris@0: 	source_location(File, Line), !,
Chris@0: 	retractall(html_resource(About, File:Line, _)),
Chris@0: 	assert_resource(About, File:Line, Properties).
Chris@0: html_resource(About, Properties) :-
Chris@0: 	assert_resource(About, -, Properties).
Chris@0: 
Chris@0: assert_resource(About, Location, Properties) :-
Chris@0: 	assert(html_resource(About, Location, Properties)),
Chris@0: 	clean_same_about_cache,
Chris@0: 	(   memberchk(aggregate(_), Properties)
Chris@0: 	->  clean_aggregate_cache
Chris@0: 	;   true
Chris@0: 	).
Chris@0: 
Chris@0: 
Chris@0: %%	html_requires(+ResourceOrList)// is det.
Chris@0: %
Chris@0: %	Include ResourceOrList and all dependencies  derived from it and
Chris@0: %	add them to the  HTML  =head=   using  html_post/2.  The  actual
Chris@0: %	dependencies are computed  during  the   HTML  output  phase  by
Chris@0: %	html_insert_resource//1.
Chris@0: 
Chris@0: html_requires(Required) -->
Chris@0: 	html_post(head, 'html required'(Required)).
Chris@0: 
Chris@0: :- multifile
Chris@0: 	html_write:html_head_expansion/2.
Chris@0: 
Chris@0: html_write:html_head_expansion(In, Out) :-
Chris@0: 	require_commands(In, Required, Rest),
Chris@0: 	Required \== [], !,
Chris@0: 	flatten(Required, Plain),
Chris@0: 	Out = [ html_head:(\html_insert_resource(Plain))
Chris@0: 	      | Rest
Chris@0: 	      ].
Chris@0: 
Chris@0: require_commands([], [], []).
Chris@0: require_commands([_:('html required'(Required))|T0], [Required|TR], R) :- !,
Chris@0: 	require_commands(T0, TR, R).
Chris@0: require_commands([R|T0], TR, [R|T]) :- !,
Chris@0: 	require_commands(T0, TR, T).
Chris@0: 
Chris@0: 
Chris@0: %%	html_insert_resource(+ResourceOrList)// is det.
Chris@0: %
Chris@0: %	Actually   include   HTML   head   resources.   Called   through
Chris@0: %	html_post//2   from   html_requires//1   after     rewrite    by
Chris@0: %	html_head_expansion/2. We are guaranteed we   will  only get one
Chris@0: %	call that is passed a flat   list  of requested requirements. We
Chris@0: %	have three jobs:
Chris@0: %	
Chris@0: %	    1. Figure out all indirect requirements
Chris@0: %	    2. See whether we can use any `aggregate' resources
Chris@0: %	    3. Put required resources before their requiree.
Chris@0: 
Chris@0: html_insert_resource(Required) -->
Chris@0: 	{ requirements(Required, Paths),
Chris@0: 	  debug(html(script), 'Requirements: ~q~nFinal: ~q', [Required, Paths])
Chris@0: 	},
Chris@0: 	html_include(Paths).
Chris@0: 	
Chris@0: requirements(Required, Paths) :-
Chris@0: 	phrase(requires(Required), List),
Chris@0: 	sort(List, Paths0),		% remove duplicates
Chris@0: 	use_agregates(Paths0, Paths1, AggregatedBy),
Chris@0: 	order_html_resources(Paths1, AggregatedBy, Paths).
Chris@0: 
Chris@0: %%	use_agregates(+Paths, -Aggregated, -AggregatedBy) is det.
Chris@0: %
Chris@0: %	Try to replace sets of  resources   by  an  `aggregate', a large
Chris@0: %	javascript or css file that  combines   the  content of multiple
Chris@0: %	small  ones  to  reduce  the  number   of  files  that  must  be
Chris@0: %	transferred to the server. The current rule says that aggregates
Chris@0: %	are used if at least half of the members are used.
Chris@0: 
Chris@0: use_agregates(Paths, Aggregated, AggregatedBy) :-
Chris@0: 	empty_assoc(AggregatedBy0),
Chris@0: 	use_agregates(Paths, Aggregated, AggregatedBy0, AggregatedBy).
Chris@0: 
Chris@0: use_agregates(Paths, Aggregated, AggregatedBy0, AggregatedBy) :-
Chris@0: 	aggregate(Aggregate, Parts, Size),
Chris@0: 	ord_subtract(Paths, Parts, NotCovered),
Chris@0: 	length(Paths, Len0),
Chris@0: 	length(NotCovered, Len1),
Chris@0: 	Covered is Len0-Len1,
Chris@0: 	Covered >= Size/2, !,
Chris@0: 	ord_add_element(NotCovered, Aggregate, NewPaths),
Chris@0: 	add_aggregated_by(Parts, AggregatedBy0, Aggregate, AggregatedBy1),
Chris@0: 	use_agregates(NewPaths, Aggregated, AggregatedBy1, AggregatedBy).
Chris@0: use_agregates(Paths, Paths, AggregatedBy, AggregatedBy).
Chris@0: 
Chris@0: add_aggregated_by([], Assoc, _, Assoc).
Chris@0: add_aggregated_by([H|T], Assoc0, V, Assoc) :-
Chris@0: 	put_assoc(H, Assoc0, V, Assoc1),
Chris@0: 	add_aggregated_by(T, Assoc1, V, Assoc).
Chris@0: 
Chris@0: 
Chris@0: :- dynamic
Chris@0: 	aggregate_cache_filled/0,
Chris@0: 	aggregate_cache/3.
Chris@0: :- volatile
Chris@0: 	aggregate_cache_filled/0,
Chris@0: 	aggregate_cache/3.
Chris@0: 
Chris@0: clean_aggregate_cache :-
Chris@0: 	retractall(aggregate_cache_filled).
Chris@0: 
Chris@0: %%	aggregate(-Aggregate, -Parts, -Size) is nondet.
Chris@0: %
Chris@0: %	True if Aggregate is a defined   aggregate  with Size Parts. All
Chris@0: %	parts are canonical absolute HTTP locations  and Parts is sorted
Chris@0: %	to allow for processing using ordered set predicates.
Chris@0: 
Chris@0: aggregate(Path, Parts, Size) :-
Chris@0: 	aggregate_cache_filled, !,
Chris@0: 	aggregate_cache(Path, Parts, Size).
Chris@0: aggregate(Path, Parts, Size) :-
Chris@0: 	retractall(aggregate_cache(_,_, _)),
Chris@0: 	forall(uncached_aggregate(Path, Parts, Size),
Chris@0: 	       assert(aggregate_cache(Path, Parts, Size))),
Chris@0: 	assert(aggregate_cache_filled),
Chris@0: 	aggregate_cache(Path, Parts, Size).
Chris@0: 
Chris@0: uncached_aggregate(Path, APartsS, Size) :-
Chris@0: 	html_resource(Aggregate, _, Properties),
Chris@0: 	memberchk(aggregate(Parts), Properties),
Chris@0: 	absolute_http_location(Aggregate, Path),
Chris@0: 	absolute_paths(Parts, Path, AParts),
Chris@0: 	sort(AParts, APartsS),
Chris@0: 	length(APartsS, Size).
Chris@0: 
Chris@0: absolute_paths([], _, []).
Chris@0: absolute_paths([H0|T0], Base, [H|T]) :-
Chris@0: 	absolute_http_location(H0, Base, H),
Chris@0: 	absolute_paths(T0, Base, T).
Chris@0: 
Chris@0: 
Chris@0: %%	requires(+Spec)// is det.
Chris@0: %%	requires(+Spec, +Base)// is det.
Chris@0: %
Chris@0: %	True if Files is the set of  files   that  need to be loaded for
Chris@0: %	Spec. Note that Spec normally appears in  Files, but this is not
Chris@0: %	necessary (i.e. virtual resources  or   the  usage  of aggregate
Chris@0: %	resources).
Chris@0: 
Chris@0: requires(Spec) -->
Chris@0: 	requires(Spec, /).
Chris@0: 
Chris@0: requires([], _) --> !,
Chris@0: 	[].
Chris@0: requires([H|T], Base) --> !,
Chris@0: 	requires(H, Base),
Chris@0: 	requires(T, Base).
Chris@0: requires(Spec, Base) -->
Chris@0: 	requires(Spec, Base, true).
Chris@0: 
Chris@0: requires(Spec, Base, Virtual) -->
Chris@0: 	{ res_properties(Spec, Properties),
Chris@0: 	  absolute_http_location(Spec, Base, File)
Chris@0: 	},
Chris@0: 	(   { option(virtual(true), Properties)
Chris@0: 	    ; Virtual == false
Chris@0: 	    }
Chris@0: 	->  []
Chris@0: 	;   [File]
Chris@0: 	),
Chris@0: 	requires_from_properties(Properties, File).
Chris@0: 
Chris@0: 
Chris@0: requires_from_properties([], _) --> 
Chris@0: 	[].
Chris@0: requires_from_properties([H|T], Base) -->
Chris@0: 	requires_from_property(H, Base),
Chris@0: 	requires_from_properties(T, Base).
Chris@0: 
Chris@0: requires_from_property(requires(What), Base) --> !,
Chris@0: 	requires(What, Base).
Chris@0: requires_from_property(_, _) -->
Chris@0: 	[].
Chris@0: 
Chris@0: 
Chris@0: % %	order_html_resources(+Requirements, +AggregatedBy, -Ordered) is det.
Chris@0: %
Chris@0: %	Establish a proper order for the   collected (sorted and unique)
Chris@0: %	list of Requirements. 
Chris@0: 
Chris@0: order_html_resources(Requirements, AggregatedBy, Ordered) :-
Chris@0: 	requirements_graph(Requirements, AggregatedBy, Graph),
Chris@0: 	(   top_sort(Graph, Ordered)
Chris@0: 	->  true
Chris@0: 	;   connect_graph(Graph, Start, Connected),
Chris@0: 	    top_sort(Connected, Ordered0),
Chris@0: 	    Ordered0 = [Start|Ordered]
Chris@0: 	).
Chris@0: 
Chris@0: %%	requirements_graph(+Requirements, +AggregatedBy, -Graph) is det.
Chris@0: %
Chris@0: %	Produce an S-graph (see library(ugraphs))   that  represents the
Chris@0: %	dependencies  in  the  list  of  Requirements.  Edges  run  from
Chris@0: %	required to requirer.
Chris@0: 
Chris@0: requirements_graph(Requirements, AggregatedBy, Graph) :-
Chris@0: 	phrase(prerequisites(Requirements, AggregatedBy, Vertices, []), Edges),
Chris@0: 	vertices_edges_to_ugraph(Vertices, Edges, Graph).
Chris@0: 
Chris@0: prerequisites([], _, Vs, Vs) -->
Chris@0: 	[].
Chris@0: prerequisites([R|T], AggregatedBy, Vs, Vt) -->
Chris@0: 	prerequisites_for(R, AggregatedBy, Vs, Vt0),
Chris@0: 	prerequisites(T, AggregatedBy, Vt0, Vt).
Chris@0: 
Chris@0: prerequisites_for(R, AggregatedBy, Vs, Vt) -->
Chris@0: 	{ phrase(requires(R, /, false), Req) },
Chris@0: 	(   {Req == []}
Chris@0: 	->  {Vs = [R|Vt]}
Chris@0: 	;   req_edges(Req, AggregatedBy, R),
Chris@0: 	    {Vs = Vt}
Chris@0: 	).
Chris@0: 
Chris@0: req_edges([], _, _) -->
Chris@0: 	[].
Chris@0: req_edges([H|T], AggregatedBy, R) -->
Chris@0: 	(   { get_assoc(H, AggregatedBy, Aggregate) }
Chris@0: 	->  [Aggregate-R]
Chris@0: 	;   [H-R]
Chris@0: 	),
Chris@0: 	req_edges(T, AggregatedBy, R).
Chris@0: 	
Chris@0: 
Chris@0: %%	connect_graph(+Graph, -Connected) is det.
Chris@0: %	
Chris@0: %	Turn Graph into a connected graph   by putting a shared starting
Chris@0: %	point before all vertices.
Chris@0: 
Chris@0: connect_graph([], 0, []) :- !.
Chris@0: connect_graph(Graph, Start, [Start-Vertices|Graph]) :-
Chris@0: 	vertices(Graph, Vertices),
Chris@0: 	Vertices = [First|_],
Chris@0: 	before(First, Start).
Chris@0: 	
Chris@0: %%	before(+Term, -Before) is det.
Chris@0: %
Chris@0: %	Unify Before to a term that comes   before  Term in the standard
Chris@0: %	order of terms.
Chris@0: %	
Chris@0: %	@error instantiation_error if Term is unbound.
Chris@0: 
Chris@0: before(X, _) :-
Chris@0: 	var(X), !,
Chris@0: 	instantiation_error(X).
Chris@0: before(Number, Start) :-
Chris@0: 	number(Number), !,
Chris@0: 	Start is Number - 1.
Chris@0: before(_, 0).
Chris@0: 
Chris@0: 
Chris@0: %%	res_properties(+Spec, -Properties) is det.
Chris@0: %
Chris@0: %	True if Properties is the set of defined properties on Spec.
Chris@0: 
Chris@0: res_properties(Spec, Properties) :-
Chris@0: 	findall(P, res_property(Spec, P), Properties0),
Chris@0: 	list_to_set(Properties0, Properties).
Chris@0: 
Chris@0: res_property(Spec, Property) :-
Chris@0: 	same_about(Spec, About),
Chris@0: 	html_resource(About, _, Properties),
Chris@0: 	member(Property, Properties).
Chris@0: 
Chris@0: :- dynamic
Chris@0: 	same_about_cache/2.
Chris@0: :- volatile
Chris@0: 	same_about_cache/2.
Chris@0: 
Chris@0: clean_same_about_cache :-
Chris@0: 	retractall(same_about_cache(_,_)).
Chris@0: 
Chris@0: same_about(Spec, About) :-
Chris@0: 	same_about_cache(Spec, Same), !,
Chris@0: 	member(About, Same).
Chris@0: same_about(Spec, About) :-
Chris@0: 	findall(A, uncached_same_about(Spec, A), List),
Chris@0: 	assert(same_about_cache(Spec, List)),
Chris@0: 	member(About, List).
Chris@0: 
Chris@0: uncached_same_about(Spec, About) :-
Chris@0: 	html_resource(About, _, _),
Chris@0: 	same_resource(Spec, About).
Chris@0: 
Chris@0: 
Chris@0: %%	same_resource(+R1, +R2) is semidet.
Chris@0: %
Chris@0: %	True if R1 an R2 represent the same resource.  R1 and R2 are
Chris@0: %	resource specifications are defined by absolute_http_location/2.
Chris@0: 
Chris@0: same_resource(R, R) :- !.
Chris@0: same_resource(R1, R2) :- 
Chris@0: 	resource_base_name(R1, B),
Chris@0: 	resource_base_name(R2, B),
Chris@0: 	absolute_http_location(R1, Path),
Chris@0: 	absolute_http_location(R2, Path).
Chris@0: 
Chris@0: :- dynamic
Chris@0: 	base_cache/2.
Chris@0: :- volatile
Chris@0: 	base_cache/2.
Chris@0: 
Chris@0: resource_base_name(Spec, Base) :-
Chris@0: 	(   base_cache(Spec, Base0)
Chris@0: 	->  Base = Base0
Chris@0: 	;   uncached_resource_base_name(Spec, Base0),
Chris@0: 	    assert(base_cache(Spec, Base0)),
Chris@0: 	    Base = Base0
Chris@0: 	).
Chris@0: 
Chris@0: uncached_resource_base_name(Atom, Base) :-
Chris@0: 	atomic(Atom), !,
Chris@0: 	file_base_name(Atom, Base).
Chris@0: uncached_resource_base_name(Compound, Base) :-
Chris@0: 	arg(1, Compound, Base0),
Chris@0: 	file_base_name(Base0, Base).
Chris@0: 
Chris@0: %%	html_include(+PathOrList)// is det.
Chris@0: %
Chris@0: %	Include to HTML resources  that  must   be  in  the  HTML <head>
Chris@0: %	element. Currently onlu supports  =|.js|=   and  =|.css|= files.
Chris@0: %	Extend this to support more  header   material.  Do not use this
Chris@0: %	predicate directly. html_requires//1 is the  public interface to
Chris@0: %	include HTML resources.
Chris@0: %	
Chris@0: %	@param	HTTP location or list of these.
Chris@0: 
Chris@0: html_include([]) --> !.
Chris@0: html_include([H|T]) --> !,
Chris@0: 	html_include(H),
Chris@0: 	html_include(T).
Chris@0: html_include(Path) -->
Chris@0: 	{ file_mime_type(Path, Mime) }, !,
Chris@0: 	html_include(Mime, Path).
Chris@0: 
Chris@0: html_include(text/css, Path) --> !,
Chris@0: 	html(link([ rel(stylesheet),
Chris@0: 		    type('text/css'),
Chris@0: 		    href(Path)
Chris@0: 		  ], [])).
Chris@0: html_include(text/javascript, Path) --> !,
Chris@0: 	html(script([ type('text/javascript'),
Chris@0: 		      src(Path)
Chris@0: 		    ], [])).
Chris@0: html_include(Mime, Path) -->
Chris@0: 	{ print_message(warning, html_include(dont_know, Mime, Path))
Chris@0: 	}.
Chris@0: 
Chris@0: 
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	      PATHS		*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: :- multifile
Chris@0: 	http:location_path/2.
Chris@0: :- dynamic
Chris@0: 	http:location_path/2.
Chris@0: 
Chris@0: %%	http_location_path(+Alias, -Expansion) is det.
Chris@0: %
Chris@0: %	Expansion is the expanded HTTP location for Alias. As we have no
Chris@0: %	condition search, we demand a single  expansion for an alias. An
Chris@0: %	ambiguous alias results in a printed   warning.  A lacking alias
Chris@0: %	results in an exception.
Chris@0: %	
Chris@0: %	@error	existence_error(http_alias, Alias)
Chris@0: 
Chris@0: http_location_path(Alias, Path) :-
Chris@0: 	findall(Path, http:location_path(Alias, Path), Paths0),
Chris@0: 	sort(Paths0, Paths),
Chris@0: 	(   Paths = [One]
Chris@0: 	->  Path = One
Chris@0: 	;   Paths = [Path|_]
Chris@0: 	->  print_message(warning, ambiguous_http_location(Alias, Paths))
Chris@0: 	;   Alias \== prefix
Chris@0: 	->  existence_error(http_alias, Alias)
Chris@0: 	).
Chris@0: http_location_path(prefix, Path) :-
Chris@0: 	(   setting(http:prefix, Prefix),
Chris@0: 	    Prefix \== ''
Chris@0: 	->  (	sub_atom(Prefix, 0, _, _, /)
Chris@0: 	    ->  Path = Prefix
Chris@0: 	    ;	atom_concat(/, Prefix, Path)
Chris@0: 	    )
Chris@0: 	;   Path = /
Chris@0: 	).
Chris@0: 
Chris@0: %%	absolute_http_location(+Spec, -Path) is det.
Chris@0: %%	absolute_http_location(+Spec, +Base, -Path) is det.
Chris@0: %
Chris@0: %	True if Path is the full HTTP   location  for Spec. This behaves
Chris@0: %	very much like absolute_file_name/2. Path-alias   are defined by
Chris@0: %	the dynamic multifile predicate  http:location_path/2, using the
Chris@0: %	same syntax as user:file_search_path/2.
Chris@0: 
Chris@0: :- dynamic
Chris@0: 	location_cache/3.
Chris@0: :- volatile
Chris@0: 	location_cache/3.
Chris@0: 
Chris@0: absolute_http_location(Spec, Path) :-
Chris@0: 	absolute_http_location(Spec, /, Path).
Chris@0: 
Chris@0: absolute_http_location(Spec, Base, Path) :-
Chris@0: 	location_cache(Spec, Base, Path), !.
Chris@0: absolute_http_location(Spec, Base, Path) :-
Chris@0: 	uncached_absolute_http_location(Spec, Base, Path),
Chris@0: 	assert(location_cache(Spec, Base, Path)).
Chris@0: 
Chris@0: uncached_absolute_http_location(Spec, Base, Path) :-
Chris@0: 	(   atomic(Spec)
Chris@0: 	->  relative_to(Base, Spec, Path)
Chris@0: 	;   Spec =.. [Alias, Sub],
Chris@0: 	    http_location_path(Alias, Parent),
Chris@0: 	    absolute_http_location(Parent, /, ParentLocation),
Chris@0: 	    phrase(sub_list(Sub), List),
Chris@0: 	    concat_atom(List, /, SubAtom),
Chris@0: 	    (	ParentLocation == ''
Chris@0: 	    ->	Path = SubAtom
Chris@0: 	    ;	sub_atom(ParentLocation, _, _, 0, /)
Chris@0: 	    ->	atom_concat(ParentLocation, SubAtom, Path)
Chris@0: 	    ;	concat_atom([ParentLocation, SubAtom], /, Path)
Chris@0: 	    )
Chris@0: 	).
Chris@0: 
Chris@0: %%	relative_to(+Base, +Path, -AbsPath) is det.
Chris@0: %
Chris@0: %	AbsPath is an absolute URL location created from Base and Path.
Chris@0: %	The result is cleaned
Chris@0: 
Chris@0: relative_to(/, Path, Path) :- !.
Chris@0: relative_to(_Base, Path, Path) :-
Chris@0: 	sub_atom(Path, 0, _, _, /), !.
Chris@0: relative_to(Base, Local, Path) :-
Chris@0: 	path_segments(Base, BaseSegments),
Chris@0: 	append(BaseDir, [_], BaseSegments) ->
Chris@0: 	path_segments(Local, LocalSegments),
Chris@0: 	append(BaseDir, LocalSegments, Segments0),
Chris@0: 	clean_segments(Segments0, Segments),
Chris@0: 	path_segments(Path, Segments).
Chris@0: 	
Chris@0: path_segments(Path, Segments) :-
Chris@0: 	concat_atom(Segments, /, Path).
Chris@0: 
Chris@0: %%	clean_segments(+SegmentsIn, -SegmentsOut) is det.
Chris@0: %
Chris@0: %	Clean a path represented  as  a   segment  list,  removing empty
Chris@0: %	segments and resolving .. based on syntax.
Chris@0: 
Chris@0: clean_segments([''|T0], [''|T]) :- !,
Chris@0: 	exclude(empty_segment, T0, T1),
Chris@0: 	clean_parent_segments(T1, T).
Chris@0: clean_segments(T0, T) :-
Chris@0: 	exclude(empty_segment, T0, T1),
Chris@0: 	clean_parent_segments(T1, T).
Chris@0: 
Chris@0: clean_parent_segments([], []).
Chris@0: clean_parent_segments([..|T0], T) :- !,
Chris@0: 	clean_parent_segments(T0, T).
Chris@0: clean_parent_segments([_,..|T0], T) :- !,
Chris@0: 	clean_parent_segments(T0, T).
Chris@0: clean_parent_segments([H|T0], [H|T]) :-
Chris@0: 	clean_parent_segments(T0, T).
Chris@0: 
Chris@0: empty_segment('').
Chris@0: empty_segment('.').
Chris@0: 
Chris@0: 
Chris@0: %%	sub_list(+Spec, -List) is det.
Chris@0: 
Chris@0: sub_list(Var) -->
Chris@0: 	{ var(Var), !,
Chris@0: 	  instantiation_error(Var)
Chris@0: 	}.
Chris@0: sub_list(A/B) --> !,
Chris@0: 	sub_list(A),
Chris@0: 	sub_list(B).
Chris@0: sub_list(A) -->
Chris@0: 	[A].
Chris@0: 
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	  CACHE CLEANUP		*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: clean_location_cache :-
Chris@0: 	retractall(location_cache(_,_,_)).
Chris@0: 
Chris@0: :- listen(settings(changed(http:prefix, _, _)),
Chris@0: 	  clean_location_cache).
Chris@0: 
Chris@0: :- multifile
Chris@0: 	user:message_hook/3.
Chris@0: :- dynamic
Chris@0: 	user:message_hook/3.
Chris@0: 
Chris@0: user:message_hook(make(done(Reload)), _Level, _Lines) :-
Chris@0: 	Reload \== [],
Chris@0: 	clean_location_cache,
Chris@0: 	clean_same_about_cache,
Chris@0: 	clean_aggregate_cache,
Chris@0: 	fail.
Chris@0: 
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	       EDIT		*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: % Allow edit(Location) to edit the :- html_resource declaration.
Chris@0: :- multifile
Chris@0: 	prolog_edit:locate/3.
Chris@0: 
Chris@0: prolog_edit:locate(Path, html_resource(Spec), [file(File), line(Line)]) :-
Chris@0: 	atom(Path),
Chris@0: 	html_resource(Spec, File:Line, _Properties),
Chris@0: 	sub_term(Path, Spec).