1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2016, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(swish_highlight,
   36	  [ current_highlight_state/2
   37	  ]).   38:- use_module(library(debug)).   39:- use_module(library(settings)).   40:- use_module(library(http/http_dispatch)).   41:- use_module(library(http/html_write)).   42:- use_module(library(http/http_json)).   43:- use_module(library(http/http_path), []).   44:- use_module(library(http/http_parameters)).   45:- use_module(library(pairs)).   46:- use_module(library(apply)).   47:- use_module(library(error)).   48:- use_module(library(prolog_xref)).   49:- use_module(library(memfile)).   50:- use_module(library(prolog_colour)).   51:- use_module(library(lazy_lists)).   52:- if(exists_source(library(helpidx))).   53:- use_module(library(helpidx), [predicate/5]).   54:- endif.   55
   56http:location(codemirror, swish(cm), []).
   57
   58:- http_handler(codemirror(.),      http_404([]),      [id(cm_highlight)]).   59:- http_handler(codemirror(change), codemirror_change, []).   60:- http_handler(codemirror(tokens), codemirror_tokens, []).   61:- http_handler(codemirror(leave),  codemirror_leave,  []).   62:- http_handler(codemirror(info),   token_info,        []).   63
   64:- setting(swish:editor_max_idle_time, nonneg, 3600,
   65	   "Maximum time we keep a mirror editor around").   66
   67/** <module> Highlight token server
   68
   69This module provides the Prolog part of server-assisted highlighting for
   70SWISH. It is implemented by managing a  shadow copy of the client editor
   71on the server. On request,  the  server   computes  a  list of _semantic
   72tokens_.
   73
   74@tbd	Use websockets
   75*/
   76
   77		 /*******************************
   78		 *	  SHADOW EDITOR		*
   79		 *******************************/
   80
   81%%	codemirror_change(+Request)
   82%
   83%	Handle changes to the codemirror instances. These are sent to us
   84%	using  a  POST  request.  The  request   a  POSTed  JSON  object
   85%	containing:
   86%
   87%	  - uuid: string holding the editor's UUID
   88%	  - change: the change object, which holds:
   89%	    - from: Start position as {line:Line, ch:Ch}
   90%	    - to: End position
   91%	    - removed: list(atom) of removed text
   92%	    - text: list(atom) of inserted text
   93%	    - origin: what caused this change event
   94%	    - next: optional next change event.
   95%
   96%	Reply is JSON and either 200 with  `true` or 409 indicating that
   97%	the editor is not known.
   98
   99codemirror_change(Request) :-
  100	call_cleanup(codemirror_change_(Request),
  101		     check_unlocked).
  102
  103codemirror_change_(Request) :-
  104	http_read_json_dict(Request, Change, []),
  105	debug(cm(change), 'Change ~p', [Change]),
  106	atom_string(UUID, Change.uuid),
  107	catch(shadow_editor(Change, TB),
  108	      cm(Reason), true),
  109	(   var(Reason)
  110	->  (	catch(apply_change(TB, Changed, Change.change),
  111		      cm(outofsync), fail)
  112	    ->  mark_changed(TB, Changed),
  113		release_editor(UUID),
  114		reply_json_dict(true)
  115	    ;	destroy_editor(UUID),
  116		change_failed(UUID, outofsync)
  117	    )
  118	;   change_failed(UUID, Reason)
  119	).
  120
  121change_failed(UUID, Reason) :-
  122	reply_json_dict(json{ type:Reason,
  123			      object:UUID
  124			    },
  125			[status(409)]).
  126
  127
  128%%	apply_change(+TB, -Changed, +Changes) is det.
  129%
  130%	Note that the argument order is like this to allow for maplist.
  131%
  132%	@arg Changed is left unbound if there are no changes or unified
  133%	to =true= if something has changed.
  134%
  135%	@throws	cm(outofsync) if an inconsistent delete is observed.
  136
  137apply_change(_, _Changed, []) :- !.
  138apply_change(TB, Changed, Change) :-
  139	_{from:From} :< Change,
  140	Line is From.line+1,
  141	memory_file_line_position(TB, Line, From.ch, ChPos),
  142	remove(Change.removed, TB, ChPos, Changed),
  143	insert(Change.text, TB, ChPos, _End, Changed),
  144	(   Next = Change.get(next)
  145	->  apply_change(TB, Changed, Next)
  146	;   true
  147	).
  148
  149remove([], _, _, _) :- !.
  150remove([H|T], TB, ChPos, Changed) :-
  151	string_length(H, Len),
  152	(   T == []
  153	->  DLen is Len
  154	;   DLen is Len+1
  155	),
  156	(   DLen == 0
  157	->  true
  158	;   Changed = true,
  159	    memory_file_substring(TB, ChPos, Len, _, Text),
  160	    (	Text == H
  161	    ->	true
  162	    ;	throw(cm(outofsync))
  163	    ),
  164	    delete_memory_file(TB, ChPos, DLen)
  165	),
  166	remove(T, TB, ChPos, Changed).
  167
  168insert([], _, ChPos, ChPos, _) :- !.
  169insert([H|T], TB, ChPos0, ChPos, Changed) :-
  170	(   H == ""
  171	->  Len	= 0
  172	;   Changed = true,
  173	    string_length(H, Len),
  174	    debug(cm(change_text), 'Insert ~q at ~d', [H, ChPos0]),
  175	    insert_memory_file(TB, ChPos0, H)
  176	),
  177	ChPos1 is ChPos0+Len,
  178	(   T == []
  179	->  ChPos2 = ChPos1
  180	;   debug(cm(change_text), 'Adding newline at ~d', [ChPos1]),
  181	    Changed = true,
  182	    insert_memory_file(TB, ChPos1, '\n'),
  183	    ChPos2 is ChPos1+1
  184	),
  185	insert(T, TB, ChPos2, ChPos, Changed).
  186
  187:- dynamic
  188	current_editor/5,		% UUID, MemFile, Role, Lock, Time
  189	editor_last_access/2,		% UUID, Time
  190	xref_upto_data/1.		% UUID
  191
  192%%	create_editor(+UUID, -Editor, +Change) is det.
  193%
  194%	Create a new editor for source UUID   from Change. The editor is
  195%	created  in  a  locked  state  and    must   be  released  using
  196%	release_editor/1 before it can be publically used.
  197
  198create_editor(UUID, Editor, Change) :-
  199	must_be(atom, UUID),
  200	uuid_like(UUID),
  201	new_memory_file(Editor),
  202	(   RoleString = Change.get(role)
  203	->  atom_string(Role, RoleString)
  204	;   Role = source
  205	),
  206	get_time(Now),
  207	mutex_create(Lock),
  208	with_mutex(swish_create_editor,
  209		   register_editor(UUID, Editor, Role, Lock, Now)), !.
  210create_editor(UUID, Editor, _Change) :-
  211	fetch_editor(UUID, Editor).
  212
  213% editor and lock are left to symbol-GC if this fails.
  214register_editor(UUID, Editor, Role, Lock, Now) :-
  215	\+ current_editor(UUID, _, _, _, _),
  216	mutex_lock(Lock),
  217	asserta(current_editor(UUID, Editor, Role, Lock, Now)).
  218
  219%%	current_highlight_state(?UUID, -State) is nondet.
  220%
  221%	Return info on the current highlighter
  222
  223current_highlight_state(UUID,
  224			highlight{data:Editor,
  225				  role:Role,
  226				  created:Created,
  227				  lock:Lock,
  228				  access:Access
  229				 }) :-
  230	current_editor(UUID, Editor, Role, Lock, Created),
  231	(   editor_last_access(Editor, Access)
  232	->  true
  233	;   Access = Created
  234	).
  235
  236
  237%%	uuid_like(+UUID) is semidet.
  238%
  239%	Do some sanity checking on  the  UUID   because  we  use it as a
  240%	temporary module name and thus we must be quite sure it will not
  241%	conflict with anything.
  242
  243uuid_like(UUID) :-
  244	split_string(UUID, "-", "", Parts),
  245	maplist(string_length, Parts, [8,4,4,4,12]),
  246	\+ current_editor(UUID, _, _, _, _).
  247
  248%%	destroy_editor(+UUID)
  249%
  250%	Destroy source admin UUID: the shadow  text (a memory file), the
  251%	XREF data and the module used  for cross-referencing. The editor
  252%	must  be  acquired  using  fetch_editor/2    before  it  can  be
  253%	destroyed.
  254
  255destroy_editor(UUID) :-
  256	must_be(atom, UUID),
  257	current_editor(UUID, Editor, _, Lock, _), !,
  258	mutex_unlock(Lock),
  259	retractall(xref_upto_data(UUID)),
  260	retractall(editor_last_access(UUID, _)),
  261	(   xref_source_id(UUID, SourceID)
  262	->  xref_clean(SourceID),
  263	    destroy_state_module(UUID)
  264	;   true
  265	),
  266	% destroy after xref_clean/1 to make xref_source_identifier/2 work.
  267	retractall(current_editor(UUID, Editor, _, _, _)),
  268	free_memory_file(Editor).
  269destroy_editor(_).
  270
  271%%	gc_editors
  272%
  273%	Garbage collect all editors that have   not been accessed for 60
  274%	minutes.
  275%
  276%	@tbd  Normally,  deleting  a  highlight    state   can  be  done
  277%	aggressively as it will be recreated  on demand. But, coloring a
  278%	query passes the UUIDs of related sources and as yet there is no
  279%	way to restore this. We could fix  that by replying to the query
  280%	colouring with the UUIDs for which we do not have sources, after
  281%	which the client retry the query-color request with all relevant
  282%	sources.
  283
  284:- dynamic
  285	gced_editors/1.  286
  287editor_max_idle_time(Time) :-
  288	setting(swish:editor_max_idle_time, Time).
  289
  290gc_editors :-
  291	get_time(Now),
  292	(   gced_editors(Then),
  293	    editor_max_idle_time(MaxIdle),
  294	    Now - Then < MaxIdle/3
  295	->  true
  296	;   retractall(gced_editors(_)),
  297	    asserta(gced_editors(Now)),
  298	    fail
  299	).
  300gc_editors :-
  301	editor_max_idle_time(MaxIdle),
  302	forall(garbage_editor(UUID, MaxIdle),
  303	       destroy_garbage_editor(UUID)).
  304
  305garbage_editor(UUID, TimeOut) :-
  306	get_time(Now),
  307	current_editor(UUID, _TB, _Role, _Lock, Created),
  308	Now - Created > TimeOut,
  309	(   editor_last_access(UUID, Access)
  310	->  Now - Access > TimeOut
  311	;   true
  312	).
  313
  314destroy_garbage_editor(UUID) :-
  315	fetch_editor(UUID, _TB), !,
  316	destroy_editor(UUID).
  317destroy_garbage_editor(_).
  318
  319%%	fetch_editor(+UUID, -MemFile) is semidet.
  320%
  321%	Fetch existing editor for source UUID.   Update  the last access
  322%	time. After success, the editor is   locked and must be released
  323%	using release_editor/1.
  324
  325fetch_editor(UUID, TB) :-
  326	current_editor(UUID, TB, Role, Lock, _),
  327	catch(mutex_lock(Lock), error(existence_error(mutex,_),_), fail),
  328	debug(cm(lock), 'Locked ~p', [UUID]),
  329	(   current_editor(UUID, TB, Role, Lock, _)
  330	->  update_access(UUID)
  331	;   mutex_unlock(Lock)
  332	).
  333
  334release_editor(UUID) :-
  335	current_editor(UUID, _TB, _Role, Lock, _),
  336	debug(cm(lock), 'Unlocked ~p', [UUID]),
  337	mutex_unlock(Lock).
  338
  339check_unlocked :-
  340	check_unlocked(unknown).
  341
  342%!	check_unlocked(+Reason)
  343%
  344%	Verify that all editors locked by this thread are unlocked
  345%	again.
  346
  347check_unlocked(Reason) :-
  348	thread_self(Me),
  349	current_editor(_UUID, _TB, _Role, Lock, _),
  350	mutex_property(Lock, status(locked(Me, _Count))), !,
  351	unlock(Me, Lock),
  352	print_message(error, locked(Reason, Me)),
  353	assertion(fail).
  354check_unlocked(_).
  355
  356unlock(Me, Lock) :-
  357	mutex_property(Lock, status(locked(Me, _Count))), !,
  358	mutex_unlock(Lock),
  359	unlock(Me, Lock).
  360unlock(_, _).
  361
  362%%	update_access(+UUID)
  363%
  364%	Update the registered last access. We only update if the time is
  365%	behind for more than a minute.
  366
  367update_access(UUID) :-
  368	get_time(Now),
  369	(   editor_last_access(UUID, Last),
  370	    Now-Last < 60
  371	->  true
  372	;   retractall(editor_last_access(UUID, _)),
  373	    asserta(editor_last_access(UUID, Now))
  374	).
  375
  376:- multifile
  377	prolog:xref_source_identifier/2,
  378	prolog:xref_open_source/2,
  379	prolog:xref_close_source/2.  380
  381prolog:xref_source_identifier(UUID, UUID) :-
  382	current_editor(UUID, _, _, _, _).
  383
  384%%	prolog:xref_open_source(+UUID, -Stream)
  385%
  386%	Open a source. As we cannot open   the same source twice we must
  387%	lock  it.  As  of  7.3.32   this    can   be  done  through  the
  388%	prolog:xref_close_source/2 hook. In older  versions   we  get no
  389%	callback on the close, so we must leave the editor unlocked.
  390
  391:- if(current_predicate(prolog_source:close_source/3)).  392prolog:xref_open_source(UUID, Stream) :-
  393	fetch_editor(UUID, TB),
  394	open_memory_file(TB, read, Stream).
  395
  396prolog:xref_close_source(UUID, Stream) :-
  397	release_editor(UUID),
  398	close(Stream).
  399:- else.  400prolog:xref_open_source(UUID, Stream) :-
  401	fetch_editor(UUID, TB),
  402	open_memory_file(TB, read, Stream),
  403	release_editor(UUID).
  404:- endif.  405
  406%%	codemirror_leave(+Request)
  407%
  408%	POST  handler  that  deals  with    destruction  of  our  mirror
  409%	associated  with  an  editor,   as    well   as  the  associated
  410%	cross-reference information.
  411
  412codemirror_leave(Request) :-
  413	call_cleanup(codemirror_leave_(Request),
  414		     check_unlocked).
  415
  416codemirror_leave_(Request) :-
  417	http_read_json_dict(Request, Data, []),
  418	(   atom_string(UUID, Data.get(uuid))
  419	->  debug(cm(leave), 'Leaving editor ~p', [UUID]),
  420	    (	fetch_editor(UUID, _TB)
  421	    ->	destroy_editor(UUID)
  422	    ;	debug(cm(leave), 'No editor for ~p', [UUID])
  423	    )
  424	;   debug(cm(leave), 'No editor?? (data=~p)', [Data])
  425	),
  426	reply_json_dict(true).
  427
  428%%	mark_changed(+MemFile, ?Changed) is det.
  429%
  430%	Mark that our cross-reference data might be obsolete
  431
  432mark_changed(MemFile, Changed) :-
  433	(   Changed == true,
  434	    current_editor(UUID, MemFile, _Role, _, _)
  435	->  retractall(xref_upto_data(UUID))
  436	;   true
  437	).
  438
  439%%	xref(+UUID) is det.
  440
  441xref(UUID) :-
  442	xref_upto_data(UUID), !.
  443xref(UUID) :-
  444	setup_call_cleanup(
  445	    fetch_editor(UUID, _TB),
  446	    ( xref_source_id(UUID, SourceId),
  447	      xref_state_module(UUID, Module),
  448	      xref_source(SourceId,
  449			  [ silent(true),
  450			    module(Module)
  451			  ]),
  452	      asserta(xref_upto_data(UUID))
  453	    ),
  454	    release_editor(UUID)).
  455
  456%%	xref_source_id(+Editor, -SourceID) is det.
  457%
  458%	SourceID is the xref source  identifier   for  Editor. As we are
  459%	using UUIDs we just use the editor.
  460
  461xref_source_id(UUID, UUID).
  462
  463%%	xref_state_module(+UUID, -Module) is semidet.
  464%
  465%	True if we must run the cross-referencing   in  Module. We use a
  466%	temporary module based on the UUID of the source.
  467
  468xref_state_module(UUID, UUID) :-
  469	(   module_property(UUID, class(temporary))
  470	->  true
  471	;   set_module(UUID:class(temporary)),
  472	    add_import_module(UUID, swish, start),
  473	    maplist(copy_flag(UUID, swish), [var_prefix])
  474	).
  475
  476copy_flag(Module, Application, Flag) :-
  477    current_prolog_flag(Application:Flag, Value), !,
  478    set_prolog_flag(Module:Flag, Value).
  479copy_flag(_, _, _).
  480
  481destroy_state_module(UUID) :-
  482	module_property(UUID, class(temporary)), !,
  483	'$destroy_module'(UUID).
  484destroy_state_module(_).
  485
  486
  487		 /*******************************
  488		 *	  SERVER TOKENS		*
  489		 *******************************/
  490
  491%%	codemirror_tokens(+Request)
  492%
  493%	HTTP POST handler that returns an array of tokens for the given
  494%	editor.
  495
  496codemirror_tokens(Request) :-
  497	setup_call_catcher_cleanup(
  498	    true,
  499	    codemirror_tokens_(Request),
  500	    Reason,
  501	    check_unlocked(Reason)).
  502
  503codemirror_tokens_(Request) :-
  504	http_read_json_dict(Request, Data, []),
  505	atom_string(UUID, Data.get(uuid)),
  506	debug(cm(tokens), 'Asking for tokens: ~p', [Data]),
  507	(   catch(shadow_editor(Data, TB), cm(Reason), true)
  508	->  (   var(Reason)
  509	    ->	call_cleanup(enriched_tokens(TB, Data, Tokens),
  510			     release_editor(UUID)),
  511		reply_json_dict(json{tokens:Tokens}, [width(0)])
  512	    ;	check_unlocked(Reason),
  513		change_failed(UUID, Reason)
  514	    )
  515	;   reply_json_dict(json{tokens:[[]]})
  516	),
  517	gc_editors.
  518
  519
  520enriched_tokens(TB, _Data, Tokens) :-		% source window
  521	current_editor(UUID, TB, source, _Lock, _), !,
  522	xref(UUID),
  523	server_tokens(TB, Tokens).
  524enriched_tokens(TB, Data, Tokens) :-		% query window
  525	json_source_id(Data.get(sourceID), SourceID), !,
  526	memory_file_to_string(TB, Query),
  527	with_mutex(swish_highlight_query,
  528		   prolog_colourise_query(Query, SourceID, colour_item(TB))),
  529	collect_tokens(TB, Tokens).
  530enriched_tokens(TB, _Data, Tokens) :-
  531	memory_file_to_string(TB, Query),
  532	prolog_colourise_query(Query, module(swish), colour_item(TB)),
  533	collect_tokens(TB, Tokens).
  534
  535%%	json_source_id(+Input, -SourceID)
  536%
  537%	Translate the Input, which is  either  a   string  or  a list of
  538%	strings into an  atom  or  list   of  atoms.  Older  versions of
  539%	SWI-Prolog only accept a single atom source id.
  540
  541:- if(current_predicate(prolog_colour:to_list/2)).  542json_source_id(StringList, SourceIDList) :-
  543	is_list(StringList),
  544	StringList \== [], !,
  545	maplist(string_source_id, StringList, SourceIDList).
  546:- else.				% old version (=< 7.3.7)
  547json_source_id([String|_], SourceID) :-
  548	maplist(string_source_id, String, SourceID).
  549:- endif.  550json_source_id(String, SourceID) :-
  551	string(String),
  552	string_source_id(String, SourceID).
  553
  554string_source_id(String, SourceID) :-
  555	atom_string(SourceID, String),
  556	(   fetch_editor(SourceID, _TB)
  557	->  release_editor(SourceID)
  558	;   true
  559	).
  560
  561
  562%%	shadow_editor(+Data, -MemoryFile) is det.
  563%
  564%	Get our shadow editor:
  565%
  566%	  1. If we have one, it is updated from either the text or the changes.
  567%	  2. If we have none, but there is a `text` property, create one
  568%	     from the text.
  569%	  3. If there is a `role` property, create an empty one.
  570%
  571%	This predicate fails if the server thinks we have an editor with
  572%	state that must be reused, but  this   is  not true (for example
  573%	because we have been restarted).
  574%
  575%	@throws cm(existence_error) if the target editor did not exist
  576%	@throws cm(out_of_sync) if the changes do not apply due to an
  577%	internal error or a lost message.
  578
  579shadow_editor(Data, TB) :-
  580	atom_string(UUID, Data.get(uuid)),
  581	setup_call_catcher_cleanup(
  582	    fetch_editor(UUID, TB),
  583	    once(update_editor(Data, UUID, TB)),
  584	    Catcher,
  585	    cleanup_update(Catcher, UUID)), !.
  586shadow_editor(Data, TB) :-
  587	Text = Data.get(text), !,
  588	atom_string(UUID, Data.uuid),
  589	create_editor(UUID, TB, Data),
  590	debug(cm(change), 'Create editor for ~p', [UUID]),
  591	debug(cm(change_text), 'Initialising editor to ~q', [Text]),
  592	insert_memory_file(TB, 0, Text).
  593shadow_editor(Data, TB) :-
  594	_{role:_} :< Data, !,
  595	atom_string(UUID, Data.uuid),
  596	create_editor(UUID, TB, Data).
  597shadow_editor(_Data, _TB) :-
  598	throw(cm(existence_error)).
  599
  600update_editor(Data, _UUID, TB) :-
  601	Text = Data.get(text), !,
  602	size_memory_file(TB, Size),
  603	delete_memory_file(TB, 0, Size),
  604	insert_memory_file(TB, 0, Text),
  605	mark_changed(TB, true).
  606update_editor(Data, UUID, TB) :-
  607	Changes = Data.get(changes), !,
  608	(   debug(cm(change), 'Patch editor for ~p', [UUID]),
  609	    maplist(apply_change(TB, Changed), Changes)
  610	->  true
  611	;   throw(cm(out_of_sync))
  612	),
  613	mark_changed(TB, Changed).
  614
  615cleanup_update(exit, _) :- !.
  616cleanup_update(_, UUID) :-
  617	release_editor(UUID).
  618
  619:- thread_local
  620	token/3.  621
  622%%	show_mirror(+Role) is det.
  623%%	server_tokens(+Role) is det.
  624%
  625%	These predicates help debugging the   server side. show_mirror/0
  626%	displays the text the server thinks is in the client editor. The
  627%	predicate server_tokens/1 dumps the token list.
  628%
  629%	@arg	Role is one of =source= or =query=, expressing the role of
  630%		the editor in the SWISH UI.
  631
  632:- public
  633	show_mirror/1,
  634	server_tokens/1.  635
  636show_mirror(Role) :-
  637	current_editor(_UUID, TB, Role, _Lock, _), !,
  638	memory_file_to_string(TB, String),
  639	write(user_error, String).
  640
  641server_tokens(Role) :-
  642	current_editor(_UUID, TB, Role, _Lock, _), !,
  643	enriched_tokens(TB, _{}, Tokens),
  644	print_term(Tokens, [output(user_error)]).
  645
  646%%	server_tokens(+TextBuffer, -Tokens) is det.
  647%
  648%	@arg	Tokens is a nested list of Prolog JSON terms.  Each group
  649%		represents the tokens found in a single toplevel term.
  650
  651server_tokens(TB, GroupedTokens) :-
  652	current_editor(UUID, TB, _Role, _Lock, _),
  653	setup_call_cleanup(
  654	    open_memory_file(TB, read, Stream),
  655	    ( set_stream_file(TB, Stream),
  656	      prolog_colourise_stream(Stream, UUID, colour_item(TB))
  657	    ),
  658	    close(Stream)),
  659	collect_tokens(TB, GroupedTokens).
  660
  661collect_tokens(TB, GroupedTokens) :-
  662	findall(Start-Token, json_token(TB, Start, Token), Pairs),
  663	keysort(Pairs, Sorted),
  664	pairs_values(Sorted, Tokens),
  665	group_by_term(Tokens, GroupedTokens).
  666
  667set_stream_file(_,_).			% TBD
  668
  669%%	group_by_term(+Tokens, -Nested) is det.
  670%
  671%	Group the tokens by  input   term.  This  simplifies incremental
  672%	updates of the token  list  at  the   client  sides  as  well as
  673%	re-syncronizing. This predicate relies on   the `fullstop` token
  674%	that is emitted at the end of each input term.
  675
  676group_by_term([], []) :- !.
  677group_by_term(Flat, [Term|Grouped]) :-
  678	take_term(Flat, Term, Rest),
  679	group_by_term(Rest, Grouped).
  680
  681take_term([], [], []).
  682take_term([H|T0], [H|T], R) :-
  683	(   ends_term(H.get(type))
  684	->  T = [],
  685	    R = T0
  686	;   take_term(T0, T, R)
  687	).
  688
  689ends_term(fullstop).
  690ends_term(syntax_error).
  691
  692%%	json_token(+TB, -Start, -JSON) is nondet.
  693%
  694%	Extract the stored terms.
  695%
  696%	@tbd	We could consider to collect the attributes in the
  697%		colour_item/4 callback and maintain a global variable
  698%		instead of using assert/retract.  Most likely that would
  699%		be faster.  Need to profile to check the bottleneck.
  700
  701json_token(TB, Start, Token) :-
  702	retract(token(Style, Start0, Len)),
  703	debug(color, 'Trapped ~q.', [token(Style, Start0, Len)]),
  704	(   atomic_special(Style, Start0, Len, TB, Type, Attrs)
  705	->  Start = Start0
  706	;   style(Style, Type0, Attrs0)
  707	->  (   Type0 = StartType-EndType
  708	    ->	(   Start = Start0,
  709		    Type  = StartType
  710		;   Start is Start0+Len-1,
  711		    Type  = EndType
  712		)
  713	    ;	Type = Type0,
  714		Start = Start0
  715	    ),
  716	    json_attributes(Attrs0, Attrs, TB, Start0, Len)
  717	),
  718	dict_create(Token, json, [type(Type)|Attrs]).
  719
  720atomic_special(atom, Start, Len, TB, Type, Attrs) :-
  721	memory_file_substring(TB, Start, 1, _, FirstChar),
  722	(   FirstChar == "'"
  723	->  Type = qatom,
  724	    Attrs = []
  725	;   char_type(FirstChar, upper)
  726	->  Type = uatom,			% var_prefix in effect
  727	    Attrs = []
  728	;   Type = atom,
  729	    (   Len =< 5			% solo characters, neck, etc.
  730	    ->  memory_file_substring(TB, Start, Len, _, Text),
  731	        Attrs = [text(Text)]
  732	    ;   Attrs = []
  733	    )
  734	).
  735
  736json_attributes([], [], _, _, _).
  737json_attributes([H0|T0], Attrs, TB, Start, Len) :-
  738	json_attribute(H0, Attrs, T, TB, Start, Len), !,
  739	json_attributes(T0, T, TB, Start, Len).
  740json_attributes([_|T0], T, TB, Start, Len) :-
  741	json_attributes(T0, T, TB, Start, Len).
  742
  743json_attribute(text, [text(Text)|T], T, TB, Start, Len) :- !,
  744	memory_file_substring(TB, Start, Len, _, Text).
  745json_attribute(line(File:Line), [line(Line),file(File)|T], T, _, _, _) :- !.
  746json_attribute(Term, [Term|T], T, _, _, _).
  747
  748colour_item(_TB, Style, Start, Len) :-
  749	(   style(Style)
  750	->  assertz(token(Style, Start, Len))
  751	;   debug(color, 'Ignored ~q.', [token(Style, Start, Len)])
  752	).
  753
  754%%	style(+StyleIn) is semidet.
  755%%	style(+StyleIn, -SWISHType:atomOrPair, -Attributes:list)
  756%
  757%	Declare    that    we    map    StyleIn    as    generated    by
  758%	library(prolog_colour) into a token of type SWISHType, providing
  759%	additional context information based on  Attributes. Elements of
  760%	Attributes are terms of the form Name(Value) or the atom =text=.
  761%	The latter is mapped to text(String),  where String contains the
  762%	text that matches the token character range.
  763%
  764%	The  resulting  JSON  token  object    has  a  property  =type=,
  765%	containing  the  SWISHType  and  the    properties   defined  by
  766%	Attributes.
  767%
  768%	Additional translations can be defined by   adding rules for the
  769%	multifile predicate swish:style/3. The base   type, which refers
  770%	to the type generated by the   SWISH tokenizer must be specified
  771%	by adding an  attribute  base(BaseType).   For  example,  if the
  772%	colour system classifies an  atom  as   refering  to  a database
  773%	column, library(prolog_colour) may emit  db_column(Name) and the
  774%	following rule should ensure consistent mapping:
  775%
  776%	  ==
  777%	  swish_highlight:style(db_column(Name),
  778%				db_column, [text, base(atom)]).
  779%	  ==
  780
  781:- multifile
  782	style/3.  783
  784style(Style) :-
  785	style(Style, _, _).
  786
  787style(neck(Neck),     neck, [ text(Text) ]) :-
  788	neck_text(Neck, Text).
  789style(head(Class, Head), Type, [ text, arity(Arity) ]) :-
  790	goal_arity(Head, Arity),
  791	head_type(Class, Type).
  792style(goal(Class, Goal), Type, [ text, arity(Arity) | More ]) :-
  793	goal_arity(Goal, Arity),
  794	goal_type(Class, Type, More).
  795style(file_no_depend(Path), file_no_depends,		   [text, path(Path)]).
  796style(file(Path),	 file,				   [text, path(Path)]).
  797style(nofile,		 nofile,			   [text]).
  798style(option_name,	 option_name,			   [text]).
  799style(no_option_name,	 no_option_name,		   [text]).
  800style(flag_name(_Flag),	 flag_name,			   [text]).
  801style(no_flag_name(_Flag), no_flag_name,		   [text]).
  802style(fullstop,		 fullstop,			   []).
  803style(var,		 var,				   [text]).
  804style(singleton,	 singleton,			   [text]).
  805style(string,		 string,			   []).
  806style(codes,		 codes,				   []).
  807style(chars,		 chars,				   []).
  808style(atom,		 atom,				   []).
  809style(meta(_Spec),	 meta,				   []).
  810style(op_type(_Type),	 op_type,			   [text]).
  811style(functor,		 functor,			   [text]).
  812style(control,		 control,			   [text]).
  813style(delimiter,	 delimiter,			   [text]).
  814style(identifier,	 identifier,			   [text]).
  815style(module(_Module),   module,			   [text]).
  816style(error,		 error,				   [text]).
  817style(type_error(Expect), error,		      [text,expected(Expect)]).
  818style(syntax_error(_Msg,_Pos), syntax_error,		   []).
  819style(instantiation_error, instantiation_error,	           [text]).
  820style(predicate_indicator, atom,			   [text]).
  821style(predicate_indicator, atom,			   [text]).
  822style(arity,		 int,				   []).
  823style(int,		 int,				   []).
  824style(float,		 float,				   []).
  825style(qq(open),		 qq_open,			   []).
  826style(qq(sep),		 qq_sep,			   []).
  827style(qq(close),	 qq_close,			   []).
  828style(qq_type,		 qq_type,			   [text]).
  829style(dict_tag,		 tag,				   [text]).
  830style(dict_key,		 key,				   [text]).
  831style(dict_sep,		 sep,				   []).
  832style(func_dot,		 atom,				   [text(.)]).
  833style(dict_return_op,	 atom,				   [text(:=)]).
  834style(dict_function(F),  dict_function,			   [text(F)]).
  835style(empty_list,	 list_open-list_close,		   []).
  836style(list,		 list_open-list_close,		   []).
  837style(dcg(terminal),	 list_open-list_close,		   []).
  838style(dcg(string),	 string_terminal,		   []).
  839style(dcg(plain),	 brace_term_open-brace_term_close, []).
  840style(brace_term,	 brace_term_open-brace_term_close, []).
  841style(dict_content,	 dict_open-dict_close,             []).
  842style(expanded,		 expanded,			   [text]).
  843style(comment_string,	 comment_string,		   []). % up to 7.3.33
  844style(comment(string),	 comment_string,		   []). % after 7.3.33
  845style(ext_quant,	 ext_quant,			   []).
  846style(unused_import,	 unused_import,			   [text]).
  847style(undefined_import,	 undefined_import,		   [text]).
  848					% from library(http/html_write)
  849style(html(_Element),	 html,				   []).
  850style(entity(_Element),	 entity,			   []).
  851style(html_attribute(_), html_attribute,		   []).
  852style(sgml_attr_function,sgml_attr_function,		   []).
  853style(http_location_for_id(_), http_location_for_id,       []).
  854style(http_no_location_for_id(_), http_no_location_for_id, []).
  855					% XPCE support
  856style(method(send),	 xpce_method,			   [text]).
  857style(method(get),	 xpce_method,			   [text]).
  858style(class(built_in,_Name),	  xpce_class_built_in,	   [text]).
  859style(class(library(File),_Name), xpce_class_lib,	   [text, file(File)]).
  860style(class(user(File),_Name),	  xpce_class_user,	   [text, file(File)]).
  861style(class(user,_Name),	  xpce_class_user,	   [text]).
  862style(class(undefined,_Name),	  xpce_class_undef,	   [text]).
  863
  864neck_text(clause,       (:-)).
  865neck_text(grammar_rule, (-->)).
  866neck_text(method(send), (:->)).
  867neck_text(method(get),  (:<-)).
  868neck_text(directive,    (:-)).
  869
  870head_type(exported,	 head_exported).
  871head_type(public(_),	 head_public).
  872head_type(extern(_),	 head_extern).
  873head_type(dynamic,	 head_dynamic).
  874head_type(multifile,	 head_multifile).
  875head_type(unreferenced,	 head_unreferenced).
  876head_type(hook,		 head_hook).
  877head_type(meta,		 head_meta).
  878head_type(constraint(_), head_constraint).
  879head_type(imported,	 head_imported).
  880head_type(built_in,	 head_built_in).
  881head_type(iso,		 head_iso).
  882head_type(def_iso,	 head_def_iso).
  883head_type(def_swi,	 head_def_swi).
  884head_type(_,		 head).
  885
  886goal_type(built_in,	      goal_built_in,	 []).
  887goal_type(imported(File),     goal_imported,	 [file(File)]).
  888goal_type(autoload(File),     goal_autoload,	 [file(File)]).
  889goal_type(global,	      goal_global,	 []).
  890goal_type(undefined,	      goal_undefined,	 []).
  891goal_type(thread_local(Line), goal_thread_local, [line(Line)]).
  892goal_type(dynamic(Line),      goal_dynamic,	 [line(Line)]).
  893goal_type(multifile(Line),    goal_multifile,	 [line(Line)]).
  894goal_type(expanded,	      goal_expanded,	 []).
  895goal_type(extern(_),	      goal_extern,	 []).
  896goal_type(recursion,	      goal_recursion,	 []).
  897goal_type(meta,		      goal_meta,	 []).
  898goal_type(foreign(_),	      goal_foreign,	 []).
  899goal_type(local(Line),	      goal_local,	 [line(Line)]).
  900goal_type(constraint(Line),   goal_constraint,	 [line(Line)]).
  901goal_type(not_callable,	      goal_not_callable, []).
  902
  903%%	goal_arity(+Goal, -Arity) is det.
  904%
  905%	Get the arity of a goal safely in SWI7
  906
  907goal_arity(Goal, Arity) :-
  908	(   compound(Goal)
  909	->  compound_name_arity(Goal, _, Arity)
  910	;   Arity = 0
  911	).
  912
  913		 /*******************************
  914		 *	 HIGHLIGHT CONFIG	*
  915		 *******************************/
  916
  917:- multifile
  918	swish_config:config/2,
  919	css/3.				% ?Context, ?Selector, -Attributes
  920
  921%%	swish_config:config(-Name, -Styles) is nondet.
  922%
  923%	Provides the object `config.swish.style`,  a   JSON  object that
  924%	maps   style   properties   of    user-defined   extensions   of
  925%	library(prolog_colour). This info is  used   by  the server-side
  926%	colour engine to populate the CodeMirror styles.
  927%
  928%	@tbd	Provide summary information
  929
  930swish_config:config(cm_style, Styles) :-
  931	findall(Name-Style, highlight_style(Name, Style), Pairs),
  932	keysort(Pairs, Sorted),
  933	remove_duplicate_styles(Sorted, Unique),
  934	dict_pairs(Styles, json, Unique).
  935swish_config:config(cm_hover_style, Styles) :-
  936	findall(Sel-Attrs, css_dict(hover, Sel, Attrs), Pairs),
  937	dict_pairs(Styles, json, Pairs).
  938
  939remove_duplicate_styles([], []).
  940remove_duplicate_styles([H|T0], [H|T]) :-
  941	H = K-_,
  942	remove_same(K, T0, T1),
  943	remove_duplicate_styles(T1, T).
  944
  945remove_same(K, [K-_|T0], T) :- !,
  946	remove_same(K, T0, T).
  947remove_same(_, Rest, Rest).
  948
  949highlight_style(StyleName, Style) :-
  950	style(Term, StyleName, _),
  951	atom(StyleName),
  952	(   prolog_colour:style(Term, Attrs0)
  953        ->  maplist(css_style, Attrs0, Attrs),
  954	    dict_create(Style, json, Attrs)
  955	).
  956
  957css_style(bold(true),      'font-weight'(bold)) :- !.
  958css_style(underline(true), 'text-decoration'(underline)) :- !.
  959css_style(colour(Name), color(RGB)) :-
  960	x11_color(Name, R, G, B),
  961	format(atom(RGB), '#~|~`0t~16r~2+~`0t~16r~2+~`0t~16r~2+', [R,G,B]).
  962css_style(Style, Style).
  963
  964%%	x11_color(+Name, -R, -G, -B)
  965%
  966%	True if RGB is the color for the named X11 color.
  967
  968x11_color(Name, R, G, B) :-
  969	(   x11_color_cache(_,_,_,_)
  970	->  true
  971	;   load_x11_colours
  972	),
  973	x11_color_cache(Name, R, G, B).
  974
  975:- dynamic
  976	x11_color_cache/4.  977
  978load_x11_colours :-
  979	source_file(load_x11_colours, File),
  980	file_directory_name(File, Dir),
  981	directory_file_path(Dir, 'rgb.txt', RgbFile),
  982	setup_call_cleanup(
  983	    open(RgbFile, read, In),
  984	    ( lazy_list(lazy_read_lines(In, [as(string)]), List),
  985	      maplist(assert_colour, List)
  986	    ),
  987	    close(In)).
  988
  989assert_colour(String) :-
  990	split_string(String, "\s\t\r", "\s\t\r", [RS,GS,BS|NameParts]),
  991	number_string(R, RS),
  992	number_string(G, GS),
  993	number_string(B, BS),
  994	atomic_list_concat(NameParts, '_', Name0),
  995	downcase_atom(Name0, Name),
  996	assertz(x11_color_cache(Name, R, G, B)).
  997
  998%%	css(?Context, ?Selector, -Style) is nondet.
  999%
 1000%	Multifile hook to define additional style to apply in a specific
 1001%	context.  Currently defined contexts are:
 1002%
 1003%	  - hover
 1004%	  Used for CodeMirror hover extension.
 1005%
 1006%	@arg Selector is a CSS selector, which is refined by Context
 1007%	@arg Style is a list of Name(Value) terms.
 1008
 1009css_dict(Context, Selector, Style) :-
 1010	css(Context, Selector, Attrs0),
 1011	maplist(css_style, Attrs0, Attrs),
 1012	dict_create(Style, json, Attrs).
 1013
 1014
 1015		 /*******************************
 1016		 *	       INFO		*
 1017		 *******************************/
 1018
 1019:- multifile
 1020	prolog:predicate_summary/2. 1021
 1022%%	token_info(+Request)
 1023%
 1024%	HTTP handler that provides information  about a token.
 1025
 1026token_info(Request) :-
 1027	http_parameters(Request, [], [form_data(Form)]),
 1028	maplist(type_convert, Form, Values),
 1029	dict_create(Token, token, Values),
 1030	reply_html_page(plain,
 1031			title('token info'),
 1032			\token_info_or_none(Token)).
 1033
 1034type_convert(Name=Atom, Name=Number) :-
 1035	atom_number(Atom, Number), !.
 1036type_convert(NameValue, NameValue).
 1037
 1038
 1039token_info_or_none(Token) -->
 1040	token_info(Token), !.
 1041token_info_or_none(_) -->
 1042	html(span(class('token-noinfo'), 'No info available')).
 1043
 1044%%	token_info(+Token:dict)// is det.
 1045%
 1046%	Generate HTML, providing details about Token.   Token is a dict,
 1047%	providing  the  enriched  token  as  defined  by  style/3.  This
 1048%	multifile non-terminal can be hooked to provide details for user
 1049%	defined style extensions.
 1050
 1051:- multifile token_info//1. 1052
 1053token_info(Token) -->
 1054	{ _{type:Type, text:Name, arity:Arity} :< Token,
 1055	  goal_type(_, Type, _), !,
 1056	  ignore(token_predicate_module(Token, Module)),
 1057	  text_arity_pi(Name, Arity, PI),
 1058	  predicate_info(Module:PI, Info)
 1059	},
 1060	pred_info(Info).
 1061
 1062pred_info([]) -->
 1063	html(span(class('pred-nosummary'), 'No help available')).
 1064pred_info([Info|_]) -->			% TBD: Ambiguous
 1065	(pred_tags(Info)     -> [];[]),
 1066	(pred_summary(Info)  -> [];[]).
 1067
 1068pred_tags(Info) -->
 1069	{ Info.get(iso) == true },
 1070	html(span(class('pred-tag'), 'ISO')).
 1071
 1072pred_summary(Info) -->
 1073	html(span(class('pred-summary'), Info.get(summary))).
 1074
 1075%%	token_predicate_module(+Token, -Module) is semidet.
 1076%
 1077%	Try to extract the module from the token.
 1078
 1079token_predicate_module(Token, Module) :-
 1080	source_file_property(Token.get(file), module(Module)), !.
 1081
 1082text_arity_pi('[', 2, consult/1) :- !.
 1083text_arity_pi(']', 2, consult/1) :- !.
 1084text_arity_pi(Name, Arity, Name/Arity).
 1085
 1086
 1087%%	predicate_info(+PI, -Info:list(dict)) is det.
 1088%
 1089%	Info is a list of dicts providing details about predicates that
 1090%	match PI.  Fields in dict are:
 1091%
 1092%	  - module:Atom
 1093%	  Module of the predicate
 1094%	  - name:Atom
 1095%	  Name of the predicate
 1096%	  - arity:Integer
 1097%	  Arity of the predicate
 1098%	  - summary:Text
 1099%	  Summary text extracted from the system manual or PlDoc
 1100%	  - iso:Boolean
 1101%	  Presend and =true= if the predicate is an ISO predicate
 1102
 1103predicate_info(PI, Info) :-
 1104	PI = Module:Name/Arity,
 1105	findall(Dict,
 1106		( setof(Key-Value,
 1107			predicate_info(PI, Key, Value),
 1108			Pairs),
 1109		  dict_pairs(Dict, json,
 1110			     [ module - Module,
 1111			       name   - Name,
 1112			       arity  - Arity
 1113			     | Pairs
 1114			     ])
 1115		),
 1116		Info).
 1117
 1118%%	predicate_info(?PI, -Key, -Value) is nondet.
 1119%
 1120%	Find information about predicates from   the  system, manual and
 1121%	PlDoc. First, we  deal  with  ISO   predicates  that  cannot  be
 1122%	redefined and are documented in the   manual. Next, we deal with
 1123%	predicates that are documented in  the   manual.
 1124%
 1125%	@bug: Handling predicates documented  in   the  manual  is buggy
 1126%	because their definition may  be  overruled   by  the  user.  We
 1127%	probably must include the file into the equation.
 1128
 1129					% ISO predicates
 1130predicate_info(Module:Name/Arity, Key, Value) :-
 1131	functor(Head, Name, Arity),
 1132	predicate_property(system:Head, iso), !,
 1133	ignore(Module = system),
 1134	(   catch(once(predicate(Name, Arity, Summary, _, _)), _, fail),
 1135	    Key = summary,
 1136	    Value = Summary
 1137	;   Key = iso,
 1138	    Value = true
 1139	).
 1140predicate_info(_Module:Name/Arity, summary, Summary) :-
 1141	catch(once(predicate(Name, Arity, Summary, _, _)), _, fail), !.
 1142predicate_info(PI, summary, Summary) :-	% PlDoc
 1143	once(prolog:predicate_summary(PI, Summary))