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