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").   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	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)]).
  138
  139
  140%%	apply_change(+TB, -Changed, +Changes) is det.
  141%
  142%	Note that the argument order is like this to allow for maplist.
  143%
  144%	@arg Changed is left unbound if there are no changes or unified
  145%	to =true= if something has changed.
  146%
  147%	@throws	cm(outofsync) if an inconsistent delete is observed.
  148
  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
  203
  204%%	create_editor(+UUID, -Editor, +Change) is det.
  205%
  206%	Create a new editor for source UUID   from Change. The editor is
  207%	created  in  a  locked  state  and    must   be  released  using
  208%	release_editor/1 before it can be publically used.
  209
  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)).
  230
  231%%	current_highlight_state(?UUID, -State) is nondet.
  232%
  233%	Return info on the current highlighter
  234
  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	).
  247
  248
  249%%	uuid_like(+UUID) is semidet.
  250%
  251%	Do some sanity checking on  the  UUID   because  we  use it as a
  252%	temporary module name and thus we must be quite sure it will not
  253%	conflict with anything.
  254
  255uuid_like(UUID) :-
  256	split_string(UUID, "-", "", Parts),
  257	maplist(string_length, Parts, [8,4,4,4,12]),
  258	\+ current_editor(UUID, _, _, _, _).
  259
  260%%	destroy_editor(+UUID)
  261%
  262%	Destroy source admin UUID: the shadow  text (a memory file), the
  263%	XREF data and the module used  for cross-referencing. The editor
  264%	must  be  acquired  using  fetch_editor/2    before  it  can  be
  265%	destroyed.
  266
  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(_).
  282
  283%%	gc_editors
  284%
  285%	Garbage collect all editors that have   not been accessed for 60
  286%	minutes.
  287%
  288%	@tbd  Normally,  deleting  a  highlight    state   can  be  done
  289%	aggressively as it will be recreated  on demand. But, coloring a
  290%	query passes the UUIDs of related sources and as yet there is no
  291%	way to restore this. We could fix  that by replying to the query
  292%	colouring with the UUIDs for which we do not have sources, after
  293%	which the client retry the query-color request with all relevant
  294%	sources.
  295
  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(_).
  330
  331%%	fetch_editor(+UUID, -MemFile) is semidet.
  332%
  333%	Fetch existing editor for source UUID.   Update  the last access
  334%	time. After success, the editor is   locked and must be released
  335%	using release_editor/1.
  336
  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).
  353
  354%!	check_unlocked(+Reason)
  355%
  356%	Verify that all editors locked by this thread are unlocked
  357%	again.
  358
  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(_, _).
  373
  374%%	update_access(+UUID)
  375%
  376%	Update the registered last access. We only update if the time is
  377%	behind for more than a minute.
  378
  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, _, _, _, _).
  395
  396%%	prolog:xref_open_source(+UUID, -Stream)
  397%
  398%	Open a source. As we cannot open   the same source twice we must
  399%	lock  it.  As  of  7.3.32   this    can   be  done  through  the
  400%	prolog:xref_close_source/2 hook. In older  versions   we  get no
  401%	callback on the close, so we must leave the editor unlocked.
  402
  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.  417
  418%%	codemirror_leave(+Request)
  419%
  420%	POST  handler  that  deals  with    destruction  of  our  mirror
  421%	associated  with  an  editor,   as    well   as  the  associated
  422%	cross-reference information.
  423
  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).
  447
  448%%	mark_changed(+MemFile, ?Changed) is det.
  449%
  450%	Mark that our cross-reference data might be obsolete
  451
  452mark_changed(MemFile, Changed) :-
  453	(   Changed == true,
  454	    current_editor(UUID, MemFile, _Role, _, _)
  455	->  retractall(xref_upto_data(UUID))
  456	;   true
  457	).
  458
  459%%	xref(+UUID) is det.
  460
  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)).
  475
  476%%	xref_source_id(+Editor, -SourceID) is det.
  477%
  478%	SourceID is the xref source  identifier   for  Editor. As we are
  479%	using UUIDs we just use the editor.
  480
  481xref_source_id(UUID, UUID).
  482
  483%%	xref_state_module(+UUID, -Module) is semidet.
  484%
  485%	True if we must run the cross-referencing   in  Module. We use a
  486%	temporary module based on the UUID of the source.
  487
  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		 *******************************/
  510
  511%%	codemirror_tokens(+Request)
  512%
  513%	HTTP POST handler that returns an array of tokens for the given
  514%	editor.
  515
  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).
  562
  563%%	json_source_id(+Input, -SourceID)
  564%
  565%	Translate the Input, which is  either  a   string  or  a list of
  566%	strings into an  atom  or  list   of  atoms.  Older  versions of
  567%	SWI-Prolog only accept a single atom source id.
  568
  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	).
  588
  589
  590%%	shadow_editor(+Data, -MemoryFile) is det.
  591%
  592%	Get our shadow editor:
  593%
  594%	  1. If we have one, it is updated from either the text or the changes.
  595%	  2. If we have none, but there is a `text` property, create one
  596%	     from the text.
  597%	  3. If there is a `role` property, create an empty one.
  598%
  599%	This predicate fails if the server thinks we have an editor with
  600%	state that must be reused, but  this   is  not true (for example
  601%	because we have been restarted).
  602%
  603%	@throws cm(existence_error) if the target editor did not exist
  604%	@throws cm(out_of_sync) if the changes do not apply due to an
  605%	internal error or a lost message.
  606
  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.  649
  650%%	show_mirror(+Role) is det.
  651%%	server_tokens(+Role) is det.
  652%
  653%	These predicates help debugging the   server side. show_mirror/0
  654%	displays the text the server thinks is in the client editor. The
  655%	predicate server_tokens/1 dumps the token list.
  656%
  657%	@arg	Role is one of =source= or =query=, expressing the role of
  658%		the editor in the SWISH UI.
  659
  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)]).
  673
  674%%	server_tokens(+TextBuffer, -Tokens) is det.
  675%
  676%	@arg	Tokens is a nested list of Prolog JSON terms.  Each group
  677%		represents the tokens found in a single toplevel term.
  678
  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
  700
  701%%	group_by_term(+Tokens, -Nested) is det.
  702%
  703%	Group the tokens by  input   term.  This  simplifies incremental
  704%	updates of the token  list  at  the   client  sides  as  well as
  705%	re-syncronizing. This predicate relies on   the `fullstop` token
  706%	that is emitted at the end of each input term.
  707
  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).
  723
  724%%	json_token(+TB, -Start, -JSON) is nondet.
  725%
  726%	Extract the stored terms.
  727%
  728%	@tbd	We could consider to collect the attributes in the
  729%		colour_item/4 callback and maintain a global variable
  730%		instead of using assert/retract.  Most likely that would
  731%		be faster.  Need to profile to check the bottleneck.
  732
  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	).
  785
  786%%	style(+StyleIn) is semidet.
  787%%	style(+StyleIn, -SWISHType:atomOrPair, -Attributes:list)
  788%
  789%	Declare    that    we    map    StyleIn    as    generated    by
  790%	library(prolog_colour) into a token of type SWISHType, providing
  791%	additional context information based on  Attributes. Elements of
  792%	Attributes are terms of the form Name(Value) or the atom =text=.
  793%	The latter is mapped to text(String),  where String contains the
  794%	text that matches the token character range.
  795%
  796%	The  resulting  JSON  token  object    has  a  property  =type=,
  797%	containing  the  SWISHType  and  the    properties   defined  by
  798%	Attributes.
  799%
  800%	Additional translations can be defined by   adding rules for the
  801%	multifile predicate swish:style/3. The base   type, which refers
  802%	to the type generated by the   SWISH tokenizer must be specified
  803%	by adding an  attribute  base(BaseType).   For  example,  if the
  804%	colour system classifies an  atom  as   refering  to  a database
  805%	column, library(prolog_colour) may emit  db_column(Name) and the
  806%	following rule should ensure consistent mapping:
  807%
  808%	  ==
  809%	  swish_highlight:style(db_column(Name),
  810%				db_column, [text, base(atom)]).
  811%	  ==
  812
  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).
  970
  971%%	goal_arity(+Goal, -Arity) is det.
  972%
  973%	Get the arity of a goal safely in SWI7
  974
  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
  988
  989%%	swish_config:config(-Name, -Styles) is nondet.
  990%
  991%	Provides the object `config.swish.style`,  a   JSON  object that
  992%	maps   style   properties   of    user-defined   extensions   of
  993%	library(prolog_colour). This info is  used   by  the server-side
  994%	colour engine to populate the CodeMirror styles.
  995%
  996%	@tbd	Provide summary information
  997
  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).
 1031
 1032%%	x11_color(+Name, -R, -G, -B)
 1033%
 1034%	True if RGB is the color for the named X11 color.
 1035
 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). 1071
 1072%%	css(?Context, ?Selector, -Style) is nondet.
 1073%
 1074%	Multifile hook to define additional style to apply in a specific
 1075%	context.  Currently defined contexts are:
 1076%
 1077%	  - hover
 1078%	  Used for CodeMirror hover extension.
 1079%
 1080%	@arg Selector is a CSS selector, which is refined by Context
 1081%	@arg Style is a list of Name(Value) terms.
 1082
 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. 1095
 1096%%	token_info(+Request)
 1097%
 1098%	HTTP handler that provides information  about a token.
 1099
 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')).
 1125
 1126%%	token_info(+Token:dict)// is det.
 1127%
 1128%	Generate HTML, providing details about Token.   Token is a dict,
 1129%	providing  the  enriched  token  as  defined  by  style/3.  This
 1130%	multifile non-terminal can be hooked to provide details for user
 1131%	defined style extensions.
 1132
 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))).
 1156
 1157%%	token_predicate_module(+Token, -Module) is semidet.
 1158%
 1159%	Try to extract the module from the token.
 1160
 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).
 1167
 1168
 1169%%	predicate_info(+PI, -Info:list(dict)) is det.
 1170%
 1171%	Info is a list of dicts providing details about predicates that
 1172%	match PI.  Fields in dict are:
 1173%
 1174%	  - module:Atom
 1175%	  Module of the predicate
 1176%	  - name:Atom
 1177%	  Name of the predicate
 1178%	  - arity:Integer
 1179%	  Arity of the predicate
 1180%	  - summary:Text
 1181%	  Summary text extracted from the system manual or PlDoc
 1182%	  - iso:Boolean
 1183%	  Presend and =true= if the predicate is an ISO predicate
 1184
 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).
 1199
 1200%%	predicate_info(?PI, -Key, -Value) is nondet.
 1201%
 1202%	Find information about predicates from   the  system, manual and
 1203%	PlDoc. First, we  deal  with  ISO   predicates  that  cannot  be
 1204%	redefined and are documented in the   manual. Next, we deal with
 1205%	predicates that are documented in  the   manual.
 1206%
 1207%	@bug: Handling predicates documented  in   the  manual  is buggy
 1208%	because their definition may  be  overruled   by  the  user.  We
 1209%	probably must include the file into the equation.
 1210
 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.