swish/commit

Copied new upstream versions

authorJan Wielemaker
Wed Sep 7 08:49:25 2016 +0200
committerJan Wielemaker
Wed Sep 7 08:49:25 2016 +0200
commitf9741ecdb5b98478b6858f32bf7503058c17750b
treedc7bdbedb4c76d0248e3353de069b88c218f515a
parent0d63d7aaa87f68c4b2e1edc03f1822345e878767
Diff style: patch stat
diff --git a/lib/swish/config.pl b/lib/swish/config.pl
index 9ca6978..40659dc 100644
--- a/lib/swish/config.pl
+++ b/lib/swish/config.pl
@@ -124,6 +124,12 @@ swish_config(Key, Value, Options) :-
 swish_config(Key, Value, _) :-
 	config(Key, Value).
 
+% We need to use '$swish wrapper' with a variable _residuals in
+% versions that support the `var_prefix` option.
+:- if(current_prolog_flag(var_prefix, _)).
+config(residuals_var, '_residuals').
+:- endif.
+
 %%	source_alias(?Alias, ?Options) is nondet.
 %
 %	Multifile hook that  defines   properties  of file_search_path/2
diff --git a/lib/swish/highlight.pl b/lib/swish/highlight.pl
index 7d29b17..a6bb280 100644
--- a/lib/swish/highlight.pl
+++ b/lib/swish/highlight.pl
@@ -31,6 +31,7 @@
 	  [ current_highlight_state/2
 	  ]).
 :- use_module(library(debug)).
+:- use_module(library(settings)).
 :- use_module(library(http/http_dispatch)).
 :- use_module(library(http/html_write)).
 :- use_module(library(http/http_json)).
@@ -54,6 +55,9 @@ http:location(codemirror, swish(cm), []).
 :- http_handler(codemirror(leave),  codemirror_leave,  []).
 :- http_handler(codemirror(info),   token_info,        []).
 
+:- setting(swish:editor_max_idle_time, nonneg, 3600,
+	   "Maximum time we keep a mirror editor around").
+
 /** <module> Highlight token server
 
 This module provides the Prolog part of server-assisted highlighting for
@@ -154,13 +158,13 @@ insert([H|T], TB, ChPos0, ChPos, Changed) :-
 	->  Len	= 0
 	;   Changed = true,
 	    string_length(H, Len),
-	    debug(cm(change), 'Insert ~q at ~d', [H, ChPos0]),
+	    debug(cm(change_text), 'Insert ~q at ~d', [H, ChPos0]),
 	    insert_memory_file(TB, ChPos0, H)
 	),
 	ChPos1 is ChPos0+Len,
 	(   T == []
 	->  ChPos2 = ChPos1
-	;   debug(cm(change), 'Adding newline at ~d', [ChPos1]),
+	;   debug(cm(change_text), 'Adding newline at ~d', [ChPos1]),
 	    Changed = true,
 	    insert_memory_file(TB, ChPos1, '\n'),
 	    ChPos2 is ChPos1+1
@@ -247,7 +251,8 @@ destroy_editor(_).
 :- dynamic
 	gced_editors/1.
 
-editor_max_idle_time(3600).
+editor_max_idle_time(Time) :-
+	setting(swish:editor_max_idle_time, Time).
 
 gc_editors :-
 	get_time(Now),
@@ -320,11 +325,14 @@ prolog:xref_open_source(UUID, Stream) :-
 
 codemirror_leave(Request) :-
 	http_read_json_dict(Request, Data, []),
-	debug(cm(leave), 'Leaving editor ~p', [Data]),
 	(   atom_string(UUID, Data.get(uuid))
-	->  forall(current_editor(UUID, _TB, _Role, _),
-		   with_mutex(swish_gc_editor, destroy_editor(UUID)))
-	;   true
+	->  debug(cm(leave), 'Leaving editor ~p', [UUID]),
+	    (	current_editor(UUID, _, _, _)
+	    ->	forall(current_editor(UUID, _TB, _Role, _),
+		       with_mutex(swish_gc_editor, destroy_editor(UUID)))
+	    ;	debug(cm(leave), 'No editor for ~p', [UUID])
+	    )
+	;   debug(cm(leave), 'No editor?? (data=~p)', [Data])
 	),
 	reply_json_dict(true).
 
@@ -380,9 +388,15 @@ xref_state_module(TB, UUID) :-
 	(   module_property(UUID, class(temporary))
 	->  true
 	;   set_module(UUID:class(temporary)),
-	    add_import_module(UUID, swish, start)
+	    add_import_module(UUID, swish, start),
+	    maplist(copy_flag(UUID, swish), [var_prefix])
 	).
 
+copy_flag(Module, Application, Flag) :-
+    current_prolog_flag(Application:Flag, Value), !,
+    set_prolog_flag(Module:Flag, Value).
+copy_flag(_, _, _).
+
 destroy_state_module(UUID) :-
 	module_property(UUID, class(temporary)), !,
 	'$destroy_module'(UUID).
@@ -480,7 +494,8 @@ shadow_editor(Data, TB) :-
 	    insert_memory_file(TB, 0, Text),
 	    mark_changed(TB, true)
 	;   Changes = Data.get(changes)
-	->  (   maplist(apply_change(TB, Changed), Changes)
+	->  (   debug(cm(change), 'Patch editor for ~p', [UUID]),
+		maplist(apply_change(TB, Changed), Changes)
 	    ->	true
 	    ;	throw(cm(out_of_sync))
 	    ),
@@ -490,7 +505,8 @@ shadow_editor(Data, TB) :-
 	Text = Data.get(text), !,
 	atom_string(UUID, Data.uuid),
 	create_editor(UUID, TB, Data),
-	debug(cm(change), 'Initialising editor to ~q', [Text]),
+	debug(cm(change), 'Create editor for ~p', [UUID]),
+	debug(cm(change_text), 'Initialising editor to ~q', [Text]),
 	insert_memory_file(TB, 0, Text).
 shadow_editor(Data, TB) :-
 	_{role:_} :< Data, !,
@@ -602,9 +618,13 @@ json_token(TB, Start, Token) :-
 	dict_create(Token, json, [type(Type)|Attrs]).
 
 atomic_special(atom, Start, Len, TB, Type, Attrs) :-
-	(   memory_file_substring(TB, Start, 1, _, "'")
+	memory_file_substring(TB, Start, 1, _, FirstChar),
+	(   FirstChar == "'"
 	->  Type = qatom,
 	    Attrs = []
+	;   char_type(FirstChar, upper)
+	->  Type = uatom,			% var_prefix in effect
+	    Attrs = []
 	;   Type = atom,
 	    (   Len =< 5			% solo characters, neck, etc.
 	    ->  memory_file_substring(TB, Start, Len, _, Text),