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:- 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").

   79		 /*******************************
   80		 *	  SHADOW EDITOR		*
   81		 *******************************/

 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.

  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)]).

 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.

  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

 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.

  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)).

 current_highlight_state(?UUID, -State) is nondet

Return info on the current highlighter

  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	).

 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.

  245uuid_like(UUID) :-
  246	split_string(UUID, "-", "", Parts),
  247	maplist(string_length, Parts, [8,4,4,4,12]),
  248	\+ 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.

  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(_).

 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.

  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(_).

 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.

  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).

 check_unlocked(+Reason)

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

  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(_, _).

 update_access(+UUID)

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

  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, _, _, _, _).

 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.

  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.

 codemirror_leave(+Request)

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

  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).

 mark_changed(+MemFile, ?Changed) is det

Mark that our cross-reference data might be obsolete

  434mark_changed(MemFile, Changed) :-
  435	(   Changed == true,
  436	    current_editor(UUID, MemFile, _Role, _, _)
  437	->  retractall(xref_upto_data(UUID))
  438	;   true
  439	).

 xref(+UUID) is det

  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)).

 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.

  463xref_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.

  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		 *******************************/

 codemirror_tokens(+Request)

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

  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).

 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.

  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	).

 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.

  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.

 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.

  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)]).

 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.

  653server_tokens(TB, GroupedTokens) :-
  654	current_editor(UUID, TB, _Role, _Lock, _),
  655	setup_call_cleanup(
  656	    open_memory_file(TB, read, Stream),
  657	    ( set_stream_file(TB, Stream),
  658	      prolog_colourise_stream(Stream, UUID, colour_item(TB))
  659	    ),
  660	    close(Stream)),
  661	collect_tokens(TB, GroupedTokens).
  662
  663collect_tokens(TB, GroupedTokens) :-
  664	findall(Start-Token, json_token(TB, Start, Token), Pairs),
  665	keysort(Pairs, Sorted),
  666	pairs_values(Sorted, Tokens),
  667	group_by_term(Tokens, GroupedTokens).
  668
  669set_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.

  678group_by_term([], []) :- !.
  679group_by_term(Flat, [Term|Grouped]) :-
  680	take_term(Flat, Term, Rest),
  681	group_by_term(Rest, Grouped).
  682
  683take_term([], [], []).
  684take_term([H|T0], [H|T], R) :-
  685	(   ends_term(H.get(type))
  686	->  T = [],
  687	    R = T0
  688	;   take_term(T0, T, R)
  689	).
  690
  691ends_term(fullstop).
  692ends_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.

  703json_token(TB, Start, Token) :-
  704	retract(token(Style, Start0, Len)),
  705	debug(color, 'Trapped ~q.', [token(Style, Start0, Len)]),
  706	(   atomic_special(Style, Start0, Len, TB, Type, Attrs)
  707	->  Start = Start0
  708	;   style(Style, Type0, Attrs0)
  709	->  (   Type0 = StartType-EndType
  710	    ->	(   Start = Start0,
  711		    Type  = StartType
  712		;   Start is Start0+Len-1,
  713		    Type  = EndType
  714		)
  715	    ;	Type = Type0,
  716		Start = Start0
  717	    ),
  718	    json_attributes(Attrs0, Attrs, TB, Start0, Len)
  719	),
  720	dict_create(Token, json, [type(Type)|Attrs]).
  721
  722atomic_special(atom, Start, Len, TB, Type, Attrs) :-
  723	memory_file_substring(TB, Start, 1, _, FirstChar),
  724	(   FirstChar == "'"
  725	->  Type = qatom,
  726	    Attrs = []
  727	;   char_type(FirstChar, upper)
  728	->  Type = uatom,			% var_prefix in effect
  729	    Attrs = []
  730	;   Type = atom,
  731	    (   Len =< 5			% solo characters, neck, etc.
  732	    ->  memory_file_substring(TB, Start, Len, _, Text),
  733	        Attrs = [text(Text)]
  734	    ;   Attrs = []
  735	    )
  736	).
  737
  738json_attributes([], [], _, _, _).
  739json_attributes([H0|T0], Attrs, TB, Start, Len) :-
  740	json_attribute(H0, Attrs, T, TB, Start, Len), !,
  741	json_attributes(T0, T, TB, Start, Len).
  742json_attributes([_|T0], T, TB, Start, Len) :-
  743	json_attributes(T0, T, TB, Start, Len).
  744
  745json_attribute(text, [text(Text)|T], T, TB, Start, Len) :- !,
  746	memory_file_substring(TB, Start, Len, _, Text).
  747json_attribute(line(File:Line), [line(Line),file(File)|T], T, _, _, _) :- !.
  748json_attribute(Term, [Term|T], T, _, _, _).
  749
  750colour_item(_TB, Style, Start, Len) :-
  751	(   style(Style)
  752	->  assertz(token(Style, Start, Len))
  753	;   debug(color, 'Ignored ~q.', [token(Style, Start, Len)])
  754	).

 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)]).

  783:- multifile
  784	style/3.  785
  786style(Style) :-
  787	style(Style, _, _).
  788
  789style(neck(Neck),     neck, [ text(Text) ]) :-
  790	neck_text(Neck, Text).
  791style(head(Class, Head), Type, [ text, arity(Arity) ]) :-
  792	goal_arity(Head, Arity),
  793	head_type(Class, Type).
  794style(goal_term(_Class, Goal), var, []) :-
  795	var(Goal), !.
  796style(goal_term(Class, {_}), brace_term_open-brace_term_close,
  797      [ name({}), arity(1) | More ]) :-
  798	goal_type(Class, _Type, More).
  799style(goal(Class, Goal), Type, [ text, arity(Arity) | More ]) :-
  800	Goal \= {_},
  801	goal_arity(Goal, Arity),
  802	goal_type(Class, Type, More).
  803style(file_no_depend(Path), file_no_depends,		   [text, path(Path)]).
  804style(file(Path),	 file,				   [text, path(Path)]).
  805style(nofile,		 nofile,			   [text]).
  806style(option_name,	 option_name,			   [text]).
  807style(no_option_name,	 no_option_name,		   [text]).
  808style(flag_name(_Flag),	 flag_name,			   [text]).
  809style(no_flag_name(_Flag), no_flag_name,		   [text]).
  810style(fullstop,		 fullstop,			   []).
  811style(var,		 var,				   [text]).
  812style(singleton,	 singleton,			   [text]).
  813style(string,		 string,			   []).
  814style(codes,		 codes,				   []).
  815style(chars,		 chars,				   []).
  816style(atom,		 atom,				   []).
  817style(format_string,	 format_string,			   []).
  818style(meta(_Spec),	 meta,				   []).
  819style(op_type(_Type),	 op_type,			   [text]).
  820style(functor,		 functor,			   [text]).
  821style(control,		 control,			   [text]).
  822style(delimiter,	 delimiter,			   [text]).
  823style(identifier,	 identifier,			   [text]).
  824style(module(_Module),   module,			   [text]).
  825style(error,		 error,				   [text]).
  826style(constraint(Set),   constraint,			   [text, set(Set)]).
  827style(type_error(Expect), error,		      [text,expected(Expect)]).
  828style(syntax_error(_Msg,_Pos), syntax_error,		   []).
  829style(instantiation_error, instantiation_error,	           [text]).
  830style(predicate_indicator, atom,			   [text]).
  831style(predicate_indicator, atom,			   [text]).
  832style(arity,		 int,				   []).
  833style(int,		 int,				   []).
  834style(float,		 float,				   []).
  835style(qq(open),		 qq_open,			   []).
  836style(qq(sep),		 qq_sep,			   []).
  837style(qq(close),	 qq_close,			   []).
  838style(qq_type,		 qq_type,			   [text]).
  839style(dict_tag,		 tag,				   [text]).
  840style(dict_key,		 key,				   [text]).
  841style(dict_sep,		 sep,				   []).
  842style(func_dot,		 atom,				   [text(.)]).
  843style(dict_return_op,	 atom,				   [text(:=)]).
  844style(dict_function(F),  dict_function,			   [text(F)]).
  845style(empty_list,	 list_open-list_close,		   []).
  846style(list,		 list_open-list_close,		   []).
  847style(dcg(terminal),	 list_open-list_close,		   []).
  848style(dcg(string),	 string_terminal,		   []).
  849style(dcg(plain),	 brace_term_open-brace_term_close, []).
  850style(brace_term,	 brace_term_open-brace_term_close, []).
  851style(dict_content,	 dict_open-dict_close,             []).
  852style(expanded,		 expanded,			   [text]).
  853style(comment_string,	 comment_string,		   []). % up to 7.3.33
  854style(comment(string),	 comment_string,		   []). % after 7.3.33
  855style(ext_quant,	 ext_quant,			   []).
  856style(unused_import,	 unused_import,			   [text]).
  857style(undefined_import,	 undefined_import,		   [text]).
  858					% from library(http/html_write)
  859style(html(_Element),	 html,				   []).
  860style(entity(_Element),	 entity,			   []).
  861style(html_attribute(_), html_attribute,		   []).
  862style(sgml_attr_function,sgml_attr_function,		   []).
  863style(html_call,	 html_call,			   [text]).  % \Rule
  864style(html_raw,		 html_raw,			   [text]).  % \List
  865style(http_location_for_id(_), http_location_for_id,       []).
  866style(http_no_location_for_id(_), http_no_location_for_id, []).
  867					% XPCE support
  868style(method(send),	 xpce_method,			   [text]).
  869style(method(get),	 xpce_method,			   [text]).
  870style(class(built_in,_Name),	  xpce_class_built_in,	   [text]).
  871style(class(library(File),_Name), xpce_class_lib,	   [text, file(File)]).
  872style(class(user(File),_Name),	  xpce_class_user,	   [text, file(File)]).
  873style(class(user,_Name),	  xpce_class_user,	   [text]).
  874style(class(undefined,_Name),	  xpce_class_undef,	   [text]).
  875
  876neck_text(clause,       (:-)).
  877neck_text(grammar_rule, (-->)).
  878neck_text(method(send), (:->)).
  879neck_text(method(get),  (:<-)).
  880neck_text(directive,    (:-)).
  881
  882head_type(exported,	 head_exported).
  883head_type(public(_),	 head_public).
  884head_type(extern(_),	 head_extern).
  885head_type(extern(_,_),	 head_extern).
  886head_type(dynamic,	 head_dynamic).
  887head_type(multifile,	 head_multifile).
  888head_type(unreferenced,	 head_unreferenced).
  889head_type(hook,		 head_hook).
  890head_type(meta,		 head_meta).
  891head_type(constraint(_), head_constraint).
  892head_type(imported,	 head_imported).
  893head_type(built_in,	 head_built_in).
  894head_type(iso,		 head_iso).
  895head_type(def_iso,	 head_def_iso).
  896head_type(def_swi,	 head_def_swi).
  897head_type(_,		 head).
  898
  899goal_type(built_in,	      goal_built_in,	 []).
  900goal_type(imported(File),     goal_imported,	 [file(File)]).
  901goal_type(autoload(File),     goal_autoload,	 [file(File)]).
  902goal_type(global,	      goal_global,	 []).
  903goal_type(undefined,	      goal_undefined,	 []).
  904goal_type(thread_local(Line), goal_thread_local, [line(Line)]).
  905goal_type(dynamic(Line),      goal_dynamic,	 [line(Line)]).
  906goal_type(multifile(Line),    goal_multifile,	 [line(Line)]).
  907goal_type(expanded,	      goal_expanded,	 []).
  908goal_type(extern(_),	      goal_extern,	 []).
  909goal_type(extern(_,_),	      goal_extern,	 []).
  910goal_type(recursion,	      goal_recursion,	 []).
  911goal_type(meta,		      goal_meta,	 []).
  912goal_type(foreign(_),	      goal_foreign,	 []).
  913goal_type(local(Line),	      goal_local,	 [line(Line)]).
  914goal_type(constraint(Line),   goal_constraint,	 [line(Line)]).
  915goal_type(not_callable,	      goal_not_callable, []).

 goal_arity(+Goal, -Arity) is det

Get the arity of a goal safely in SWI7

  921goal_arity(Goal, Arity) :-
  922	(   compound(Goal)
  923	->  compound_name_arity(Goal, _, Arity)
  924	;   Arity = 0
  925	).
  926
  927		 /*******************************
  928		 *	 HIGHLIGHT CONFIG	*
  929		 *******************************/
  930
  931:- multifile
  932	swish_config:config/2,
  933	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

  944swish_config:config(cm_style, Styles) :-
  945	findall(Name-Style, highlight_style(Name, Style), Pairs),
  946	keysort(Pairs, Sorted),
  947	remove_duplicate_styles(Sorted, Unique),
  948	dict_pairs(Styles, json, Unique).
  949swish_config:config(cm_hover_style, Styles) :-
  950	findall(Sel-Attrs, css_dict(hover, Sel, Attrs), Pairs),
  951	dict_pairs(Styles, json, Pairs).
  952
  953remove_duplicate_styles([], []).
  954remove_duplicate_styles([H|T0], [H|T]) :-
  955	H = K-_,
  956	remove_same(K, T0, T1),
  957	remove_duplicate_styles(T1, T).
  958
  959remove_same(K, [K-_|T0], T) :- !,
  960	remove_same(K, T0, T).
  961remove_same(_, Rest, Rest).
  962
  963highlight_style(StyleName, Style) :-
  964	style(Term, StyleName, _),
  965	atom(StyleName),
  966	(   prolog_colour:style(Term, Attrs0)
  967        ->  maplist(css_style, Attrs0, Attrs),
  968	    dict_create(Style, json, Attrs)
  969	).
  970
  971css_style(bold(true),      'font-weight'(bold)) :- !.
  972css_style(underline(true), 'text-decoration'(underline)) :- !.
  973css_style(colour(Name), color(RGB)) :-
  974	x11_color(Name, R, G, B),
  975	format(atom(RGB), '#~|~`0t~16r~2+~`0t~16r~2+~`0t~16r~2+', [R,G,B]).
  976css_style(Style, Style).

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

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

  982x11_color(Name, R, G, B) :-
  983	(   x11_colors_done
  984	->  true
  985	;   with_mutex(swish_highlight, load_x11_colours)
  986	),
  987	x11_color_cache(Name, R, G, B).
  988
  989:- dynamic
  990	x11_color_cache/4,
  991	x11_colors_done/0.  992
  993load_x11_colours :-
  994	x11_colors_done, !.
  995load_x11_colours :-
  996	source_file(load_x11_colours, File),
  997	file_directory_name(File, Dir),
  998	directory_file_path(Dir, 'rgb.txt', RgbFile),
  999	setup_call_cleanup(
 1000	    open(RgbFile, read, In),
 1001	    ( lazy_list(lazy_read_lines(In, [as(string)]), List),
 1002	      maplist(assert_colour, List)
 1003	    ),
 1004	    close(In)),
 1005	asserta(x11_colors_done).
 1006
 1007assert_colour(String) :-
 1008	split_string(String, "\s\t\r", "\s\t\r", [RS,GS,BS|NameParts]),
 1009	number_string(R, RS),
 1010	number_string(G, GS),
 1011	number_string(B, BS),
 1012	atomic_list_concat(NameParts, '_', Name0),
 1013	downcase_atom(Name0, Name),
 1014	assertz(x11_color_cache(Name, R, G, B)).
 1015
 1016:- 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.

 1029css_dict(Context, Selector, Style) :-
 1030	css(Context, Selector, Attrs0),
 1031	maplist(css_style, Attrs0, Attrs),
 1032	dict_create(Style, json, Attrs).
 1033
 1034
 1035		 /*******************************
 1036		 *	       INFO		*
 1037		 *******************************/
 1038
 1039:- multifile
 1040	prolog:predicate_summary/2.

 token_info(+Request)

HTTP handler that provides information about a token.

 1046token_info(Request) :-
 1047	http_parameters(Request, [], [form_data(Form)]),
 1048	maplist(type_convert, Form, Values),
 1049	dict_create(Token, token, Values),
 1050	reply_html_page(plain,
 1051			title('token info'),
 1052			\token_info_or_none(Token)).
 1053
 1054type_convert(Name=Atom, Name=Number) :-
 1055	atom_number(Atom, Number), !.
 1056type_convert(NameValue, NameValue).
 1057
 1058
 1059token_info_or_none(Token) -->
 1060	token_info(Token), !.
 1061token_info_or_none(_) -->
 1062	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.

 1071:- multifile token_info//1. 1072
 1073token_info(Token) -->
 1074	{ _{type:Type, text:Name, arity:Arity} :< Token,
 1075	  goal_type(_, Type, _), !,
 1076	  ignore(token_predicate_module(Token, Module)),
 1077	  text_arity_pi(Name, Arity, PI),
 1078	  predicate_info(Module:PI, Info)
 1079	},
 1080	pred_info(Info).
 1081
 1082pred_info([]) -->
 1083	html(span(class('pred-nosummary'), 'No help available')).
 1084pred_info([Info|_]) -->			% TBD: Ambiguous
 1085	(pred_tags(Info)     -> [];[]),
 1086	(pred_summary(Info)  -> [];[]).
 1087
 1088pred_tags(Info) -->
 1089	{ Info.get(iso) == true },
 1090	html(span(class('pred-tag'), 'ISO')).
 1091
 1092pred_summary(Info) -->
 1093	html(span(class('pred-summary'), Info.get(summary))).

 token_predicate_module(+Token, -Module) is semidet

Try to extract the module from the token.

 1099token_predicate_module(Token, Module) :-
 1100	source_file_property(Token.get(file), module(Module)), !.
 1101
 1102text_arity_pi('[', 2, consult/1) :- !.
 1103text_arity_pi(']', 2, consult/1) :- !.
 1104text_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

 1123predicate_info(PI, Info) :-
 1124	PI = Module:Name/Arity,
 1125	findall(Dict,
 1126		( setof(Key-Value,
 1127			predicate_info(PI, Key, Value),
 1128			Pairs),
 1129		  dict_pairs(Dict, json,
 1130			     [ module - Module,
 1131			       name   - Name,
 1132			       arity  - Arity
 1133			     | Pairs
 1134			     ])
 1135		),
 1136		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.

 1149					% ISO predicates
 1150predicate_info(Module:Name/Arity, Key, Value) :-
 1151	functor(Head, Name, Arity),
 1152	predicate_property(system:Head, iso), !,
 1153	ignore(Module = system),
 1154	(   man_predicate_summary(Name/Arity, Summary),
 1155	    Key = summary,
 1156	    Value = Summary
 1157	;   Key = iso,
 1158	    Value = true
 1159	).
 1160predicate_info(PI, summary, Summary) :-
 1161	PI = Module:Name/Arity,
 1162
 1163	(   man_predicate_summary(Name/Arity, Summary)
 1164	->  true
 1165	;   Arity >= 2,
 1166	    DCGArity is Arity - 2,
 1167	    man_predicate_summary(Name//DCGArity, Summary)
 1168	->  true
 1169	;   prolog:predicate_summary(PI, Summary)
 1170	->  true
 1171	;   Arity >= 2,
 1172	    DCGArity is Arity - 2,
 1173	    prolog:predicate_summary(Module:Name/DCGArity, Summary)
 1174	).
 1175
 1176:- if(current_predicate(man_object_property/2)). 1177man_predicate_summary(PI, Summary) :-
 1178    man_object_property(PI, summary(Summary)).
 1179:- else. 1180man_predicate_summary(_, _) :-
 1181    fail.
 1182:- endif.