swish/commit

Updated Prolog files

authorJan Wielemaker
Mon Jan 19 18:34:39 2015 +0100
committerJan Wielemaker
Mon Jan 19 18:34:39 2015 +0100
commitbee7912d643372fb6ffd8ec84b9e16428b556e47
treed0de09d1efb133af71262223a196b37537360b81
parentd230fbad545e412fa2c38ef549331fa443455794
Diff style: patch stat
diff --git a/lib/swish/config.pl b/lib/swish/config.pl
index 28e7756..5f089d5 100644
--- a/lib/swish/config.pl
+++ b/lib/swish/config.pl
@@ -3,7 +3,7 @@
     Author:        Jan Wielemaker
     E-mail:        J.Wielemaker@cs.vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 2014, VU University Amsterdam
+    Copyright (C): 2014-2015, VU University Amsterdam
 
     This program is free software; you can redistribute it and/or
     modify it under the terms of the GNU General Public License
@@ -28,7 +28,8 @@
 */
 
 :- module(swish_config,
-	  [ swish_reply_config/1
+	  [ swish_reply_config/1,		% +Request
+	    swish_config_hash/1			% -HASH
 	  ]).
 :- use_module(library(http/http_dispatch)).
 :- use_module(library(http/http_json)).
@@ -49,12 +50,23 @@
 swish_reply_config(Request) :-
 	option(path(Path), Request),
 	file_base_name(Path, 'swish_config.json'),
+	json_config(JSON),
+	reply_json(JSON).
+
+%%	swish_config_hash(-Hash) is det.
+%
+%	True if Hash is the SHA1 of the SWISH config.
+
+swish_config_hash(Hash) :-
+	json_config(Config),
+	variant_sha1(Config, Hash).
+
+json_config(json{ http: json{ locations:JSON
+			    },
+		  swish: SWISHConfig
+		}) :-
 	http_locations(JSON),
-	swish_config(SWISHConfig),
-	reply_json(json{ http: json{ locations:JSON
-				   },
-			 swish: SWISHConfig
-		       }).
+	swish_config(SWISHConfig).
 
 http_locations(JSON) :-
 	findall(ID-Path,
diff --git a/lib/swish/form.pl b/lib/swish/form.pl
new file mode 100644
index 0000000..3ca44e7
--- /dev/null
+++ b/lib/swish/form.pl
@@ -0,0 +1,43 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2014, VU University Amsterdam
+
+    This program 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.
+
+    This program 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 this library; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+    As a special exception, if you link this library with other files,
+    compiled with a Free Software compiler, to produce an executable, this
+    library does not by itself cause the resulting executable to be covered
+    by the GNU General Public License. This exception does not however
+    invalidate any other reasons why the executable file might be covered by
+    the GNU General Public License.
+*/
+
+:- module(swish_form, []).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_server_files)).
+
+/** <module> Show forms in SWISH
+
+This module serves forms for SWISH.
+*/
+
+:- http_handler(swish(form), serve_files_in_directory(swish_form),
+		[id(form),prefix]).
+
+user:file_search_path(swish_form, swish(web/form)).
+
diff --git a/lib/swish/gitty.pl b/lib/swish/gitty.pl
index 768b5f3..a8d0187 100644
--- a/lib/swish/gitty.pl
+++ b/lib/swish/gitty.pl
@@ -3,7 +3,7 @@
     Author:        Jan Wielemaker
     E-mail:        J.Wielemaker@cs.vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 2014, VU University Amsterdam
+    Copyright (C): 2015, VU University Amsterdam
 
     This program is free software; you can redistribute it and/or
     modify it under the terms of the GNU General Public License
@@ -33,9 +33,12 @@
 	    gitty_update/5,		% +Store, +Name, +Data, +Meta, -Commit
 	    gitty_commit/3,		% +Store, +Name, -Meta
 	    gitty_data/4,		% +Store, +Name, -Data, -Meta
-	    gitty_history/4,		% +Store, +Name, +Max, -History
+	    gitty_history/4,		% +Store, +Name, -History, +Options
 	    gitty_scan/1,		% +Store
 	    gitty_hash/2,		% +Store, ?Hash
+	    gitty_reserved_meta/1,	% ?Key
+
+	    gitty_diff/4,		% +Store, ?Start, +End, -Diff
 
 	    data_diff/3,		% +String1, +String2, -Diff
 	    udiff_string/2		% +Diff, -String
@@ -45,6 +48,9 @@
 :- use_module(library(sha)).
 :- use_module(library(lists)).
 :- use_module(library(apply)).
+:- use_module(library(option)).
+:- use_module(library(process)).
+:- use_module(library(debug)).
 :- use_module(library(dcg/basics)).
 
 /** <module> Single-file GIT like version system
@@ -89,6 +95,8 @@ gitty_file(Store, Head, Hash) :-
 %%	gitty_create(+Store, +Name, +Data, +Meta, -Commit) is det.
 %
 %	Create a new object Name from Data and meta information.
+%
+%	@arg Commit is a dit describing the new Commit
 
 gitty_create(Store, Name, _Data, _Meta, _) :-
 	gitty_scan(Store),
@@ -123,7 +131,7 @@ gitty_update(Store, Name, Data, Meta, CommitRet) :-
 	->  true
 	;   throw(error(gitty(commit_version(OldHead, Meta.previous)), _))
 	),
-	load_commit(Store, OldHead, OldMeta),
+	load_plain_commit(Store, OldHead, OldMeta),
 	get_time(Now),
 	save_object(Store, Data, blob, Hash),
 	Commit = gitty{}.put(OldMeta)
@@ -158,7 +166,8 @@ gitty_data(Store, Hash, Data, Meta) :-
 
 %%	gitty_commit(+Store, +NameOrHash, -Meta) is semidet.
 %
-%	True if Meta holds the commit data of NameOrHash.
+%	True if Meta holds the commit data of NameOrHash. A key =commit=
+%	is added to the meta-data to specify the commit hash.
 
 gitty_commit(Store, Name, Meta) :-
 	gitty_scan(Store),
@@ -167,31 +176,79 @@ gitty_commit(Store, Name, Meta) :-
 gitty_commit(Store, Hash, Meta) :-
 	load_commit(Store, Hash, Meta).
 
+load_commit(Store, Hash, Meta) :-
+	load_plain_commit(Store, Hash, Meta0),
+	Meta1 = Meta0.put(commit, Hash),
+	(   head(Store, Meta0.name, Hash)
+	->  Meta = Meta1.put(symbolic, "HEAD")
+	;   Meta = Meta1
+	).
 
-load_commit(Store, Head, Meta) :-
-	load_object(Store, Head, String),
+load_plain_commit(Store, Hash, Meta) :-
+	load_object(Store, Hash, String),
 	term_string(Meta, String, []).
 
-%%	gitty_history(+Store, +NameOrHash, +Max, -History) is det.
+%%	gitty_history(+Store, +NameOrHash, -History, +Options) is det.
 %
 %	History is a list of dicts representating the history of Name in
-%	Store.
+%	Store.  Options:
+%
+%	  - depth(+Depth)
+%	  Number of entries in the history.  If not present, defaults
+%	  to 5.
+%	  - includes(+HASH)
+%	  Ensure Hash is included in the history.  This means that the
+%	  history includes the entry with HASH an (depth+1)//2 entries
+%	  after the requested HASH.
+
+gitty_history(Store, Name, History, Options) :-
+	history_hash_start(Store, Name, Hash0),
+	option(depth(Depth), Options, 5),
+	(   option(includes(Hash), Options)
+	->  read_history_to_hash(Store, Hash0, Hash, History0),
+	    length(History0, Before),
+	    After is max(Depth-Before, (Depth+1)//2),
+	    read_history_depth(Store, Hash, After, History1),
+	    append(History0, History1, History2),
+	    list_prefix(Depth, History2, History)
+	;   read_history_depth(Store, Hash0, Depth, History)
+	).
 
-gitty_history(Store, Name, Max, [Meta|History]) :-
+history_hash_start(Store, Name, Hash) :-
 	gitty_scan(Store),
 	head(Store, Name, Head), !,
-	load_commit(Store, Head, Meta),
-	history(Store, Meta, Max, History).
-gitty_history(Store, Hash, Max, [Meta|History]) :-
-	load_commit(Store, Hash, Meta),
-	history(Store, Meta, Max, History).
+	Hash = Head.
+history_hash_start(_, Hash, Hash).
+
+
+read_history_depth(_, _, 0, []) :- !.
+read_history_depth(Store, Hash, Left, [H|T]) :-
+	load_commit(Store, Hash, H), !,
+	Left1 is Left-1,
+	(   read_history_depth(Store, H.get(previous), Left1, T)
+	->  true
+	;   T = []
+	).
+read_history_depth(_, _, _, []).
+
+%%	read_history_to_hash(+Store, +Start, +Upto, -History)
+%
+%	Read the history upto, but NOT including Upto.
 
+read_history_to_hash(Store, Hash, Upto, [H|T]) :-
+	Upto \== Hash,
+	load_commit(Store, Hash, H),
+	(   read_history_to_hash(Store, H.get(previous), Upto, T)
+	->  true
+	;   T = []
+	).
+read_history_to_hash(_, _, _, []).
 
-history(Store, Meta, Max, [Prev|History]) :-
-	succ(Max1, Max),
-	load_commit(Store, Meta.get(previous), Prev), !,
-	history(Store, Prev, Max1, History).
-history(_, _, _, []).
+list_prefix(0, _, []) :- !.
+list_prefix(_, [], []) :- !.
+list_prefix(N, [H|T0], [H|T]) :-
+	N2 is N - 1,
+	list_prefix(N2, T0, T).
 
 
 %%	save_object(+Store, +Data, +Type, -Hash)
@@ -303,6 +360,7 @@ gitty_scan_sync(Store) :-
 
 gitty_hash(Store, Hash) :-
 	var(Hash), !,
+	access_file(Store, exist),
 	directory_files(Store, Level0),
 	member(E0, Level0),
 	E0 \== '..',
@@ -335,11 +393,120 @@ hash_file(Store, Hash, Path) :-
 	sub_atom(Hash, 4, _, 0, File),
 	atomic_list_concat([Store, Dir0, Dir1, File], /, Path).
 
+%%	gitty_reserved_meta(?Key) is nondet.
+%
+%	True when Key is a gitty reserved key for the commit meta-data
+
+gitty_reserved_meta(name).
+gitty_reserved_meta(time).
+gitty_reserved_meta(data).
+gitty_reserved_meta(previous).
+
 
 		 /*******************************
 		 *	       DIFF		*
 		 *******************************/
 
+%%	gitty_diff(+Store, ?Hash1, +FileOrHash2, -Dict) is det.
+%
+%	True if Dict representeds the changes   in Hash1 to FileOrHash2.
+%	If Hash1 is unbound,  it  is   unified  with  the  `previous` of
+%	FileOrHash2. Returns _{initial:true} if  Hash1   is  unbound and
+%	FileOrHash2 is the initial commit.  Dict contains:
+%
+%	  - from:Meta1
+%	  - to:Meta2
+%	  Meta-data for the two diffed versions
+%	  - data:UDiff
+%	  String holding unified diff representation of changes to the
+%	  data.  Only present of data has changed
+%	  - tags:_{added:AddedTags, deleted:DeletedTags}
+%	  If tags have changed, the added and deleted ones.
+
+gitty_diff(Store, C1, C2, Dict) :-
+	gitty_data(Store, C2, Data2, Meta2),
+	(   var(C1)
+	->  C1 = Meta2.get(previous)
+	;   true
+	), !,
+	gitty_data(Store, C1, Data1, Meta1),
+	Pairs = [ from-Meta1, to-Meta2|_],
+	(   Data1 \== Data2
+	->  udiff_string(Data1, Data2, UDIFF),
+	    memberchk(data-UDIFF, Pairs)
+	;   true
+	),
+	meta_tag_set(Meta1, Tags1),
+	meta_tag_set(Meta2, Tags2),
+	(   Tags1 \== Tags2
+	->  ord_subtract(Tags1, Tags2, Deleted),
+	    ord_subtract(Tags2, Tags1, Added),
+	    memberchk(tags-_{added:Added, deleted:Deleted}, Pairs)
+	;   true
+	),
+	once(length(Pairs,_)),			% close list
+	dict_pairs(Dict, json, Pairs).
+gitty_diff(_Store, '0000000000000000000000000000000000000000', _C2,
+	   json{initial:true}).
+
+
+meta_tag_set(Meta, Tags) :-
+	sort(Meta.get(tags), Tags), !.
+meta_tag_set(_, []).
+
+%%	udiff_string(+Data1, +Data2, -UDIFF) is det.
+%
+%	Produce a unified difference between two   strings. Note that we
+%	can avoid one temporary file using diff's `-` arg and the second
+%	by    passing    =/dev/fd/NNN=    on    Linux    systems.    See
+%	http://stackoverflow.com/questions/3800202
+
+:- if(true).
+
+udiff_string(Data1, Data2, UDIFF) :-
+	setup_call_cleanup(
+	    save_string(Data1, File1),
+	    setup_call_cleanup(
+		save_string(Data2, File2),
+		process_diff(File1, File2, UDIFF),
+		delete_file(File2)),
+	    delete_file(File1)).
+
+save_string(String, File) :-
+	tmp_file_stream(utf8, File, TmpOut),
+	format(TmpOut, '~s', [String]),
+	close(TmpOut).
+
+process_diff(File1, File2, String) :-
+	setup_call_cleanup(
+	    process_create(path(diff),
+			   ['-u', file(File1), file(File2)],
+			   [ stdout(pipe(Out)),
+			     process(PID)
+			   ]),
+	    read_string(Out, _, String),
+	    ( close(Out),
+	      process_wait(PID, Status)
+	    )),
+	assertion(normal_diff_exit(Status)).
+
+normal_diff_exit(exit(0)).		% equal
+normal_diff_exit(exit(1)).		% different
+
+:- else.
+
+udiff_string(Data1, Data2, UDIFF) :-
+	data_diff(Data1, Data2, Diffs),
+	maplist(udiff_string, Diffs, Strings),
+	atomics_to_string(Strings, UDIFF).
+
+:- endif.
+
+
+		 /*******************************
+		 *	   PROLOG DIFF		*
+		 *******************************/
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 Attempt at a built-in diff utility. Doing   it in Prolog may seem weird,
 but is good for tasting  ones  own   dog  food.  In  addition, it avoids
@@ -368,11 +535,11 @@ different solution for the real thing.  Options are:
 %	`Diff` is a list holding
 %
 %	  - +(Line)
-%	  Line as added to Data1 to get Data2
+%	  Line was added to Data1 to get Data2
 %	  - -(Line)
 %	  Line was deleted from Data1 to get Data2
 %	  - -(Line1,Line2)
-%	  Line as replaced
+%	  Line was replaced
 %	  - =(Line)
 %	  Line is identical (context line).
 
@@ -476,7 +643,7 @@ block_lines(=(U), Lines) :- maplist(string_concat(' '), U, Lines).
 block_lines(+(U), Lines) :- maplist(string_concat('+'), U, Lines).
 block_lines(-(U), Lines) :- maplist(string_concat('-'), U, Lines).
 
-udiff_blocks([], []).
+udiff_blocks([], []) :- !.
 udiff_blocks([=(H)|T0], [=([H|E])|T]) :- !,
 	udiff_cp(T0, E, T1),
 	udiff_blocks(T1, T).
diff --git a/lib/swish/highlight.pl b/lib/swish/highlight.pl
index 7c66b0c..884c8be 100644
--- a/lib/swish/highlight.pl
+++ b/lib/swish/highlight.pl
@@ -301,19 +301,6 @@ destroy_state_module(UUID) :-
 destroy_state_module(_).
 
 
-%%	master_load_file(+File, +Seen, -MasterFile) is det.
-%
-%	If file is included into another  file, find the outermost file.
-%	This is the file that needs to  be reloaded instead of reloading
-%	File.
-
-master_load_file(File0, Seen, File) :-
-	source_file_property(File0, included_in(File1, _Line)),
-	\+ memberchk(File1, Seen), !,
-	master_load_file(File1, [File0|Seen], File).
-master_load_file(File, _, File).
-
-
 		 /*******************************
 		 *	  SERVER TOKENS		*
 		 *******************************/
diff --git a/lib/swish/page.pl b/lib/swish/page.pl
index 6d46605..145e9ac 100644
--- a/lib/swish/page.pl
+++ b/lib/swish/page.pl
@@ -50,7 +50,11 @@
 :- use_module(library(debug)).
 :- use_module(library(time)).
 :- use_module(library(option)).
+
 :- use_module(config).
+:- use_module(help).
+:- use_module(form).
+:- use_module(search).
 
 /** <module> Provide the SWISH application as Prolog HTML component
 
@@ -59,7 +63,9 @@ grammer rules. This allows for server-side   generated  pages to include
 swish or parts of swish easily into a page.
 */
 
-:- http_handler(swish(.), swish_reply([]), [id(swish), prefix]).
+http:location(pldoc, swish(pldoc), [priority(100)]).
+
+:- http_handler(swish(.), swish_reply([]), [id(swish), prefix, priority(100)]).
 
 :- multifile
 	swish_config:source_alias/1,
@@ -89,26 +95,34 @@ swish_reply(SwishOptions, Request) :-
 	Params = [ code(_,	 [optional(true)]),
 		   background(_, [optional(true)]),
 		   examples(_,   [optional(true)]),
-		   q(_,          [optional(true)])
+		   q(_,          [optional(true)]),
+		   format(_,     [oneof([swish,raw]), default(swish)])
 		 ],
 	http_parameters(Request, Params),
 	params_options(Params, Options0),
 	merge_options(Options0, SwishOptions, Options1),
-	source_option(Request, Options1, Options),
-	(   swish_config:reply_page(Options)
-	->  true
-	;   reply_html_page(
-		swish(main),
-		[ title('SWISH -- SWI-Prolog for SHaring'),
-		  link([ rel('shortcut icon'),
-			 href('/icons/favicon.ico')
-		       ]),
-		  link([ rel('apple-touch-icon'),
-			 href('/icons/swish-touch-icon.png')
-		       ])
-		],
-		\swish_page(Options))
-	).
+	source_option(Request, Options1, Options2),
+	swish_reply1(Options2).
+
+swish_reply1(Options) :-
+	option(code(Code), Options),
+	option(format(raw), Options), !,
+	format('Content-type: text/x-prolog~n~n'),
+	format('~s~n', [Code]).
+swish_reply1(Options) :-
+	swish_config:reply_page(Options), !.
+swish_reply1(Options) :-
+	reply_html_page(
+	    swish(main),
+	    [ title('SWISH -- SWI-Prolog for SHaring'),
+	      link([ rel('shortcut icon'),
+		     href('/icons/favicon.ico')
+		   ]),
+	      link([ rel('apple-touch-icon'),
+		     href('/icons/swish-touch-icon.png')
+		   ])
+	    ],
+	    \swish_page(Options)).
 
 params_options([], []).
 params_options([H0|T0], [H|T]) :-
@@ -126,7 +140,8 @@ params_options([_|T0], T) :-
 %	Alias(File).
 
 source_option(_Request, Options, Options) :-
-	option(code(_), Options), !.
+	option(code(_), Options),
+	option(format(swish), Options), !.
 source_option(Request, Options0, Options) :-
 	option(path_info(Info), Request),
 	Info \== 'index.html', !,	% Backward compatibility
@@ -165,6 +180,7 @@ serve_resource(Request) :-
 
 resource_prefix('css/').
 resource_prefix('help/').
+resource_prefix('form/').
 resource_prefix('icons/').
 resource_prefix('js/').
 resource_prefix('bower_components/').
@@ -181,28 +197,57 @@ swish_page(Options) -->
 %
 %	Generate the swish navigation bar.
 
-swish_navbar(_Options) -->
+swish_navbar(Options) -->
 	swish_resources,
-	html(header(class([navbar, 'navbar-default']),
-		    div(class([container, 'pull-left']),
-			[ div(class('navbar-header'),
-			      \swish_logos),
-			  nav(id(navbar), [])
-			]))).
-
-swish_logos -->
-	pengine_logo,
-	swish_logo.
-
-pengine_logo -->
+	html(nav([ class([navbar, 'navbar-default']),
+		   role(navigation)
+		 ],
+		 [ div(class('navbar-header'),
+		       [ \collapsed_button,
+			 \swish_logos(Options)
+		       ]),
+		   div([ class([collapse, 'navbar-collapse']),
+			 id(navbar)
+		       ],
+		       [ ul([class([nav, 'navbar-nav'])], []),
+			 \search_form(Options)
+		       ])
+		 ])).
+
+collapsed_button -->
+	html(button([type(button),
+		     class('navbar-toggle'),
+		     'data-toggle'(collapse),
+		     'data-target'('#navbar')
+		    ],
+		    [ span(class('sr-only'), 'Toggle navigation'),
+		      span(class('icon-bar'), []),
+		      span(class('icon-bar'), []),
+		      span(class('icon-bar'), [])
+		    ])).
+
+swish_logos(Options) -->
+	pengine_logo(Options),
+	swish_logo(Options).
+
+pengine_logo(_Options) -->
 	{ http_absolute_location(root(.), HREF, [])
 	},
 	html(a([href(HREF), class('pengine-logo')], &(nbsp))).
-swish_logo -->
+swish_logo(_Options) -->
 	{ http_absolute_location(swish('index.html'), HREF, [])
 	},
 	html(a([href(HREF), class('swish-logo')], &(nbsp))).
 
+%%	search_form(+Options)//
+%
+%	Add search box to the navigation bar
+
+search_form(Options) -->
+	html(div(class(['col-sm-3', 'col-md-3', 'pull-right']),
+		 \search_box(Options))).
+
+
 %%	swish_content(+Options)//
 %
 %	Generate the SWISH editor, Prolog output  area and query editor.
@@ -213,6 +258,7 @@ swish_logo -->
 
 swish_content(Options) -->
 	swish_resources,
+	swish_config_hash,
 	html(div([id(content), class([container, swish])],
 		 [ div([class([tile, horizontal]), 'data-split'('50%')],
 		       [ div(class('prolog-editor'), \source(Options)),
@@ -225,6 +271,21 @@ swish_content(Options) -->
 		   \examples(Options)
 		 ])).
 
+
+%%	swish_config_hash//
+%
+%	Set `window.swish.config_hash` to a  hash   that  represents the
+%	current configuration. This is used by   config.js  to cache the
+%	configuration in the browser's local store.
+
+swish_config_hash -->
+	{ swish_config_hash(Hash) },
+	js_script({|javascript(Hash)||
+		   window.swish = window.swish||{};
+		   window.swish.config_hash = Hash;
+		   |}).
+
+
 %%	source(+Options)//
 %
 %	Associate the source with the SWISH   page. The source itself is
@@ -245,6 +306,7 @@ source(Options) -->
 	  ;   Extra = []
 	  )
 	},
+	source_meta_data(File, Options),
 	html(textarea([ class([source,prolog]),
 			style('display:none')
 		      | Extra
@@ -252,6 +314,19 @@ source(Options) -->
 		      Source)).
 source(_) --> [].
 
+%%	source_meta_data(+File, +Options)//
+%
+%	Dump the meta-data of the provided file into swish.meta_data.
+
+source_meta_data(File, Options) -->
+	{ nonvar(File),
+	  option(meta(Meta), Options)
+	}, !,
+	js_script({|javascript(Meta)||
+		   window.swish = window.swish||{};
+		   window.swish.meta_data = Meta;
+		   |}).
+source_meta_data(_, _) --> [].
 
 background(Options) -->
 	{ option(background(Spec), Options), !,
diff --git a/lib/swish/search.pl b/lib/swish/search.pl
new file mode 100644
index 0000000..794a300
--- /dev/null
+++ b/lib/swish/search.pl
@@ -0,0 +1,106 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2015, VU University Amsterdam
+
+    This program 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.
+
+    This program 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 this library; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+    As a special exception, if you link this library with other files,
+    compiled with a Free Software compiler, to produce an executable, this
+    library does not by itself cause the resulting executable to be covered
+    by the GNU General Public License. This exception does not however
+    invalidate any other reasons why the executable file might be covered by
+    the GNU General Public License.
+*/
+
+:- module(swish_search,
+	  [ search_box//1		% +Options
+	  ]).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_json)).
+
+:- multifile
+	typeahead/3.			% +Set, +Query, -Match
+
+/** <module> SWISH search from the navigation bar
+
+This library supports both typeahead of the   search  box and the actual
+search from the server side. What do we want to search for?
+
+  - Predicates (built-in, library)
+    - How should we handle documentation?  PlDoc?  Manual?
+  - Source files (name, tags, meta-data, content?)
+    - Show matching sources in modal dialog and allow switching to
+      these?
+*/
+
+:- http_handler(swish(typeahead), typeahead, [id(typeahead)]).
+:- http_handler(swish(search),    search,    [id(search)]).
+
+%%	search_box(+Options)//
+%
+%	Render a Bootstrap search box.
+
+search_box(_Options) -->
+	html(form([class('navbar-form'), role(search)],
+		  div(class('input-group'),
+		      [ input([ type(text),
+				class('form-control'),
+				placeholder('Search'),
+				title('Searches code, documentation and files'),
+				id('search')
+			      ]),
+			div(class('input-group-btn'),
+			    button([ class([btn, 'btn-default']),
+				     type(submit)],
+				   i(class([glyphicon, 'glyphicon-search']),
+				     [])))
+		      ]))).
+
+
+%%	typeahead(+Request)
+%
+%	Support the search typeahead widget. The  handler returns a JSON
+%	array of matches. Each match is an object that contains at least
+%	a label.
+
+typeahead(Request) :-
+	http_parameters(Request,
+			[ q(Query, [default('')]),
+			  set(Set, [default(predicates)])
+			]),
+	findall(Match, typeahead(Set, Query, Match), Matches),
+	reply_json_dict(Matches).
+
+typeahead(predicates, Query, Template) :-
+	swish_config:config(templates, Templates),
+	member(Template, Templates),
+	_{name:Name, arity:_} :< Template,
+	sub_atom(Name, 0, _, _, Query).
+
+%%	search(+Request)
+%
+%	Handle an actual search  request  from   the  SWISH  search box.
+%	Returns an HTML  document  with  the   actual  results  that  is
+%	displayed in a modal dialog.
+
+search(_Request) :-
+	reply_html_page(search,
+			[],
+			h1('Search results')).
diff --git a/lib/swish/storage.pl b/lib/swish/storage.pl
index 4645159..585187f 100644
--- a/lib/swish/storage.pl
+++ b/lib/swish/storage.pl
@@ -3,7 +3,7 @@
     Author:        Jan Wielemaker
     E-mail:        J.Wielemaker@cs.vu.nl
     WWW:           http://www.swi-prolog.org
-    Copyright (C): 2014, VU University Amsterdam
+    Copyright (C): 2015, VU University Amsterdam
 
     This program is free software; you can redistribute it and/or
     modify it under the terms of the GNU General Public License
@@ -31,9 +31,9 @@
 :- use_module(library(http/http_dispatch)).
 :- use_module(library(http/http_parameters)).
 :- use_module(library(http/http_json)).
-:- use_module(library(http/http_client)).
 :- use_module(library(http/http_wrapper)).
 :- use_module(library(http/mimetype)).
+:- use_module(library(lists)).
 :- use_module(library(settings)).
 :- use_module(library(random)).
 :- use_module(library(apply)).
@@ -69,42 +69,79 @@ web_storage(Request) :-
 
 storage(get, Request) :-
 	http_parameters(Request,
-			[ format(Format, [ oneof([swish,raw]),
-					   default(swish),
-					   description('How to render')
-					 ])
+			[ format(Fmt,  [ oneof([swish,raw,json,history,diff]),
+					 default(swish),
+					 description('How to render')
+				       ]),
+			  depth(Depth, [ default(5),
+					 integer,
+					 description('History depth')
+				       ]),
+			  to(RelTo,    [ optional(true),
+					 description('Diff relative to')
+				       ])
 			]),
+	(   Fmt == history
+	->  (   nonvar(RelTo)
+	    ->	Format = history(Depth, RelTo)
+	    ;	Format = history(Depth)
+	    )
+	;   Fmt == diff
+	->  Format = diff(RelTo)
+	;   Format = Fmt
+	),
 	storage_get(Request, Format).
 storage(post, Request) :-
-	http_parameters(Request,
-			[   data(Data, [default(''),
-					description('Data to be saved')]),
-			    type(Type, [default(pl)])
-			]),
-	authentity(Request, Authentity),
+	http_read_json_dict(Request, Dict),
+	option(data(Data), Dict, ""),
+	option(type(Type), Dict, pl),
 	setting(directory, Dir),
 	make_directory_path(Dir),
-	(   repeat,
-	    random_filename(Base),
-	    file_name_extension(Base, Type, File),
-	    catch(gitty_create(Dir, File, Data, Authentity, Commit),
-		  error(gitty(file_exists(File)),_),
-		  fail)
-	->  true
+	meta_data(Request, Dir, Dict, Meta),
+	(   atom_string(Base, Dict.get(meta).get(name))
+	->  file_name_extension(Base, Type, File),
+	    (	catch(gitty_create(Dir, File, Data, Meta, Commit),
+		      error(gitty(file_exists(File)),_),
+		      fail)
+	    ->	true
+	    ;	Error = json{error:file_exists,
+			     file:File}
+	    )
+	;   (   repeat,
+	        random_filename(Base),
+		file_name_extension(Base, Type, File),
+		catch(gitty_create(Dir, File, Data, Meta, Commit),
+		      error(gitty(file_exists(File)),_),
+		      fail)
+	    ->  true
+	    )
 	),
-	debug(storage, 'Created: ~p', [Commit]),
-	storage_url(File, URL),
-	reply_json_dict(json{url:URL, file:File}).
+	(   var(Error)
+	->  debug(storage, 'Created: ~p', [Commit]),
+	    storage_url(File, URL),
+
+	    reply_json_dict(json{url:URL,
+				 file:File,
+				 meta:Commit.put(symbolic, "HEAD")
+				})
+	;   reply_json_dict(Error)
+	).
 storage(put, Request) :-
-	http_read_data(Request, Form, []),
-	option(data(Data), Form, ''),
-	authentity(Request, Meta),
+	http_read_json_dict(Request, Dict),
 	setting(directory, Dir),
 	request_file(Request, Dir, File),
+	(   Dict.get(update) == "meta-data"
+	->  gitty_data(Dir, File, Data, _OldMeta)
+	;   option(data(Data), Dict, "")
+	),
+	meta_data(Request, Dict, Meta),
 	storage_url(File, URL),
 	gitty_update(Dir, File, Data, Meta, Commit),
 	debug(storage, 'Updated: ~p', [Commit]),
-	reply_json_dict(json{url:URL, file:File}).
+	reply_json_dict(json{url:URL,
+			     file:File,
+			     meta:Commit.put(symbolic, "HEAD")
+			    }).
 storage(delete, Request) :-
 	authentity(Request, Meta),
 	setting(directory, Dir),
@@ -123,23 +160,113 @@ request_file(Request, Dir, File) :-
 storage_url(File, HREF) :-
 	http_link_to_id(web_storage, path_postfix(File), HREF).
 
+%%	meta_data(+Request, +Dict, -Meta) is det.
+%%	meta_data(+Request, Store, +Dict, -Meta) is det.
+%
+%	Gather meta-data from the  Request   (user,  peer)  and provided
+%	meta-data. Illegal and unknown values are ignored.
+
+meta_data(Request, Dict, Meta) :-
+	authentity(Request, Meta0),	% user, peer
+	(   filter_meta(Dict.get(meta), Meta1)
+	->  Meta = Meta0.put(Meta1)
+	;   Meta = Meta0
+	).
+
+meta_data(Request, Store, Dict, Meta) :-
+	meta_data(Request, Dict, Meta1),
+	(   atom_string(Previous, Dict.get(previous)),
+	    is_sha1(Previous),
+	    gitty_commit(Store, Previous, _PrevMeta)
+	->  Meta = Meta1.put(previous, Previous)
+	;   Meta = Meta1
+	).
+
+filter_meta(Dict0, Dict) :-
+	dict_pairs(Dict0, Tag, Pairs0),
+	filter_pairs(Pairs0, Pairs),
+	dict_pairs(Dict, Tag, Pairs).
+
+filter_pairs([], []).
+filter_pairs([H|T0], [H|T]) :-
+	H = K-V,
+	meta_allowed(K, Type),
+	is_of_type(Type, V), !,
+	filter_pairs(T0, T).
+filter_pairs([_|T0], T) :-
+	filter_pairs(T0, T).
+
+meta_allowed(public,	     boolean).
+meta_allowed(author,	     string).
+meta_allowed(email,	     string).
+meta_allowed(title,	     string).
+meta_allowed(tags,	     list(string)).
+meta_allowed(description,    string).
+meta_allowed(commit_message, string).
+
 %%	storage_get(+Request, +Format) is det.
+%
+%	HTTP handler that returns information a given gitty file.
+%
+%	@arg Format is one of
+%
+%	     - swish
+%	     Serve file embedded in a SWISH application
+%	     - raw
+%	     Serve the raw file
+%	     - json
+%	     Return a JSON object with the keys `data` and `meta`
+%	     - history(Depth, IncludeHASH)
+%	     Return a JSON description with the change log
+%	     - diff(RelTo)
+%	     Reply with diff relative to RelTo.  Default is the
+%	     previous commit.
 
 storage_get(Request, swish) :-
 	swish_reply_config(Request), !.
-storage_get(Request, swish) :- !,
-	setting(directory, Dir),
-	request_file(Request, Dir, File),
-	gitty_data(Dir, File, Code, _Meta),
-	swish_reply([code(Code),file(File)], Request).
-storage_get(Request, _) :-
+storage_get(Request, Format) :-
 	setting(directory, Dir),
-	request_file(Request, Dir, File),
-	gitty_data(Dir, File, Code, _Meta),
-	file_mime_type(File, MIME),
+	request_file_or_hash(Request, Dir, FileOrHash, Type),
+	storage_get(Format, Dir, Type, FileOrHash, Request).
+
+storage_get(swish, Dir, _, FileOrHash, Request) :-
+	gitty_data(Dir, FileOrHash, Code, Meta),
+	swish_reply([code(Code),file(FileOrHash),meta(Meta)], Request).
+storage_get(raw, Dir, _, FileOrHash, _Request) :-
+	gitty_data(Dir, FileOrHash, Code, Meta),
+	file_mime_type(Meta.name, MIME),
 	format('Content-type: ~w~n~n', [MIME]),
 	format('~s', [Code]).
+storage_get(json, Dir, _, FileOrHash, _Request) :-
+	gitty_data(Dir, FileOrHash, Code, Meta),
+	reply_json_dict(json{data:Code, meta:Meta}).
+storage_get(history(Depth, Includes), Dir, _, File, _Request) :-
+	gitty_history(Dir, File, History, [depth(Depth),includes(Includes)]),
+	reply_json_dict(History).
+storage_get(history(Depth), Dir, _, File, _Request) :-
+	gitty_history(Dir, File, History, [depth(Depth)]),
+	reply_json_dict(History).
+storage_get(diff(RelTo), Dir, _, File, _Request) :-
+	gitty_diff(Dir, RelTo, File, Diff),
+	reply_json_dict(Diff).
+
+request_file_or_hash(Request, Dir, FileOrHash, Type) :-
+	option(path_info(PathInfo), Request),
+	atom_concat(/, FileOrHash, PathInfo),
+	(   gitty_file(Dir, FileOrHash, _Hash)
+	->  Type = file
+	;   is_sha1(FileOrHash)
+	->  Type = hash
+	;   http_404([], Request)
+	).
 
+is_sha1(SHA1) :-
+	atom_length(SHA1, 40),
+	atom_codes(SHA1, Codes),
+	maplist(hex_digit, Codes).
+
+hex_digit(C) :- between(0'0, 0'9, C), !.
+hex_digit(C) :- between(0'a, 0'f, C).
 
 %%	authentity(+Request, -Authentity:dict) is det.
 %
@@ -183,3 +310,45 @@ random_char(Char) :-
 	Max is Len - 1,
 	random_between(0, Max, I),
 	sub_atom(From, I, 1, _, Char).
+
+
+		 /*******************************
+		 *	 SEARCH SUPPORT		*
+		 *******************************/
+
+:- multifile
+	swish_search:typeahead/3.	% +Set, +Query, -Match
+
+%%	swish_search:typeahead(+Set, +Query, -Match) is nondet.
+%
+%	Find files using typeahead from the SWISH search box.
+%
+%	@tbd caching?
+%	@tbd We should only demand public on public servers.
+
+swish_search:typeahead(file, Query, FileInfo) :-
+	setting(directory, Dir),
+	gitty_file(Dir, File, Head),
+	gitty_commit(Dir, Head, Meta),
+	Meta.get(public) == true,
+	(   sub_atom(File, 0, _, _, Query) % find only public
+	->  true
+	;   meta_match_query(Query, Meta)
+	->  true
+	),
+	FileInfo = Meta.put(_{type:"store", file:File}).
+
+meta_match_query(Query, Meta) :-
+	member(Tag, Meta.get(tags)),
+	sub_atom(Tag, 0, _, _, Query).
+meta_match_query(Query, Meta) :-
+	sub_atom(Meta.get(author), 0, _, _, Query).
+meta_match_query(Query, Meta) :-
+	Title = Meta.get(title),
+	sub_atom_icasechk(Title, Start, Query),
+	(   Start =:= 0
+	->  true
+	;   Before is Start-1,
+	    sub_atom(Title, Before, 1, _, C),
+	    \+ char_type(C, csym)
+	).
diff --git a/lib/swish/template_hint.pl b/lib/swish/template_hint.pl
index eccdfe4..09669b3 100644
--- a/lib/swish/template_hint.pl
+++ b/lib/swish/template_hint.pl
@@ -250,11 +250,14 @@ man_predicate_info(PI, Name-Value) :-
 	normalize_space(string(ModeLine), ModeLine0),
 	(   atom_string(PName, PString),
 	    Name-Value = name-PString
+	;   Name-Value = arity-Arity
 	;   Name-Value = mode-ModeLine
 	;   once(catch(predicate(PName, Arity, Summary, _, _), _, fail)),
 	    Name-Value = summary-Summary
-	;   predicate_property(system:PHead, iso)
-	->  Name-Value = iso:true
+	;   predicate_property(system:PHead, iso),
+	    Name-Value = iso-true
+	;   predicate_property(system:PHead, built_in),
+	    Name-Value = type-built_in
 	).
 
 %%	pldoc_predicate_info(+PI, -ModeLine) is semidet.
@@ -262,7 +265,7 @@ man_predicate_info(PI, Name-Value) :-
 pldoc_predicate_info(PI, Name-Value) :-
 	pi_head(PI, Head),
 	strip_module(Head, _, PHead),
-	functor(PHead, PName, _Arity),
+	functor(PHead, PName, Arity),
 	implementation_module(Head, Module),
 	doc_comment(PI, Pos, Summary, Comment), !,
 	is_structured_comment(Comment, Prefixes),
@@ -281,6 +284,7 @@ pldoc_predicate_info(PI, Name-Value) :-
 		    ]),
 	(   atom_string(PName, PString),
 	    Name-Value = name-PString
+	;   Name-Value = arity-Arity
 	;   Name-Value = mode-ModeLine
 	;   Name-Value = summary-Summary
 	;   Det \== unknown,