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-2023, VU University Amsterdam
    7			      CWI, Amsterdam
    8			      SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(swish_highlight,
   38	  [ current_highlight_state/2,		% +UUID, -State
   39	    man_predicate_summary/2		% +PI, -Summary
   40	  ]).   41:- use_module(library(debug)).   42:- use_module(library(settings)).   43:- use_module(library(http/http_dispatch)).   44:- use_module(library(http/html_write)).   45:- use_module(library(http/http_json)).   46:- use_module(library(http/http_path), []).   47:- use_module(library(http/http_parameters)).   48:- use_module(library(http/http_cors)).   49:- use_module(library(pairs)).   50:- use_module(library(apply)).   51:- use_module(library(error)).   52:- use_module(library(prolog_xref)).   53:- use_module(library(memfile)).   54:- use_module(library(prolog_colour)).   55:- use_module(library(lazy_lists)).   56:- if(exists_source(library(pldoc/man_index))).   57:- use_module(library(pldoc/man_index)).   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").

   81		 /*******************************
   82		 *	  SHADOW EDITOR		*
   83		 *******************************/

 codemirror_change(+Request)

Handle changes to the codemirror instances. These are sent to us using a POST request. The request a POSTed JSON object containing:

• uuid: string holding the editor's UUID
• change: the change object, which holds:
  • from: Start position as {line:Line, ch:Ch}
  • to: End position
  • removed: list(atom) of removed text
  • text: list(atom) of inserted text
  • origin: what caused this change event
  • next: optional next change event.

Reply is JSON and either 200 with true or 409 indicating that the editor is not known.

  103codemirror_change(Request) :-
  104	memberchk(method(options), Request),
  105	!,
  106	cors_enable(Request,
  107		    [ methods([post])
  108		    ]),
  109	format('~n').
  110codemirror_change(Request) :-
  111	cors_enable,
  112	call_cleanup(codemirror_change_(Request),
  113		     check_unlocked).
  114
  115codemirror_change_(Request) :-
  116	http_read_json_dict(Request, Change, []),
  117	debug(cm(change), 'Change ~p', [Change]),
  118	atom_string(UUID, Change.uuid),
  119	catch(shadow_editor(Change, TB),
  120	      cm(Reason), true),
  121	(   var(Reason)
  122	->  (	catch(apply_change(TB, Changed, Change.change),
  123		      cm(outofsync), fail)
  124	    ->  mark_changed(TB, Changed),
  125		release_editor(UUID),
  126		reply_json_dict(true)
  127	    ;	destroy_editor(UUID),
  128		change_failed(UUID, outofsync)
  129	    )
  130	;   change_failed(UUID, Reason)
  131	).
  132
  133change_failed(UUID, Reason) :-
  134	reply_json_dict(json{ type:Reason,
  135			      object:UUID
  136			    },
  137			[status(409)]).

 apply_change(+TB, -Changed, +Changes) is det

Note that the argument order is like this to allow for maplist.

Arguments:

Changed

- is left unbound if there are no changes or unified to true if something has changed.

throws

- cm(outofsync) if an inconsistent delete is observed.

  149apply_change(_, _Changed, []) :- !.
  150apply_change(TB, Changed, Change) :-
  151	_{from:From} :< Change,
  152	Line is From.line+1,
  153	memory_file_line_position(TB, Line, From.ch, ChPos),
  154	remove(Change.removed, TB, ChPos, Changed),
  155	insert(Change.text, TB, ChPos, _End, Changed),
  156	(   Next = Change.get(next)
  157	->  apply_change(TB, Changed, Next)
  158	;   true
  159	).
  160
  161remove([], _, _, _) :- !.
  162remove([H|T], TB, ChPos, Changed) :-
  163	string_length(H, Len),
  164	(   T == []
  165	->  DLen is Len
  166	;   DLen is Len+1
  167	),
  168	(   DLen == 0
  169	->  true
  170	;   Changed = true,
  171	    memory_file_substring(TB, ChPos, Len, _, Text),
  172	    (	Text == H
  173	    ->	true
  174	    ;	throw(cm(outofsync))
  175	    ),
  176	    delete_memory_file(TB, ChPos, DLen)
  177	),
  178	remove(T, TB, ChPos, Changed).
  179
  180insert([], _, ChPos, ChPos, _) :- !.
  181insert([H|T], TB, ChPos0, ChPos, Changed) :-
  182	(   H == ""
  183	->  Len	= 0
  184	;   Changed = true,
  185	    string_length(H, Len),
  186	    debug(cm(change_text), 'Insert ~q at ~d', [H, ChPos0]),
  187	    insert_memory_file(TB, ChPos0, H)
  188	),
  189	ChPos1 is ChPos0+Len,
  190	(   T == []
  191	->  ChPos2 = ChPos1
  192	;   debug(cm(change_text), 'Adding newline at ~d', [ChPos1]),
  193	    Changed = true,
  194	    insert_memory_file(TB, ChPos1, '\n'),
  195	    ChPos2 is ChPos1+1
  196	),
  197	insert(T, TB, ChPos2, ChPos, Changed).
  198
  199:- dynamic
  200	current_editor/5,		% UUID, MemFile, Role, Lock, Time
  201	editor_last_access/2,		% UUID, Time
  202	xref_upto_data/1.		% UUID

 create_editor(+UUID, -Editor, +Change) is det

Create a new editor for source UUID from Change. The editor is created in a locked state and must be released using release_editor/1 before it can be publically used.

  210create_editor(UUID, Editor, Change) :-
  211	must_be(atom, UUID),
  212	uuid_like(UUID),
  213	new_memory_file(Editor),
  214	(   RoleString = Change.get(role)
  215	->  atom_string(Role, RoleString)
  216	;   Role = source
  217	),
  218	get_time(Now),
  219	mutex_create(Lock),
  220	with_mutex(swish_create_editor,
  221		   register_editor(UUID, Editor, Role, Lock, Now)), !.
  222create_editor(UUID, Editor, _Change) :-
  223	fetch_editor(UUID, Editor).
  224
  225% editor and lock are left to symbol-GC if this fails.
  226register_editor(UUID, Editor, Role, Lock, Now) :-
  227	\+ current_editor(UUID, _, _, _, _),
  228	mutex_lock(Lock),
  229	asserta(current_editor(UUID, Editor, Role, Lock, Now)).

 current_highlight_state(?UUID, -State) is nondet

Return info on the current highlighter

  235current_highlight_state(UUID,
  236			highlight{data:Editor,
  237				  role:Role,
  238				  created:Created,
  239				  lock:Lock,
  240				  access:Access
  241				 }) :-
  242	current_editor(UUID, Editor, Role, Lock, Created),
  243	(   editor_last_access(Editor, Access)
  244	->  true
  245	;   Access = Created
  246	).

 uuid_like(+UUID) is semidet

Do some sanity checking on the UUID because we use it as a temporary module name and thus we must be quite sure it will not conflict with anything.

  255uuid_like(UUID) :-
  256	split_string(UUID, "-", "", Parts),
  257	maplist(string_length, Parts, [8,4,4,4,12]),
  258	\+ current_editor(UUID, _, _, _, _).

 destroy_editor(+UUID)

Destroy source admin UUID: the shadow text (a memory file), the XREF data and the module used for cross-referencing. The editor must be acquired using fetch_editor/2 before it can be destroyed.

  267destroy_editor(UUID) :-
  268	must_be(atom, UUID),
  269	current_editor(UUID, Editor, _, Lock, _), !,
  270	mutex_unlock(Lock),
  271	retractall(xref_upto_data(UUID)),
  272	retractall(editor_last_access(UUID, _)),
  273	(   xref_source_id(UUID, SourceID)
  274	->  xref_clean(SourceID),
  275	    destroy_state_module(UUID)
  276	;   true
  277	),
  278	% destroy after xref_clean/1 to make xref_source_identifier/2 work.
  279	retractall(current_editor(UUID, Editor, _, _, _)),
  280	free_memory_file(Editor).
  281destroy_editor(_).

 gc_editors

Garbage collect all editors that have not been accessed for 60 minutes.

To be done

- Normally, deleting a highlight state can be done aggressively as it will be recreated on demand. But, coloring a query passes the UUIDs of related sources and as yet there is no way to restore this. We could fix that by replying to the query colouring with the UUIDs for which we do not have sources, after which the client retry the query-color request with all relevant sources.

  296:- dynamic
  297	gced_editors/1.  298
  299editor_max_idle_time(Time) :-
  300	setting(swish:editor_max_idle_time, Time).
  301
  302gc_editors :-
  303	get_time(Now),
  304	(   gced_editors(Then),
  305	    editor_max_idle_time(MaxIdle),
  306	    Now - Then < MaxIdle/3
  307	->  true
  308	;   retractall(gced_editors(_)),
  309	    asserta(gced_editors(Now)),
  310	    fail
  311	).
  312gc_editors :-
  313	editor_max_idle_time(MaxIdle),
  314	forall(garbage_editor(UUID, MaxIdle),
  315	       destroy_garbage_editor(UUID)).
  316
  317garbage_editor(UUID, TimeOut) :-
  318	get_time(Now),
  319	current_editor(UUID, _TB, _Role, _Lock, Created),
  320	Now - Created > TimeOut,
  321	(   editor_last_access(UUID, Access)
  322	->  Now - Access > TimeOut
  323	;   true
  324	).
  325
  326destroy_garbage_editor(UUID) :-
  327	fetch_editor(UUID, _TB), !,
  328	destroy_editor(UUID).
  329destroy_garbage_editor(_).

 fetch_editor(+UUID, -MemFile) is semidet

Fetch existing editor for source UUID. Update the last access time. After success, the editor is locked and must be released using release_editor/1.

  337fetch_editor(UUID, TB) :-
  338	current_editor(UUID, TB, Role, Lock, _),
  339	catch(mutex_lock(Lock), error(existence_error(mutex,_),_), fail),
  340	debug(cm(lock), 'Locked ~p', [UUID]),
  341	(   current_editor(UUID, TB, Role, Lock, _)
  342	->  update_access(UUID)
  343	;   mutex_unlock(Lock)
  344	).
  345
  346release_editor(UUID) :-
  347	current_editor(UUID, _TB, _Role, Lock, _),
  348	debug(cm(lock), 'Unlocked ~p', [UUID]),
  349	mutex_unlock(Lock).
  350
  351check_unlocked :-
  352	check_unlocked(unknown).

 check_unlocked(+Reason)

Verify that all editors locked by this thread are unlocked again.

  359check_unlocked(Reason) :-
  360	thread_self(Me),
  361	current_editor(_UUID, _TB, _Role, Lock, _),
  362	mutex_property(Lock, status(locked(Me, _Count))), !,
  363	unlock(Me, Lock),
  364	print_message(error, locked(Reason, Me)),
  365	assertion(fail).
  366check_unlocked(_).
  367
  368unlock(Me, Lock) :-
  369	mutex_property(Lock, status(locked(Me, _Count))), !,
  370	mutex_unlock(Lock),
  371	unlock(Me, Lock).
  372unlock(_, _).

 update_access(+UUID)

Update the registered last access. We only update if the time is behind for more than a minute.

  379update_access(UUID) :-
  380	get_time(Now),
  381	(   editor_last_access(UUID, Last),
  382	    Now-Last < 60
  383	->  true
  384	;   retractall(editor_last_access(UUID, _)),
  385	    asserta(editor_last_access(UUID, Now))
  386	).
  387
  388:- multifile
  389	prolog:xref_source_identifier/2,
  390	prolog:xref_open_source/2,
  391	prolog:xref_close_source/2.  392
  393prolog:xref_source_identifier(UUID, UUID) :-
  394	current_editor(UUID, _, _, _, _).

 prolog:xref_open_source(+UUID, -Stream)

Open a source. As we cannot open the same source twice we must lock it. As of 7.3.32 this can be done through the prolog:xref_close_source/2 hook. In older versions we get no callback on the close, so we must leave the editor unlocked.

  403:- if(current_predicate(prolog_source:close_source/3)).  404prolog:xref_open_source(UUID, Stream) :-
  405	fetch_editor(UUID, TB),
  406	open_memory_file(TB, read, Stream).
  407
  408prolog:xref_close_source(UUID, Stream) :-
  409	release_editor(UUID),
  410	close(Stream).
  411:- else.  412prolog:xref_open_source(UUID, Stream) :-
  413	fetch_editor(UUID, TB),
  414	open_memory_file(TB, read, Stream),
  415	release_editor(UUID).
  416:- endif.

 codemirror_leave(+Request)

POST handler that deals with destruction of our mirror associated with an editor, as well as the associated cross-reference information.

  424codemirror_leave(Request) :-
  425	memberchk(method(options), Request),
  426	!,
  427	cors_enable(Request,
  428		    [ methods([post])
  429		    ]),
  430	format('~n').
  431codemirror_leave(Request) :-
  432	cors_enable,
  433	call_cleanup(codemirror_leave_(Request),
  434		     check_unlocked).
  435
  436codemirror_leave_(Request) :-
  437	http_read_json_dict(Request, Data, []),
  438	(   atom_string(UUID, Data.get(uuid))
  439	->  debug(cm(leave), 'Leaving editor ~p', [UUID]),
  440	    (	fetch_editor(UUID, _TB)
  441	    ->	destroy_editor(UUID)
  442	    ;	debug(cm(leave), 'No editor for ~p', [UUID])
  443	    )
  444	;   debug(cm(leave), 'No editor?? (data=~p)', [Data])
  445	),
  446	reply_json_dict(true).

 mark_changed(+MemFile, ?Changed) is det

Mark that our cross-reference data might be obsolete

  452mark_changed(MemFile, Changed) :-
  453	(   Changed == true,
  454	    current_editor(UUID, MemFile, _Role, _, _)
  455	->  retractall(xref_upto_data(UUID))
  456	;   true
  457	).

 xref(+UUID) is det

  461xref(UUID) :-
  462	xref_upto_data(UUID), !.
  463xref(UUID) :-
  464	setup_call_cleanup(
  465	    fetch_editor(UUID, _TB),
  466	    ( xref_source_id(UUID, SourceId),
  467	      xref_state_module(UUID, Module),
  468	      xref_source(SourceId,
  469			  [ silent(true),
  470			    module(Module)
  471			  ]),
  472	      asserta(xref_upto_data(UUID))
  473	    ),
  474	    release_editor(UUID)).

 xref_source_id(+Editor, -SourceID) is det

SourceID is the xref source identifier for Editor. As we are using UUIDs we just use the editor.

  481xref_source_id(UUID, UUID).

 xref_state_module(+UUID, -Module) is semidet

True if we must run the cross-referencing in Module. We use a temporary module based on the UUID of the source.

  488xref_state_module(UUID, UUID) :-
  489	(   module_property(UUID, class(temporary))
  490	->  true
  491	;   set_module(UUID:class(temporary)),
  492	    add_import_module(UUID, swish, start),
  493	    maplist(copy_flag(UUID, swish), [var_prefix])
  494	).
  495
  496copy_flag(Module, Application, Flag) :-
  497    current_prolog_flag(Application:Flag, Value), !,
  498    set_prolog_flag(Module:Flag, Value).
  499copy_flag(_, _, _).
  500
  501destroy_state_module(UUID) :-
  502	module_property(UUID, class(temporary)), !,
  503	'$destroy_module'(UUID).
  504destroy_state_module(_).
  505
  506
  507		 /*******************************
  508		 *	  SERVER TOKENS		*
  509		 *******************************/

 codemirror_tokens(+Request)

HTTP POST handler that returns an array of tokens for the given editor.

  516codemirror_tokens(Request) :-
  517	memberchk(method(options), Request),
  518	!,
  519	cors_enable(Request,
  520		    [ methods([post])
  521		    ]),
  522	format('~n').
  523codemirror_tokens(Request) :-
  524	cors_enable,
  525	setup_call_catcher_cleanup(
  526	    true,
  527	    codemirror_tokens_(Request),
  528	    Reason,
  529	    check_unlocked(Reason)).
  530
  531codemirror_tokens_(Request) :-
  532	http_read_json_dict(Request, Data, []),
  533	atom_string(UUID, Data.get(uuid)),
  534	debug(cm(tokens), 'Asking for tokens: ~p', [Data]),
  535	(   catch(shadow_editor(Data, TB), cm(Reason), true)
  536	->  (   var(Reason)
  537	    ->	call_cleanup(enriched_tokens(TB, Data, Tokens),
  538			     release_editor(UUID)),
  539		reply_json_dict(json{tokens:Tokens}, [width(0)])
  540	    ;	check_unlocked(Reason),
  541		change_failed(UUID, Reason)
  542	    )
  543	;   reply_json_dict(json{tokens:[[]]})
  544	),
  545	gc_editors.
  546
  547
  548enriched_tokens(TB, _Data, Tokens) :-		% source window
  549	current_editor(UUID, TB, source, _Lock, _), !,
  550	xref(UUID),
  551	server_tokens(TB, Tokens).
  552enriched_tokens(TB, Data, Tokens) :-		% query window
  553	json_source_id(Data.get(sourceID), SourceID), !,
  554	memory_file_to_string(TB, Query),
  555	with_mutex(swish_highlight_query,
  556		   prolog_colourise_query(Query, SourceID, colour_item(TB))),
  557	collect_tokens(TB, Tokens).
  558enriched_tokens(TB, _Data, Tokens) :-
  559	memory_file_to_string(TB, Query),
  560	prolog_colourise_query(Query, module(swish), colour_item(TB)),
  561	collect_tokens(TB, Tokens).

 json_source_id(+Input, -SourceID)

Translate the Input, which is either a string or a list of strings into an atom or list of atoms. Older versions of SWI-Prolog only accept a single atom source id.

  569:- if(current_predicate(prolog_colour:to_list/2)).  570json_source_id(StringList, SourceIDList) :-
  571	is_list(StringList),
  572	StringList \== [], !,
  573	maplist(string_source_id, StringList, SourceIDList).
  574:- else.				% old version (=< 7.3.7)
  575json_source_id([String|_], SourceID) :-
  576	maplist(string_source_id, String, SourceID).
  577:- endif.  578json_source_id(String, SourceID) :-
  579	string(String),
  580	string_source_id(String, SourceID).
  581
  582string_source_id(String, SourceID) :-
  583	atom_string(SourceID, String),
  584	(   fetch_editor(SourceID, _TB)
  585	->  release_editor(SourceID)
  586	;   true
  587	).

 shadow_editor(+Data, -MemoryFile) is det

Get our shadow editor:

1. If we have one, it is updated from either the text or the changes.
2. If we have none, but there is a text property, create one from the text.
3. If there is a role property, create an empty one.

This predicate fails if the server thinks we have an editor with state that must be reused, but this is not true (for example because we have been restarted).

throws

- cm(existence_error) if the target editor did not exist

- cm(out_of_sync) if the changes do not apply due to an internal error or a lost message.

  607shadow_editor(Data, TB) :-
  608	atom_string(UUID, Data.get(uuid)),
  609	setup_call_catcher_cleanup(
  610	    fetch_editor(UUID, TB),
  611	    once(update_editor(Data, UUID, TB)),
  612	    Catcher,
  613	    cleanup_update(Catcher, UUID)), !.
  614shadow_editor(Data, TB) :-
  615	Text = Data.get(text), !,
  616	atom_string(UUID, Data.uuid),
  617	create_editor(UUID, TB, Data),
  618	debug(cm(change), 'Create editor for ~p', [UUID]),
  619	debug(cm(change_text), 'Initialising editor to ~q', [Text]),
  620	insert_memory_file(TB, 0, Text).
  621shadow_editor(Data, TB) :-
  622	_{role:_} :< Data, !,
  623	atom_string(UUID, Data.uuid),
  624	create_editor(UUID, TB, Data).
  625shadow_editor(_Data, _TB) :-
  626	throw(cm(existence_error)).
  627
  628update_editor(Data, _UUID, TB) :-
  629	Text = Data.get(text), !,
  630	size_memory_file(TB, Size),
  631	delete_memory_file(TB, 0, Size),
  632	insert_memory_file(TB, 0, Text),
  633	mark_changed(TB, true).
  634update_editor(Data, UUID, TB) :-
  635	Changes = Data.get(changes), !,
  636	(   debug(cm(change), 'Patch editor for ~p', [UUID]),
  637	    maplist(apply_change(TB, Changed), Changes)
  638	->  true
  639	;   throw(cm(out_of_sync))
  640	),
  641	mark_changed(TB, Changed).
  642
  643cleanup_update(exit, _) :- !.
  644cleanup_update(_, UUID) :-
  645	release_editor(UUID).
  646
  647:- thread_local
  648	token/3.

 show_mirror(+Role) is det

 server_tokens(+Role) is det

These predicates help debugging the server side. show_mirror/0 displays the text the server thinks is in the client editor. The predicate server_tokens/1 dumps the token list.

Arguments:

Role	- is one of source or query, expressing the role of the editor in the SWISH UI.

  660:- public
  661	show_mirror/1,
  662	server_tokens/1.  663
  664show_mirror(Role) :-
  665	current_editor(_UUID, TB, Role, _Lock, _), !,
  666	memory_file_to_string(TB, String),
  667	write(user_error, String).
  668
  669server_tokens(Role) :-
  670	current_editor(_UUID, TB, Role, _Lock, _), !,
  671	enriched_tokens(TB, _{}, Tokens),
  672	print_term(Tokens, [output(user_error)]).

 server_tokens(+TextBuffer, -Tokens) is det

Arguments:

Tokens

- is a nested list of Prolog JSON terms. Each group represents the tokens found in a single toplevel term.

  679server_tokens(TB, GroupedTokens) :-
  680	current_editor(UUID, TB, _Role, _Lock, _),
  681	Ignore = error(syntax_error(swi_backslash_newline),_),
  682	setup_call_cleanup(
  683	    asserta(user:thread_message_hook(Ignore, _, _), Ref),
  684	    setup_call_cleanup(
  685		open_memory_file(TB, read, Stream),
  686		( set_stream_file(TB, Stream),
  687		  prolog_colourise_stream(Stream, UUID, colour_item(TB))
  688		),
  689		close(Stream)),
  690	    erase(Ref)),
  691	collect_tokens(TB, GroupedTokens).
  692
  693collect_tokens(TB, GroupedTokens) :-
  694	findall(Start-Token, json_token(TB, Start, Token), Pairs),
  695	keysort(Pairs, Sorted),
  696	pairs_values(Sorted, Tokens),
  697	group_by_term(Tokens, GroupedTokens).
  698
  699set_stream_file(_,_).			% TBD

 group_by_term(+Tokens, -Nested) is det

Group the tokens by input term. This simplifies incremental updates of the token list at the client sides as well as re-syncronizing. This predicate relies on the fullstop token that is emitted at the end of each input term.

  708group_by_term([], []) :- !.
  709group_by_term(Flat, [Term|Grouped]) :-
  710	take_term(Flat, Term, Rest),
  711	group_by_term(Rest, Grouped).
  712
  713take_term([], [], []).
  714take_term([H|T0], [H|T], R) :-
  715	(   ends_term(H.get(type))
  716	->  T = [],
  717	    R = T0
  718	;   take_term(T0, T, R)
  719	).
  720
  721ends_term(fullstop).
  722ends_term(syntax_error).

 json_token(+TB, -Start, -JSON) is nondet

Extract the stored terms.

To be done

- We could consider to collect the attributes in the colour_item/4 callback and maintain a global variable instead of using assert/retract. Most likely that would be faster. Need to profile to check the bottleneck.

  733json_token(TB, Start, Token) :-
  734	retract(token(Style, Start0, Len)),
  735	debug(color, 'Trapped ~q.', [token(Style, Start0, Len)]),
  736	(   atomic_special(Style, Start0, Len, TB, Type, Attrs)
  737	->  Start = Start0
  738	;   style(Style, Type0, Attrs0)
  739	->  (   Type0 = StartType-EndType
  740	    ->	(   Start = Start0,
  741		    Type  = StartType
  742		;   Start is Start0+Len-1,
  743		    Type  = EndType
  744		)
  745	    ;	Type = Type0,
  746		Start = Start0
  747	    ),
  748	    json_attributes(Attrs0, Attrs, TB, Start0, Len)
  749	),
  750	dict_create(Token, json, [type(Type)|Attrs]).
  751
  752atomic_special(atom, Start, Len, TB, Type, Attrs) :-
  753	memory_file_substring(TB, Start, 1, _, FirstChar),
  754	(   FirstChar == "'"
  755	->  Type = qatom,
  756	    Attrs = []
  757	;   char_type(FirstChar, upper)
  758	->  Type = uatom,			% var_prefix in effect
  759	    Attrs = []
  760	;   Type = atom,
  761	    (   Len =< 5			% solo characters, neck, etc.
  762	    ->  memory_file_substring(TB, Start, Len, _, Text),
  763	Attrs = [text(Text)]
  764	    ;   Attrs = []
  765	    )
  766	).
  767
  768json_attributes([], [], _, _, _).
  769json_attributes([H0|T0], Attrs, TB, Start, Len) :-
  770	json_attribute(H0, Attrs, T, TB, Start, Len), !,
  771	json_attributes(T0, T, TB, Start, Len).
  772json_attributes([_|T0], T, TB, Start, Len) :-
  773	json_attributes(T0, T, TB, Start, Len).
  774
  775json_attribute(text, [text(Text)|T], T, TB, Start, Len) :- !,
  776	memory_file_substring(TB, Start, Len, _, Text).
  777json_attribute(line(File:Line), [line(Line),file(File)|T], T, _, _, _) :- !.
  778json_attribute(Term, [Term|T], T, _, _, _).
  779
  780colour_item(_TB, Style, Start, Len) :-
  781	(   style(Style)
  782	->  assertz(token(Style, Start, Len))
  783	;   debug(color, 'Ignored ~q.', [token(Style, Start, Len)])
  784	).

 style(+StyleIn) is semidet

 style(+StyleIn, -SWISHType:atomOrPair, -Attributes:list)

Declare that we map StyleIn as generated by library(prolog_colour) into a token of type SWISHType, providing additional context information based on Attributes. Elements of Attributes are terms of the form Name(Value) or the atom text. The latter is mapped to text(String), where String contains the text that matches the token character range.

The resulting JSON token object has a property type, containing the SWISHType and the properties defined by Attributes.

Additional translations can be defined by adding rules for the multifile predicate style/3. The base type, which refers to the type generated by the SWISH tokenizer must be specified by adding an attribute base(BaseType). For example, if the colour system classifies an atom as refering to a database column, library(prolog_colour) may emit db_column(Name) and the following rule should ensure consistent mapping:

swish_highlight:style(db_column(Name),
                      db_column, [text, base(atom)]).

  813:- multifile
  814	style/3.  815
  816style(Style) :-
  817	style(Style, _, _).
  818
  819style(neck(Neck),     neck, [ text(Text) ]) :-
  820	neck_text(Neck, Text).
  821style(head(Class, Head), Type, [ text, arity(Arity) ]) :-
  822	goal_arity(Head, Arity),
  823	head_type(Class, Type).
  824style(goal_term(_Class, Goal), var, []) :-
  825	var(Goal), !.
  826style(goal_term(Class, {_}), brace_term_open-brace_term_close,
  827      [ name({}), arity(1) | More ]) :-
  828	goal_type(Class, _Type, More).
  829style(goal(Class, Goal), Type, [ text, arity(Arity) | More ]) :-
  830	Goal \= {_},
  831	goal_arity(Goal, Arity),
  832	goal_type(Class, Type, More).
  833style(file_no_depend(Path), file_no_depends,		   [text, path(Path)]).
  834style(file(Path),	 file,				   [text, path(Path)]).
  835style(nofile,		 nofile,			   [text]).
  836style(option_name,	 option_name,			   [text]).
  837style(no_option_name,	 no_option_name,		   [text]).
  838style(flag_name(_Flag),	 flag_name,			   [text]).
  839style(no_flag_name(_Flag), no_flag_name,		   [text]).
  840style(fullstop,		 fullstop,			   []).
  841style(var,		 var,				   [text]).
  842style(singleton,	 singleton,			   [text]).
  843style(string,		 string,			   []).
  844style(codes,		 codes,				   []).
  845style(chars,		 chars,				   []).
  846style(atom,		 atom,				   []).
  847style(rational(_Value),	 rational,			   [text]).
  848style(format_string,	 format_string,			   []).
  849style(meta(_Spec),	 meta,				   []).
  850style(op_type(_Type),	 op_type,			   [text]).
  851style(decl_option(_Name),decl_option,			   [text]).
  852style(functor,		 functor,			   [text]).
  853style(function,		 function,			   [text]).
  854style(no_function,	 no_function,			   [text]).
  855style(control,		 control,			   [text]).
  856style(delimiter,	 delimiter,			   [text]).
  857style(identifier,	 identifier,			   [text]).
  858style(module(_Module),   module,			   [text]).
  859style(error,		 error,				   [text]).
  860style(constraint(Set),   constraint,			   [text, set(Set)]).
  861style(type_error(Expect), error,		      [text,expected(Msg)]) :-
  862    type_error_msg(Expect, Msg).
  863style(syntax_error(_Msg,_Pos), syntax_error,		   []).
  864style(instantiation_error, instantiation_error,		   [text]).
  865style(predicate_indicator, atom,			   [text]).
  866style(predicate_indicator, atom,			   [text]).
  867style(arity,		 int,				   []).
  868style(int,		 int,				   []).
  869style(float,		 float,				   []).
  870style(keyword(_),	 keyword,			   [text]).
  871style(qq(open),		 qq_open,			   []).
  872style(qq(sep),		 qq_sep,			   []).
  873style(qq(close),	 qq_close,			   []).
  874style(qq_type,		 qq_type,			   [text]).
  875style(dict_tag,		 tag,				   [text]).
  876style(dict_key,		 key,				   [text]).
  877style(dict_sep,		 sep,				   []).
  878style(func_dot,		 atom,				   [text(.)]).
  879style(dict_return_op,	 atom,				   [text(:=)]).
  880style(dict_function(F),  dict_function,			   [text(F)]).
  881style(empty_list,	 list_open-list_close,		   []).
  882style(list,		 list_open-list_close,		   []).
  883style(dcg(terminal),	 list_open-list_close,		   []).
  884style(dcg(string),	 string_terminal,		   []).
  885style(dcg(plain),	 brace_term_open-brace_term_close, []).
  886style(brace_term,	 brace_term_open-brace_term_close, []).
  887style(dict_content,	 dict_open-dict_close,             []).
  888style(expanded,		 expanded,			   [text]).
  889style(comment_string,	 comment_string,		   []). % up to 7.3.33
  890style(comment(string),	 comment_string,		   []). % after 7.3.33
  891style(ext_quant,	 ext_quant,			   []).
  892style(unused_import,	 unused_import,			   [text]).
  893style(undefined_import,	 undefined_import,		   [text]).
  894					% from library(http/html_write)
  895style(html(_Element),	 html,				   []).
  896style(entity(_Element),	 entity,			   []).
  897style(html_attribute(_), html_attribute,		   []).
  898style(sgml_attr_function,sgml_attr_function,		   []).
  899style(html_call,	 html_call,			   [text]).  % \Rule
  900style(html_raw,		 html_raw,			   [text]).  % \List
  901style(http_location_for_id(_), http_location_for_id,       []).
  902style(http_no_location_for_id(_), http_no_location_for_id, []).
  903					% XPCE support
  904style(method(send),	 xpce_method,			   [text]).
  905style(method(get),	 xpce_method,			   [text]).
  906style(class(built_in,_Name),	  xpce_class_built_in,	   [text]).
  907style(class(library(File),_Name), xpce_class_lib,	   [text, file(File)]).
  908style(class(user(File),_Name),	  xpce_class_user,	   [text, file(File)]).
  909style(class(user,_Name),	  xpce_class_user,	   [text]).
  910style(class(undefined,_Name),	  xpce_class_undef,	   [text]).
  911
  912style(table_mode(_Mode), table_mode,			   [text]).
  913style(table_option(_Mode), table_option,		   [text]).
  914
  915
  916type_error_msg(declaration(Context), Msg) =>
  917    format(string(Msg), '~w declaration', [Context]).
  918type_error_msg(Atomic, Msg), atomic(Atomic) =>
  919    Msg = Atomic.
  920type_error_msg(Term, Msg) =>
  921    term_string(Term, Msg).
  922
  923neck_text(clause,       (:-))  :- !.
  924neck_text(grammar_rule, (-->)) :- !.
  925neck_text(method(send), (:->)) :- !.
  926neck_text(method(get),  (:<-)) :- !.
  927neck_text(directive,    (:-))  :- !.
  928neck_text(Text,         Text).		% new style
  929
  930head_type(exported,	 head_exported).
  931head_type(public(_),	 head_public).
  932head_type(extern(_),	 head_extern).
  933head_type(extern(_,_),	 head_extern).
  934head_type(dynamic,	 head_dynamic).
  935head_type(multifile,	 head_multifile).
  936head_type(unreferenced,	 head_unreferenced).
  937head_type(hook,		 head_hook).
  938head_type(meta,		 head_meta).
  939head_type(constraint(_), head_constraint).
  940head_type(imported,	 head_imported).
  941head_type(built_in,	 head_built_in).
  942head_type(iso,		 head_iso).
  943head_type(def_iso,	 head_def_iso).
  944head_type(def_swi,	 head_def_swi).
  945head_type(_,		 head).
  946
  947goal_type(built_in,	      goal_built_in,	 []).
  948goal_type(imported(File),     goal_imported,	 [file(File)]).
  949goal_type(autoload(File),     goal_autoload,	 [file(File)]).
  950goal_type(global,	      goal_global,	 []).
  951goal_type(undefined,	      goal_undefined,	 []).
  952goal_type(thread_local(Line), goal_thread_local, [line(Line)]).
  953goal_type(dynamic(Line),      goal_dynamic,	 [line(Line)]).
  954goal_type(multifile(Line),    goal_multifile,	 [line(Line)]).
  955goal_type(expanded,	      goal_expanded,	 []).
  956goal_type(extern(_),	      goal_extern,	 []).
  957goal_type(extern(_,_),	      goal_extern,	 []).
  958goal_type(recursion,	      goal_recursion,	 []).
  959goal_type(meta,		      goal_meta,	 []).
  960goal_type(foreign(_),	      goal_foreign,	 []).
  961goal_type(local(Line),	      goal_local,	 [line(Line)]).
  962goal_type(constraint(Line),   goal_constraint,	 [line(Line)]).
  963goal_type(not_callable,	      goal_not_callable, []).
  964goal_type(global(Type,_Loc),  Class,		 []) :-
  965	global_class(Type, Class).
  966
  967global_class(dynamic,   goal_dynamic) :- !.
  968global_class(multifile, goal_multifile) :- !.
  969global_class(_,		goal_global).

 goal_arity(+Goal, -Arity) is det

Get the arity of a goal safely in SWI7

  975goal_arity(Goal, Arity) :-
  976	(   compound(Goal)
  977	->  compound_name_arity(Goal, _, Arity)
  978	;   Arity = 0
  979	).
  980
  981		 /*******************************
  982		 *	 HIGHLIGHT CONFIG	*
  983		 *******************************/
  984
  985:- multifile
  986	swish_config:config/2,
  987	css/3.				% ?Context, ?Selector, -Attributes

 swish_config:config(-Name, -Styles) is nondet

Provides the object config.swish.style, a JSON object that maps style properties of user-defined extensions of library(prolog_colour). This info is used by the server-side colour engine to populate the CodeMirror styles.

To be done

- Provide summary information

  998swish_config:config(cm_style, Styles) :-
  999	findall(Name-Style, highlight_style(Name, Style), Pairs),
 1000	keysort(Pairs, Sorted),
 1001	remove_duplicate_styles(Sorted, Unique),
 1002	dict_pairs(Styles, json, Unique).
 1003swish_config:config(cm_hover_style, Styles) :-
 1004	findall(Sel-Attrs, css_dict(hover, Sel, Attrs), Pairs),
 1005	dict_pairs(Styles, json, Pairs).
 1006
 1007remove_duplicate_styles([], []).
 1008remove_duplicate_styles([H|T0], [H|T]) :-
 1009	H = K-_,
 1010	remove_same(K, T0, T1),
 1011	remove_duplicate_styles(T1, T).
 1012
 1013remove_same(K, [K-_|T0], T) :- !,
 1014	remove_same(K, T0, T).
 1015remove_same(_, Rest, Rest).
 1016
 1017highlight_style(StyleName, Style) :-
 1018	style(Term, StyleName, _),
 1019	atom(StyleName),
 1020	(   prolog_colour:style(Term, Attrs0)
 1021        ->  maplist(css_style, Attrs0, Attrs),
 1022	    dict_create(Style, json, Attrs)
 1023	).
 1024
 1025css_style(bold(true),      'font-weight'(bold)) :- !.
 1026css_style(underline(true), 'text-decoration'(underline)) :- !.
 1027css_style(colour(Name), color(RGB)) :-
 1028	x11_color(Name, R, G, B),
 1029	format(atom(RGB), '#~|~`0t~16r~2+~`0t~16r~2+~`0t~16r~2+', [R,G,B]).
 1030css_style(Style, Style).

 x11_color(+Name, -R, -G, -B)

True if RGB is the color for the named X11 color.

 1036x11_color(Name, R, G, B) :-
 1037	(   x11_colors_done
 1038	->  true
 1039	;   with_mutex(swish_highlight, load_x11_colours)
 1040	),
 1041	x11_color_cache(Name, R, G, B).
 1042
 1043:- dynamic
 1044	x11_color_cache/4,
 1045	x11_colors_done/0. 1046
 1047load_x11_colours :-
 1048	x11_colors_done, !.
 1049load_x11_colours :-
 1050	source_file(load_x11_colours, File),
 1051	file_directory_name(File, Dir),
 1052	directory_file_path(Dir, 'rgb.txt', RgbFile),
 1053	setup_call_cleanup(
 1054	    open(RgbFile, read, In),
 1055	    ( lazy_list(lazy_read_lines(In, [as(string)]), List),
 1056	      maplist(assert_colour, List)
 1057	    ),
 1058	    close(In)),
 1059	asserta(x11_colors_done).
 1060
 1061assert_colour(String) :-
 1062	split_string(String, "\s\t\r", "\s\t\r", [RS,GS,BS|NameParts]),
 1063	number_string(R, RS),
 1064	number_string(G, GS),
 1065	number_string(B, BS),
 1066	atomic_list_concat(NameParts, '_', Name0),
 1067	downcase_atom(Name0, Name),
 1068	assertz(x11_color_cache(Name, R, G, B)).
 1069
 1070:- catch(initialization(load_x11_colours, prepare_state), _, true).

 css(?Context, ?Selector, -Style) is nondet

Multifile hook to define additional style to apply in a specific context. Currently defined contexts are:

hover

Used for CodeMirror hover extension.

Arguments:

Selector	- is a CSS selector, which is refined by Context
Style	- is a list of Name(Value) terms.

 1083css_dict(Context, Selector, Style) :-
 1084	css(Context, Selector, Attrs0),
 1085	maplist(css_style, Attrs0, Attrs),
 1086	dict_create(Style, json, Attrs).
 1087
 1088
 1089		 /*******************************
 1090		 *	       INFO		*
 1091		 *******************************/
 1092
 1093:- multifile
 1094	prolog:predicate_summary/2.

 token_info(+Request)

HTTP handler that provides information about a token.

 1100token_info(Request) :-
 1101	memberchk(method(options), Request),
 1102	!,
 1103	cors_enable(Request,
 1104		    [ methods([get])
 1105		    ]),
 1106	format('~n').
 1107token_info(Request) :-
 1108	cors_enable,
 1109	http_parameters(Request, [], [form_data(Form)]),
 1110	maplist(type_convert, Form, Values),
 1111	dict_create(Token, token, Values),
 1112	reply_html_page(plain,
 1113			title('token info'),
 1114			\token_info_or_none(Token)).
 1115
 1116type_convert(Name=Atom, Name=Number) :-
 1117	atom_number(Atom, Number), !.
 1118type_convert(NameValue, NameValue).
 1119
 1120
 1121token_info_or_none(Token) -->
 1122	token_info(Token), !.
 1123token_info_or_none(_) -->
 1124	html(span(class('token-noinfo'), 'No info available')).

 token_info(+Token:dict)// is det

Generate HTML, providing details about Token. Token is a dict, providing the enriched token as defined by style/3. This multifile non-terminal can be hooked to provide details for user defined style extensions.

 1133:- multifile token_info//1. 1134
 1135token_info(Token) -->
 1136	{ _{type:Type, text:Name, arity:Arity} :< Token,
 1137	  goal_type(_, Type, _), !,
 1138	  ignore(token_predicate_module(Token, Module)),
 1139	  text_arity_pi(Name, Arity, PI),
 1140	  predicate_info(Module:PI, Info)
 1141	},
 1142	pred_info(Info).
 1143
 1144pred_info([]) -->
 1145	html(span(class('pred-nosummary'), 'No help available')).
 1146pred_info([Info|_]) -->			% TBD: Ambiguous
 1147	(pred_tags(Info)     -> [];[]),
 1148	(pred_summary(Info)  -> [];[]).
 1149
 1150pred_tags(Info) -->
 1151	{ Info.get(iso) == true },
 1152	html(span(class('pred-tag'), 'ISO')).
 1153
 1154pred_summary(Info) -->
 1155	html(span(class('pred-summary'), Info.get(summary))).

 token_predicate_module(+Token, -Module) is semidet

Try to extract the module from the token.

 1161token_predicate_module(Token, Module) :-
 1162	source_file_property(Token.get(file), module(Module)), !.
 1163
 1164text_arity_pi('[', 2, consult/1) :- !.
 1165text_arity_pi(']', 2, consult/1) :- !.
 1166text_arity_pi(Name, Arity, Name/Arity).

 predicate_info(+PI, -Info:list(dict)) is det

Info is a list of dicts providing details about predicates that match PI. Fields in dict are:

module:Atom

Module of the predicate

name:Atom

Name of the predicate

arity:Integer

Arity of the predicate

summary:Text

Summary text extracted from the system manual or PlDoc

iso:Boolean

Presend and true if the predicate is an ISO predicate

 1185predicate_info(PI, Info) :-
 1186	PI = Module:Name/Arity,
 1187	findall(Dict,
 1188		( setof(Key-Value,
 1189			predicate_info(PI, Key, Value),
 1190			Pairs),
 1191		  dict_pairs(Dict, json,
 1192			     [ module - Module,
 1193			       name   - Name,
 1194			       arity  - Arity
 1195			     | Pairs
 1196			     ])
 1197		),
 1198		Info).

 predicate_info(?PI, -Key, -Value) is nondet

Find information about predicates from the system, manual and PlDoc. First, we deal with ISO predicates that cannot be redefined and are documented in the manual. Next, we deal with predicates that are documented in the manual.

bug

- : Handling predicates documented in the manual is buggy because their definition may be overruled by the user. We probably must include the file into the equation.

 1211					% ISO predicates
 1212predicate_info(Module:Name/Arity, Key, Value) :-
 1213	functor(Head, Name, Arity),
 1214	predicate_property(system:Head, iso), !,
 1215	ignore(Module = system),
 1216	(   man_predicate_summary(Name/Arity, Summary),
 1217	    Key = summary,
 1218	    Value = Summary
 1219	;   Key = iso,
 1220	    Value = true
 1221	).
 1222predicate_info(PI, summary, Summary) :-
 1223	PI = Module:Name/Arity,
 1224
 1225	(   man_predicate_summary(Name/Arity, Summary)
 1226	->  true
 1227	;   Arity >= 2,
 1228	    DCGArity is Arity - 2,
 1229	    man_predicate_summary(Name//DCGArity, Summary)
 1230	->  true
 1231	;   prolog:predicate_summary(PI, Summary)
 1232	->  true
 1233	;   Arity >= 2,
 1234	    DCGArity is Arity - 2,
 1235	    prolog:predicate_summary(Module:Name/DCGArity, Summary)
 1236	).
 1237
 1238:- if(current_predicate(man_object_property/2)). 1239man_predicate_summary(PI, Summary) :-
 1240    man_object_property(PI, summary(Summary)).
 1241:- else. 1242man_predicate_summary(_, _) :-
 1243    fail.
 1244:- endif.