35
36:- module(swish_highlight,
37 [ current_highlight_state/2, 38 man_predicate_summary/2 39 ]). 40:- use_module(library(debug)). 41:- use_module(library(settings)). 42:- use_module(library(http/http_dispatch)). 43:- use_module(library(http/html_write)). 44:- use_module(library(http/http_json)). 45:- use_module(library(http/http_path), []). 46:- use_module(library(http/http_parameters)). 47:- use_module(library(pairs)). 48:- use_module(library(apply)). 49:- use_module(library(error)). 50:- use_module(library(prolog_xref)). 51:- use_module(library(memfile)). 52:- use_module(library(prolog_colour)). 53:- use_module(library(lazy_lists)). 54:- if(exists_source(library(pldoc/man_index))). 55:- use_module(library(pldoc/man_index)). 56:- endif. 57
58http:location(codemirror, swish(cm), []).
59
60:- http_handler(codemirror(.), http_404([]), [id(cm_highlight)]). 61:- http_handler(codemirror(change), codemirror_change, []). 62:- http_handler(codemirror(tokens), codemirror_tokens, []). 63:- http_handler(codemirror(leave), codemirror_leave, []). 64:- http_handler(codemirror(info), token_info, []). 65
66:- setting(swish:editor_max_idle_time, nonneg, 3600,
67 "Maximum time we keep a mirror editor around"). 68
78
79 82
100
101codemirror_change(Request) :-
102 call_cleanup(codemirror_change_(Request),
103 check_unlocked).
104
105codemirror_change_(Request) :-
106 http_read_json_dict(Request, Change, []),
107 debug(cm(change), 'Change ~p', [Change]),
108 atom_string(UUID, Change.uuid),
109 catch(shadow_editor(Change, TB),
110 cm(Reason), true),
111 ( var(Reason)
112 -> ( catch(apply_change(TB, Changed, Change.change),
113 cm(outofsync), fail)
114 -> mark_changed(TB, Changed),
115 release_editor(UUID),
116 reply_json_dict(true)
117 ; destroy_editor(UUID),
118 change_failed(UUID, outofsync)
119 )
120 ; change_failed(UUID, Reason)
121 ).
122
123change_failed(UUID, Reason) :-
124 reply_json_dict(json{ type:Reason,
125 object:UUID
126 },
127 [status(409)]).
128
129
138
139apply_change(_, _Changed, []) :- !.
140apply_change(TB, Changed, Change) :-
141 _{from:From} :< Change,
142 Line is From.line+1,
143 memory_file_line_position(TB, Line, From.ch, ChPos),
144 remove(Change.removed, TB, ChPos, Changed),
145 insert(Change.text, TB, ChPos, _End, Changed),
146 ( Next = Change.get(next)
147 -> apply_change(TB, Changed, Next)
148 ; true
149 ).
150
151remove([], _, _, _) :- !.
152remove([H|T], TB, ChPos, Changed) :-
153 string_length(H, Len),
154 ( T == []
155 -> DLen is Len
156 ; DLen is Len+1
157 ),
158 ( DLen == 0
159 -> true
160 ; Changed = true,
161 memory_file_substring(TB, ChPos, Len, _, Text),
162 ( Text == H
163 -> true
164 ; throw(cm(outofsync))
165 ),
166 delete_memory_file(TB, ChPos, DLen)
167 ),
168 remove(T, TB, ChPos, Changed).
169
170insert([], _, ChPos, ChPos, _) :- !.
171insert([H|T], TB, ChPos0, ChPos, Changed) :-
172 ( H == ""
173 -> Len = 0
174 ; Changed = true,
175 string_length(H, Len),
176 debug(cm(change_text), 'Insert ~q at ~d', [H, ChPos0]),
177 insert_memory_file(TB, ChPos0, H)
178 ),
179 ChPos1 is ChPos0+Len,
180 ( T == []
181 -> ChPos2 = ChPos1
182 ; debug(cm(change_text), 'Adding newline at ~d', [ChPos1]),
183 Changed = true,
184 insert_memory_file(TB, ChPos1, '\n'),
185 ChPos2 is ChPos1+1
186 ),
187 insert(T, TB, ChPos2, ChPos, Changed).
188
189:- dynamic
190 current_editor/5, 191 editor_last_access/2, 192 xref_upto_data/1. 193
199
200create_editor(UUID, Editor, Change) :-
201 must_be(atom, UUID),
202 uuid_like(UUID),
203 new_memory_file(Editor),
204 ( RoleString = Change.get(role)
205 -> atom_string(Role, RoleString)
206 ; Role = source
207 ),
208 get_time(Now),
209 mutex_create(Lock),
210 with_mutex(swish_create_editor,
211 register_editor(UUID, Editor, Role, Lock, Now)), !.
212create_editor(UUID, Editor, _Change) :-
213 fetch_editor(UUID, Editor).
214
216register_editor(UUID, Editor, Role, Lock, Now) :-
217 \+ current_editor(UUID, _, _, _, _),
218 mutex_lock(Lock),
219 asserta(current_editor(UUID, Editor, Role, Lock, Now)).
220
224
225current_highlight_state(UUID,
226 highlight{data:Editor,
227 role:Role,
228 created:Created,
229 lock:Lock,
230 access:Access
231 }) :-
232 current_editor(UUID, Editor, Role, Lock, Created),
233 ( editor_last_access(Editor, Access)
234 -> true
235 ; Access = Created
236 ).
237
238
244
245uuid_like(UUID) :-
246 split_string(UUID, "-", "", Parts),
247 maplist(string_length, Parts, [8,4,4,4,12]),
248 \+ current_editor(UUID, _, _, _, _).
249
256
257destroy_editor(UUID) :-
258 must_be(atom, UUID),
259 current_editor(UUID, Editor, _, Lock, _), !,
260 mutex_unlock(Lock),
261 retractall(xref_upto_data(UUID)),
262 retractall(editor_last_access(UUID, _)),
263 ( xref_source_id(UUID, SourceID)
264 -> xref_clean(SourceID),
265 destroy_state_module(UUID)
266 ; true
267 ),
268 269 retractall(current_editor(UUID, Editor, _, _, _)),
270 free_memory_file(Editor).
271destroy_editor(_).
272
285
286:- dynamic
287 gced_editors/1. 288
289editor_max_idle_time(Time) :-
290 setting(swish:editor_max_idle_time, Time).
291
292gc_editors :-
293 get_time(Now),
294 ( gced_editors(Then),
295 editor_max_idle_time(MaxIdle),
296 Now - Then < MaxIdle/3
297 -> true
298 ; retractall(gced_editors(_)),
299 asserta(gced_editors(Now)),
300 fail
301 ).
302gc_editors :-
303 editor_max_idle_time(MaxIdle),
304 forall(garbage_editor(UUID, MaxIdle),
305 destroy_garbage_editor(UUID)).
306
307garbage_editor(UUID, TimeOut) :-
308 get_time(Now),
309 current_editor(UUID, _TB, _Role, _Lock, Created),
310 Now - Created > TimeOut,
311 ( editor_last_access(UUID, Access)
312 -> Now - Access > TimeOut
313 ; true
314 ).
315
316destroy_garbage_editor(UUID) :-
317 fetch_editor(UUID, _TB), !,
318 destroy_editor(UUID).
319destroy_garbage_editor(_).
320
326
327fetch_editor(UUID, TB) :-
328 current_editor(UUID, TB, Role, Lock, _),
329 catch(mutex_lock(Lock), error(existence_error(mutex,_),_), fail),
330 debug(cm(lock), 'Locked ~p', [UUID]),
331 ( current_editor(UUID, TB, Role, Lock, _)
332 -> update_access(UUID)
333 ; mutex_unlock(Lock)
334 ).
335
336release_editor(UUID) :-
337 current_editor(UUID, _TB, _Role, Lock, _),
338 debug(cm(lock), 'Unlocked ~p', [UUID]),
339 mutex_unlock(Lock).
340
341check_unlocked :-
342 check_unlocked(unknown).
343
348
349check_unlocked(Reason) :-
350 thread_self(Me),
351 current_editor(_UUID, _TB, _Role, Lock, _),
352 mutex_property(Lock, status(locked(Me, _Count))), !,
353 unlock(Me, Lock),
354 print_message(error, locked(Reason, Me)),
355 assertion(fail).
356check_unlocked(_).
357
358unlock(Me, Lock) :-
359 mutex_property(Lock, status(locked(Me, _Count))), !,
360 mutex_unlock(Lock),
361 unlock(Me, Lock).
362unlock(_, _).
363
368
369update_access(UUID) :-
370 get_time(Now),
371 ( editor_last_access(UUID, Last),
372 Now-Last < 60
373 -> true
374 ; retractall(editor_last_access(UUID, _)),
375 asserta(editor_last_access(UUID, Now))
376 ).
377
378:- multifile
379 prolog:xref_source_identifier/2,
380 prolog:xref_open_source/2,
381 prolog:xref_close_source/2. 382
383prolog:xref_source_identifier(UUID, UUID) :-
384 current_editor(UUID, _, _, _, _).
385
392
393:- if(current_predicate(prolog_source:close_source/3)). 394prolog:xref_open_source(UUID, Stream) :-
395 fetch_editor(UUID, TB),
396 open_memory_file(TB, read, Stream).
397
398prolog:xref_close_source(UUID, Stream) :-
399 release_editor(UUID),
400 close(Stream).
401:- else. 402prolog:xref_open_source(UUID, Stream) :-
403 fetch_editor(UUID, TB),
404 open_memory_file(TB, read, Stream),
405 release_editor(UUID).
406:- endif. 407
413
414codemirror_leave(Request) :-
415 call_cleanup(codemirror_leave_(Request),
416 check_unlocked).
417
418codemirror_leave_(Request) :-
419 http_read_json_dict(Request, Data, []),
420 ( atom_string(UUID, Data.get(uuid))
421 -> debug(cm(leave), 'Leaving editor ~p', [UUID]),
422 ( fetch_editor(UUID, _TB)
423 -> destroy_editor(UUID)
424 ; debug(cm(leave), 'No editor for ~p', [UUID])
425 )
426 ; debug(cm(leave), 'No editor?? (data=~p)', [Data])
427 ),
428 reply_json_dict(true).
429
433
434mark_changed(MemFile, Changed) :-
435 ( Changed == true,
436 current_editor(UUID, MemFile, _Role, _, _)
437 -> retractall(xref_upto_data(UUID))
438 ; true
439 ).
440
442
443xref(UUID) :-
444 xref_upto_data(UUID), !.
445xref(UUID) :-
446 setup_call_cleanup(
447 fetch_editor(UUID, _TB),
448 ( xref_source_id(UUID, SourceId),
449 xref_state_module(UUID, Module),
450 xref_source(SourceId,
451 [ silent(true),
452 module(Module)
453 ]),
454 asserta(xref_upto_data(UUID))
455 ),
456 release_editor(UUID)).
457
462
463xref_source_id(UUID, UUID).
464
469
470xref_state_module(UUID, UUID) :-
471 ( module_property(UUID, class(temporary))
472 -> true
473 ; set_module(UUID:class(temporary)),
474 add_import_module(UUID, swish, start),
475 maplist(copy_flag(UUID, swish), [var_prefix])
476 ).
477
478copy_flag(Module, Application, Flag) :-
479 current_prolog_flag(Application:Flag, Value), !,
480 set_prolog_flag(Module:Flag, Value).
481copy_flag(_, _, _).
482
483destroy_state_module(UUID) :-
484 module_property(UUID, class(temporary)), !,
485 '$destroy_module'(UUID).
486destroy_state_module(_).
487
488
489 492
497
498codemirror_tokens(Request) :-
499 setup_call_catcher_cleanup(
500 true,
501 codemirror_tokens_(Request),
502 Reason,
503 check_unlocked(Reason)).
504
505codemirror_tokens_(Request) :-
506 http_read_json_dict(Request, Data, []),
507 atom_string(UUID, Data.get(uuid)),
508 debug(cm(tokens), 'Asking for tokens: ~p', [Data]),
509 ( catch(shadow_editor(Data, TB), cm(Reason), true)
510 -> ( var(Reason)
511 -> call_cleanup(enriched_tokens(TB, Data, Tokens),
512 release_editor(UUID)),
513 reply_json_dict(json{tokens:Tokens}, [width(0)])
514 ; check_unlocked(Reason),
515 change_failed(UUID, Reason)
516 )
517 ; reply_json_dict(json{tokens:[[]]})
518 ),
519 gc_editors.
520
521
522enriched_tokens(TB, _Data, Tokens) :- 523 current_editor(UUID, TB, source, _Lock, _), !,
524 xref(UUID),
525 server_tokens(TB, Tokens).
526enriched_tokens(TB, Data, Tokens) :- 527 json_source_id(Data.get(sourceID), SourceID), !,
528 memory_file_to_string(TB, Query),
529 with_mutex(swish_highlight_query,
530 prolog_colourise_query(Query, SourceID, colour_item(TB))),
531 collect_tokens(TB, Tokens).
532enriched_tokens(TB, _Data, Tokens) :-
533 memory_file_to_string(TB, Query),
534 prolog_colourise_query(Query, module(swish), colour_item(TB)),
535 collect_tokens(TB, Tokens).
536
542
543:- if(current_predicate(prolog_colour:to_list/2)). 544json_source_id(StringList, SourceIDList) :-
545 is_list(StringList),
546 StringList \== [], !,
547 maplist(string_source_id, StringList, SourceIDList).
548:- else. 549json_source_id([String|_], SourceID) :-
550 maplist(string_source_id, String, SourceID).
551:- endif. 552json_source_id(String, SourceID) :-
553 string(String),
554 string_source_id(String, SourceID).
555
556string_source_id(String, SourceID) :-
557 atom_string(SourceID, String),
558 ( fetch_editor(SourceID, _TB)
559 -> release_editor(SourceID)
560 ; true
561 ).
562
563
580
581shadow_editor(Data, TB) :-
582 atom_string(UUID, Data.get(uuid)),
583 setup_call_catcher_cleanup(
584 fetch_editor(UUID, TB),
585 once(update_editor(Data, UUID, TB)),
586 Catcher,
587 cleanup_update(Catcher, UUID)), !.
588shadow_editor(Data, TB) :-
589 Text = Data.get(text), !,
590 atom_string(UUID, Data.uuid),
591 create_editor(UUID, TB, Data),
592 debug(cm(change), 'Create editor for ~p', [UUID]),
593 debug(cm(change_text), 'Initialising editor to ~q', [Text]),
594 insert_memory_file(TB, 0, Text).
595shadow_editor(Data, TB) :-
596 _{role:_} :< Data, !,
597 atom_string(UUID, Data.uuid),
598 create_editor(UUID, TB, Data).
599shadow_editor(_Data, _TB) :-
600 throw(cm(existence_error)).
601
602update_editor(Data, _UUID, TB) :-
603 Text = Data.get(text), !,
604 size_memory_file(TB, Size),
605 delete_memory_file(TB, 0, Size),
606 insert_memory_file(TB, 0, Text),
607 mark_changed(TB, true).
608update_editor(Data, UUID, TB) :-
609 Changes = Data.get(changes), !,
610 ( debug(cm(change), 'Patch editor for ~p', [UUID]),
611 maplist(apply_change(TB, Changed), Changes)
612 -> true
613 ; throw(cm(out_of_sync))
614 ),
615 mark_changed(TB, Changed).
616
617cleanup_update(exit, _) :- !.
618cleanup_update(_, UUID) :-
619 release_editor(UUID).
620
621:- thread_local
622 token/3. 623
633
634:- public
635 show_mirror/1,
636 server_tokens/1. 637
638show_mirror(Role) :-
639 current_editor(_UUID, TB, Role, _Lock, _), !,
640 memory_file_to_string(TB, String),
641 write(user_error, String).
642
643server_tokens(Role) :-
644 current_editor(_UUID, TB, Role, _Lock, _), !,
645 enriched_tokens(TB, _{}, Tokens),
646 print_term(Tokens, [output(user_error)]).
647
652
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(_,_). 670
677
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).
693
702
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, 729 Attrs = []
730 ; Type = atom,
731 ( Len =< 5 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 ).
755
782
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, []). 854style(comment(string), comment_string, []). 855style(ext_quant, ext_quant, []).
856style(unused_import, unused_import, [text]).
857style(undefined_import, undefined_import, [text]).
858 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]). 864style(html_raw, html_raw, [text]). 865style(http_location_for_id(_), http_location_for_id, []).
866style(http_no_location_for_id(_), http_no_location_for_id, []).
867 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, []).
916
920
921goal_arity(Goal, Arity) :-
922 ( compound(Goal)
923 -> compound_name_arity(Goal, _, Arity)
924 ; Arity = 0
925 ).
926
927 930
931:- multifile
932 swish_config:config/2,
933 css/3. 934
943
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).
977
981
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). 1017
1028
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 1038
1039:- multifile
1040 prolog:predicate_summary/2. 1041
1045
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')).
1063
1070
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|_]) --> 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))).
1094
1098
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).
1105
1106
1122
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).
1137
1148
1149 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.