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