1 % (c) 2018-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5
6 :- module(tools_matching,
7 [fuzzy_match_codes_lower_case/2,
8 fuzzy_match_codes/2,
9 codes_to_lower_case/2, % to lower case, also performs Unicode simplifications
10 get_current_keywords/1, get_current_expr_keywords/1,
11 is_b_keyword/2,
12 get_all_svg_attributes/1, is_svg_number_attribute/2, is_svg_color_attribute/1, is_svg_attribute/1,
13 is_svg_color_name/1,
14 get_all_dot_attributes/1, is_dot_attribute/1,
15 get_possible_preferences/1, get_possible_preferences_matches_msg/2,
16 get_possible_top_level_event_matches_msg/2,
17 get_possible_fuzzy_matches_msg/3,
18 get_possible_completions_msg/3,
19 get_possible_fuzzy_matches_and_completions_msg/3 % both in one
20 ]).
21
22 :- use_module(error_manager).
23 :- use_module(self_check).
24 :- use_module(library(lists)).
25
26 :- use_module(module_information).
27
28 :- module_info(group,infrastructure).
29 :- module_info(description,'A few utilities for fuzzy matching and completion.').
30
31 :- set_prolog_flag(double_quotes, codes).
32
33
34 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("a","A")).
35 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("aBcD","ABCd")).
36 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("aBcD","ABxCd")).
37 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("aBxcD","ABCd")).
38 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("aBcD","ABCdx")).
39 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("aBcDx","ABCd")).
40 :- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("a_Bc_D","AB__Cd")).
41 %:- assert_must_succeed(tools_matching:fuzzy_match_codes_lower_case("äÄ","aA")).
42 :- assert_must_fail(tools_matching:fuzzy_match_codes_lower_case("abc","cba")).
43
44
45 fuzzy_match_codes_lower_case(Codes1,Codes2) :-
46 codes_to_lower_case(Codes1,LCodes1),
47 codes_to_lower_case(Codes2,LCodes2),
48 fuzzy_match_codes(LCodes1,LCodes2).
49
50 :- assert_must_succeed(tools_matching:fuzzy_match_codes("aBcD","aBcD")).
51 :- assert_must_succeed(tools_matching:fuzzy_match_codes("aBxcD","aBcD")).
52 :- assert_must_succeed(tools_matching:fuzzy_match_codes("aBcD","aBcxD")).
53 :- assert_must_succeed(tools_matching:fuzzy_match_codes("aBcD","aBcDx")).
54 :- assert_must_succeed(tools_matching:fuzzy_match_codes("xaBcD","aBcD")).
55 :- assert_must_succeed(tools_matching:fuzzy_match_codes("aBcD","xaBcD")).
56 :- assert_must_succeed(tools_matching:fuzzy_match_codes("version","verison")).
57 :- assert_must_fail(tools_matching:fuzzy_match_codes("abc","ABC")).
58
59 fuzzy_match_codes([],[]).
60 fuzzy_match_codes([H|T1],[H|T2]) :- !,fuzzy_match_codes(T1,T2).
61 fuzzy_match_codes([_|T],[_|T]) :- !. % one character rewritten
62 fuzzy_match_codes([H1|T1],L2) :- possible_skip_char(H1),!, % underscore _
63 fuzzy_match_codes(T1,L2).
64 fuzzy_match_codes(L1,[H2|T2]) :- possible_skip_char(H2),!,
65 fuzzy_match_codes(L1,T2).
66 fuzzy_match_codes([_|T],T) :- !. % one character too much
67 fuzzy_match_codes(T,[_|T]) :- !. % one character too few
68 fuzzy_match_codes([H1,H2|T],[H2,H1|T]) :- !. % swapping of two characters
69
70
71 %:- assert_must_succeed(tools_matching:codes_to_lower_case("äÄöAa","aaoaa")).
72
73 codes_to_lower_case(Codes,LC) :- maplist(code_to_lower_case,Codes,LC).
74 % TO DO: normalise more UNICODE symbols, ...
75
76 code_to_lower_case(Char,LC_Char) :- Char >= 65, Char =< 90,!, LC_Char is Char+32.
77 code_to_lower_case(Char,LC_Char) :- Char >= 8320, Char =< 8329,!, LC_Char is Char-8272. % Unicode Subscripts
78 code_to_lower_case(8242,R) :- !, R=8242. % Unicode Prime
79 code_to_lower_case(8216,R) :- !, R=8242.
80 code_to_lower_case(8217,R) :- !, R=8242.
81 code_to_lower_case(Char,R) :- Char >= 192, Char =< 197,!, R=97. % upper-case a
82 code_to_lower_case(Char,R) :- Char >= 224, Char =< 229,!, R=97. % lower-case a
83 code_to_lower_case(Char,R) :- Char >= 200, Char =< 203,!, R=101. % upper-case e
84 code_to_lower_case(Char,R) :- Char >= 232, Char =< 235,!, R=101. % lower-case e
85 code_to_lower_case(Char,R) :- Char >= 204, Char =< 207,!, R=105. % upper-case i
86 code_to_lower_case(Char,R) :- Char >= 236, Char =< 239,!, R=105. % lower-case i
87 code_to_lower_case(Char,R) :- Char >= 210, Char =< 214,!, R=111. % upper-case o
88 code_to_lower_case(Char,R) :- Char >= 242, Char =< 246,!, R=111. % lower-case o
89 code_to_lower_case(Char,R) :- Char >= 217, Char =< 220,!, R=117. % upper-case u
90 code_to_lower_case(Char,R) :- Char >= 249, Char =< 252,!, R=117. % lower-case u
91 code_to_lower_case(253,R) :- !, R=121. % ý -> y
92 code_to_lower_case(209,R) :- !, R=110. % Ñ -> n
93 code_to_lower_case(241,R) :- !, R=110. % ñ -> n
94 code_to_lower_case(231,R) :- !, R=99. % ç -> c
95 code_to_lower_case(223,R) :- !, R=115. % ß -> s
96 code_to_lower_case(C,C).
97
98 % use_module(library(between)), between(150,255,R), atom_codes(A,[R]), format("~w : ~w~n",[R,A]),fail.
99
100 possible_skip_char(95). % _
101
102 :- use_module(specfile,[b_or_z_mode/0, csp_mode/0, xtl_mode/0, animation_minor_mode/1, classical_b_mode/0]).
103
104 get_current_expr_keywords(List) :-
105 get_current_keywords([expr,external_funs,pragma,predicate],List).
106 get_current_keywords(List) :-
107 get_current_keywords([expr,external_funs,pragma,predicate,prob_definitions,section,subst],List).
108
109 get_current_keywords(Types,List) :- b_or_z_mode,!,
110 (animation_minor_mode(Minor)
111 -> (classical_b_mode
112 % e.g., for rules_dsl allow both B and rules_dsl keywords at the moment, TODO: remove sections
113 -> get_keywords(Minor,Types,List1),
114 get_keywords(b,Types,List2),
115 append(List1,List2,List)
116 ; get_keywords(Minor,Types,List))
117 ; get_keywords(b,Types,List)).
118 get_current_keywords(_,List) :- csp_mode,!,
119 findall(Def,csp_keyword(Def),List).
120 get_current_keywords(_,List) :- xtl_mode,!,
121 findall(Def,xtl_keyword(Def),List).
122 get_current_keywords(_,[]).
123
124 % -----------------
125
126 csp_keyword(and).
127 csp_keyword(card).
128 csp_keyword(channel).
129 csp_keyword(datatype).
130 csp_keyword(diff).
131 csp_keyword(elem).
132 csp_keyword(empty).
133 csp_keyword(false).
134 csp_keyword(head).
135 csp_keyword(inter).
136 csp_keyword(length).
137 csp_keyword(let).
138 csp_keyword(member).
139 csp_keyword(mod).
140 csp_keyword(nametype).
141 csp_keyword(not).
142 csp_keyword(null).
143 csp_keyword(or).
144 csp_keyword(set).
145 csp_keyword(subtype).
146 csp_keyword(tail).
147 csp_keyword(true).
148 csp_keyword(union).
149 csp_keyword(within).
150 csp_keyword('CHAOS').
151 csp_keyword('Inter').
152 csp_keyword('Seq').
153 csp_keyword('Set').
154 csp_keyword('SKIP').
155 csp_keyword('STOP').
156 csp_keyword('Union').
157
158
159 xtl_keyword(prop).
160 xtl_keyword(start).
161 xtl_keyword(trans).
162 xtl_keyword(animation_image).
163 xtl_keyword(animation_image_click_transition).
164 xtl_keyword(animation_image_right_click_transition).
165 xtl_keyword(animation_function_result).
166 xtl_keyword(heuristic_function_active).
167 xtl_keyword(heuristic_function_result).
168 xtl_keyword(prob_game_info).
169 xtl_keyword(prob_pragma_string).
170
171 % -----------------
172
173 get_keywords(Mode,Types,List) :-
174 (Mode=b,select(prob_definitions,Types,Types1)
175 -> findall(Def,prob_special_def(Def),Ids1)
176 ; Ids1=[], Types1=Types
177 ),
178 (Mode=b,select(external_funs,Types1,Types2)
179 -> findall(Def,prob_external_fun(Def),Ids2,Ids1)
180 ; Ids2=Ids1, Types2=Types1
181 ),
182 findall(ID,(keyword(ID,Type,Modes), member(Mode,Modes), member(Type,Types2)),Ids,Ids2),
183 sort(Ids,List).
184
185 :- use_module(external_function_declarations,[external_function_library/2]).
186 prob_external_fun(Fun) :- external_function_library(Fun,File),
187 member(File,['LibraryStrings.def']). % ideally we want to only show the included libraries
188
189 prob_special_def(Def) :- special_definitions(Def,_).
190 prob_special_def(Def) :- set_pref_keyword(Def,_).
191
192 special_definitions('ASSERT_CTL',model_check).
193 special_definitions('ASSERT_LTL',model_check).
194 special_definitions('GOAL',model_check).
195 special_definitions('HEURISTIC_FUNCTION',model_check).
196 special_definitions('SCOPE',model_check).
197 special_definitions('CUSTOM_GRAPH',dot).
198 special_definitions('CUSTOM_GRAPH_EDGES',dot).
199 special_definitions('CUSTOM_GRAPH_NODES',dot).
200 special_definitions('VISB_JSON_FILE',visb).
201 special_definitions('VISB_SVG_BOX',visb).
202 special_definitions('VISB_SVG_CONTENTS',visb).
203 %special_definitions('VISB_SVG_EVENTS',visb).
204 special_definitions('VISB_SVG_FILE',visb).
205 special_definitions('VISB_SVG_HOVERS',visb).
206 special_definitions('VISB_SVG_OBJECTS',visb).
207 special_definitions('VISB_SVG_UPDATES',visb).
208 special_definitions('ANIMATION_CLICK',tkanim).
209 special_definitions('ANIMATION_EXPRESSION',tkanim).
210 special_definitions('ANIMATION_FUNCTION',tkanim).
211 special_definitions('ANIMATION_FUNCTION_DEFAULT',tkanim).
212 special_definitions('ANIMATION_IMG',tkanim).
213 special_definitions('ANIMATION_RIGHT_CLICK',tkanim).
214 special_definitions('ANIMATION_STR',tkanim).
215 special_definitions('ANIMATION_STR_JUSTIFY_LEFT',tkanim).
216 special_definitions('ANIMATION_STR_JUSTIFY_RIGHT',tkanim).
217 special_definitions('GAME_MCTS_RUNS',mcts).
218 special_definitions('GAME_MCTS_TIMEOUT',mcts).
219 special_definitions('GAME_MCTS_CACHE_LAST_TREE',mcts).
220 special_definitions('GAME_OVER',mcts).
221 special_definitions('GAME_PLAYER',mcts).
222 special_definitions('GAME_VALUE',mcts).
223
224
225 set_pref_keyword(SetPrefAtom,Pref) :-
226 get_possible_preferences(Prefs),
227 member(Pref,Prefs),
228 atom_concat('SET_PREF_',Pref,SetPrefAtom).
229
230 is_b_keyword(ID,Type) :- keyword(ID,Type,L), member(b,L).
231
232 % list of language specific and context specific keywords
233 keyword(not,predicate,[b,eventb]).
234 keyword(or,predicate,[b,eventb]).
235 keyword('true',expr,[eventb]). % truth in Rodin parser
236 keyword('false',expr,[eventb]). % falsity in Rodin parser
237 keyword('TRUE',expr,[b,eventb,tla]).
238 keyword('FALSE',expr,[b,eventb,tla]).
239 keyword('BOOL',expr,[b,eventb]).
240 keyword('bool',expr,[b,eventb]).
241 keyword('POW',expr,[b,eventb]).
242 keyword('POW1',expr,[b,eventb]).
243 keyword('FIN',expr,[b,eventb]).
244 keyword('FIN1',expr,[b,eventb]).
245 keyword('union',expr,[b,eventb]).
246 keyword('inter',expr,[b,eventb]).
247 keyword('UNION',expr,[b,eventb]).
248 keyword('INTER',expr,[b,eventb]).
249 keyword('INTEGER',expr,[b]).
250 keyword('NATURAL',expr,[b]).
251 keyword('NATURAL1',expr,[b]).
252 keyword('INT',expr,[b,eventb]).
253 keyword('NAT',expr,[b,eventb]).
254 keyword('NAT1',expr,[b,eventb]).
255 keyword('MININT',expr,[b]).
256 keyword('MAXINT',expr,[b]).
257 keyword('min',expr,[b,eventb]).
258 keyword('max',expr,[b,eventb]).
259 keyword('SIGMA',expr,[b]).
260 keyword('PI',expr,[b]).
261 keyword('STRING',expr,[b,tla]).
262 keyword('card',expr,[b,eventb]).
263 keyword('finite',expr,[eventb]).
264 keyword('@finite',expr,[b]).
265 keyword('dom',expr,[b,eventb]).
266 keyword('ran',expr,[b,eventb]).
267 keyword('id',expr,[b,eventb]).
268 keyword('@partition',expr,[b]).
269 keyword('partition',expr,[eventb]).
270 keyword('prj1',expr,[b,eventb]).
271 keyword('prj2',expr,[b,eventb]).
272 keyword('@prj1',expr,[b]).
273 keyword('@prj2',expr,[b]).
274 keyword('pred',expr,[b,eventb]).
275 keyword('succ',expr,[b,eventb]).
276 keyword('closure',expr,[b]).
277 keyword('closure1',expr,[b]).
278 keyword('iterate',expr,[b]).
279 keyword('fnc',expr,[b]). % also Event-B ?
280 keyword('rel',expr,[b]).
281
282 keyword('seq',expr,[b]).
283 keyword('seq1',expr,[b]).
284 keyword('iseq',expr,[b]).
285 keyword('iseq1',expr,[b]).
286 keyword('perm',expr,[b]).
287 keyword('size',expr,[b]).
288 keyword('rev',expr,[b]).
289 keyword('first',expr,[b]).
290 keyword('last',expr,[b]).
291 keyword('front',expr,[b]).
292 keyword('tail',expr,[b]).
293 keyword('conc',expr,[b]).
294 keyword('struct',expr,[b]).
295 keyword('rec',expr,[b]).
296 keyword('STRING',expr,[b]).
297
298 % TREE keywords
299 keyword('arity',expr,[b]).
300 keyword('bin',expr,[b]).
301 keyword('btree',expr,[b]).
302 keyword('const',expr,[b]).
303 keyword('father',expr,[b]).
304 keyword('infix',expr,[b]).
305 keyword('left',expr,[b]).
306 keyword('mirror',expr,[b]).
307 keyword('prefix',expr,[b]).
308 keyword('postfix',expr,[b]).
309 keyword('rank',expr,[b]).
310 keyword('right',expr,[b]).
311 keyword('sizet',expr,[b]).
312 keyword('son',expr,[b]).
313 keyword('sons',expr,[b]).
314 keyword('subtree',expr,[b]).
315 keyword('top',expr,[b]).
316 keyword('tree',expr,[b]).
317
318
319 % REAL keywords
320 keyword('floor',expr,[b]).
321 keyword('ceiling',expr,[b]).
322 keyword('real',expr,[b]).
323 keyword('REAL',expr,[b]).
324 keyword('FLOAT',expr,[b]).
325
326 % ---
327
328 keyword('btrue',predicate,[b]).
329 keyword('bfalse',predicate,[b]).
330
331 keyword('skip',subst,[b]).
332 keyword('ANY',subst,[b]).
333 keyword('ASSERT',subst,[b]).
334 keyword('BEGIN',subst,[b]).
335 keyword('CASE',subst,[b,tla]).
336 keyword('CHOICE',subst,[b]).
337 keyword('DO',subst,[b]).
338 keyword('EITHER',subst,[b]).
339 keyword('OR',subst,[b]).
340 keyword('OF',subst,[b]).
341 keyword('PRE',subst,[b]).
342 keyword('SELECT',subst,[b]).
343 keyword('WHERE',subst,[b]).
344 keyword('WHILE',subst,[b]).
345 keyword('WITH',subst,[b,tla]).
346
347 % --
348
349 keyword('ABSTRACT_CONSTANTS',section,[b]).
350 keyword('ABSTRACT_VARIABLES',section,[b]).
351 keyword('ASSERTIONS',section,[b]).
352 keyword('CONCRETE_CONSTANTS',section,[b]).
353 keyword('CONCRETE_VARIABLES',section,[b]).
354 keyword('CONSTANTS',section,[b,tla]).
355 keyword('CONSTRAINTS',section,[b]).
356 keyword('DEFINITIONS',section,[b]).
357 keyword('EVENT',section,[b]).
358 keyword('EXTENDS',section,[b,tla]).
359 keyword('IMPLEMENTATION',section,[b]).
360 keyword('IMPORTS',section,[b]).
361 keyword('INCLUDES',section,[b]).
362 keyword('INITIALISATION',section,[b]).
363 keyword('INITIALIZATION',section,[b]).
364 keyword('INVARIANT',section,[b]).
365 keyword('LOCAL_OPERATIONS',section,[b]).
366 keyword('MACHINE',section,[b]).
367 keyword('MODEL',section,[b]).
368 keyword('OPERATIONS',section,[b]).
369 keyword('PROMOTES',section,[b]).
370 keyword('PROPERTIES',section,[b]).
371 keyword('REFINEMENT',section,[b]).
372 keyword('REFINES',section,[b]).
373 keyword('SEES',section,[b]).
374 keyword('SYSTEM',section,[b]).
375 keyword('USES',section,[b]).
376 keyword('VALUES',section,[b]).
377 keyword('VARIABLES',section,[b,tla]).
378 keyword('VARIANT',section,[b]).
379
380 % rules-dsl sections
381 keyword('ACTIVATION',section,[rules_dsl]).
382 keyword('BODY',section,[rules_dsl]).
383 keyword('CLASSIFICATION',section,[rules_dsl]).
384 keyword('COMPUTATION',section,[rules_dsl]).
385 keyword('COUNTEREXAMPLE',section,[rules_dsl]).
386 keyword('DEPENDS_ON_COMPUTATION',section,[rules_dsl]).
387 keyword('DEPENDS_ON_RULE',section,[rules_dsl]).
388 keyword('DEFINE',section,[rules_dsl]).
389 keyword('DUMMY_VALUE',section,[rules_dsl]).
390 keyword('ERROR_TYPE',section,[rules_dsl]).
391 keyword('ERROR_TYPES',section,[rules_dsl]).
392 keyword('FOR',section,[rules_dsl]).
393 keyword('FUNCTION',section,[rules_dsl]).
394 keyword('POSTCONDITION',section,[rules_dsl]).
395 keyword('PRECONDITION',section,[rules_dsl]).
396 keyword('REFERENCES',section,[rules_dsl]).
397 keyword('REPLACES',section,[rules_dsl]).
398 keyword('RULE_FAIL',section,[rules_dsl]).
399 keyword('RULE_FORALL',section,[rules_dsl]).
400 keyword('RULE',section,[rules_dsl]).
401 keyword('RULEID',section,[rules_dsl]).
402 keyword('RULES_MACHINE',section,[rules_dsl]).
403 keyword('TAGS',section,[rules_dsl]).
404 keyword('TYPE',section,[rules_dsl]).
405 keyword('VALUE',section,[rules_dsl]).
406
407
408 % TODO: check if these below are available within expressions:
409 keyword('DISABLED_RULE',section,[rules_dsl]).
410 keyword('FAILED_RULE',section,[rules_dsl]).
411 keyword('FAILED_RULE_ERROR_TYPE',section,[rules_dsl]).
412 keyword('FAILED_RULE_ALL_ERROR_TYPES',section,[rules_dsl]).
413 keyword('GET_RULE_COUNTEREXAMPLES',section,[rules_dsl]).
414 keyword('NOT_CHECKED_RULE',section,[rules_dsl]).
415 keyword('STRING_FORMAT',section,[rules_dsl]).
416 keyword('SUCCEEDED_RULE',section,[rules_dsl]).
417 keyword('SUCCEEDED_RULE_ERROR_TYPE',section,[rules_dsl]).
418
419
420 keyword('@desc',pragma,[b]).
421 keyword('@file',pragma,[b]).
422 keyword('@generated',pragma,[b]).
423 keyword('@import-package',pragma,[b]).
424 keyword('@label',pragma,[b]).
425 keyword('@package',pragma,[b]).
426 keyword('@symbolic',pragma,[b]).
427
428 % TLA sections
429 keyword('ASSUME',section,[tla]).
430 keyword('ASSUMPTION',section,[tla]).
431 keyword('AXIOM',section,[tla]).
432 keyword('CONSTANT',section,[tla]).
433 keyword('LOCAL',section,[tla]).
434 keyword('INSTANCE',section,[b,tla]).
435 keyword('MODULE',section,[tla]).
436 keyword('THEOREM',section,[tla]).
437
438 keyword('IF',_,[b,tla]).
439 keyword('THEN',_,[b,tla]).
440 keyword('ELSE',_,[b,tla]).
441 keyword('ELSIF',_,[b]).
442 keyword('LET',_,[b,tla]).
443 keyword('BE',_,[b]).
444 keyword('IN',_,[b,tla]).
445 keyword('END',_,[b,tla]).
446
447 % TLA expression keywords
448 keyword('BOOLEAN',expr,[tla]).
449 keyword('Cardinality',expr,[tla]).
450 keyword('CHOOSE',expr,[tla]).
451 keyword('DOMAIN',expr,[tla]).
452 keyword('ENABLED',expr,[tla]).
453 keyword('EXCEPT',expr,[tla]).
454 keyword('SUBSET',expr,[tla]).
455 keyword('UNCHANGED',expr,[tla]).
456 keyword('UNION',expr,[tla]).
457
458 % Alloy sections
459 keyword('abstract',section,[alloy]).
460 keyword('assert',section,[alloy]).
461 keyword('check',section,[alloy]).
462 keyword('extends',section,[alloy]).
463 keyword('fact',section,[alloy]).
464 keyword('fun',section,[alloy]).
465 keyword('module',section,[alloy]).
466 keyword('open',section,[alloy]).
467 keyword('pred',section,[alloy]).
468 keyword('run',section,[alloy]).
469 keyword('sig',section,[alloy]).
470
471
472 keyword('div',expr,[alloy]).
473 keyword('minus',expr,[alloy]).
474 keyword('else',expr,[alloy]).
475 keyword('iden',expr,[alloy]).
476 keyword('let',expr,[alloy]).
477 keyword('mul',expr,[alloy]).
478 keyword('plus',expr,[alloy]).
479 keyword('rem',expr,[alloy]).
480 keyword('sum',expr,[alloy]).
481 keyword('univ',expr,[alloy]).
482
483 keyword('all',predicate,[alloy]).
484 keyword('disjoint',predicate,[alloy]).
485 keyword('iff',predicate,[alloy]).
486 keyword('implies',predicate,[alloy]).
487 keyword('lone',predicate,[alloy]).
488 keyword('not',predicate,[alloy]).
489 keyword('no',predicate,[alloy]).
490 keyword('none',predicate,[alloy]).
491 keyword('one',predicate,[alloy]).
492 keyword('or',predicate,[alloy]).
493 keyword('some',predicate,[alloy]).
494 keyword('set',expr,[alloy]).
495
496 % SVG
497
498 get_all_svg_attributes(SList) :- findall(A,is_svg_attribute(A),List), sort(List,SList).
499
500 % first list of svg attributes which are not number or color attributes
501 is_svg_attribute('clip-path').
502 is_svg_attribute('clip-rule').
503 is_svg_attribute('color-rendering').
504 is_svg_attribute(class).
505 is_svg_attribute(cursor).
506 is_svg_attribute(display).
507 is_svg_attribute('fill-opacity').
508 is_svg_attribute('fill-rule').
509 is_svg_attribute('flood-opacity').
510 is_svg_attribute('font-family').
511 is_svg_attribute('font-style'). % normal | italic | oblique
512 is_svg_attribute('font-variant').
513 is_svg_attribute(from).
514 is_svg_attribute('href'). % use
515 is_svg_attribute(id).
516 is_svg_attribute('marker-end').
517 is_svg_attribute('marker-start').
518 is_svg_attribute(mask).
519 % Note: name is a deprecated SVG attribute
520 is_svg_attribute(path).
521 is_svg_attribute('pointer-events').
522 is_svg_attribute(points). % polyline, polygon
523 is_svg_attribute(radius).
524 is_svg_attribute(repeatDur).
525 is_svg_attribute(restart).
526 is_svg_attribute(rotate).
527 is_svg_attribute(scale).
528 is_svg_attribute(seed).
529 is_svg_attribute('shape-rendering').
530 is_svg_attribute(startoffset).
531 is_svg_attribute(stdDeviation).
532 is_svg_attribute(stitchTiles).
533 is_svg_attribute(stroke).
534 is_svg_attribute('stroke-dasharray').
535 is_svg_attribute('stroke-dashoffset').
536 is_svg_attribute('stroke-linecap').
537 is_svg_attribute('stroke-linejoin').
538 is_svg_attribute('stroke-miterlimit').
539 is_svg_attribute(style).
540 is_svg_attribute(surfaceScale).
541 is_svg_attribute(systemLanguage).
542 is_svg_attribute(tableValues).
543 is_svg_attribute(text).
544 is_svg_attribute('text-anchor').
545 is_svg_attribute('text-decoration').
546 is_svg_attribute('text-rendering').
547 is_svg_attribute(textLength).
548 is_svg_attribute(title). % virtual attribute
549 is_svg_attribute(to).
550 is_svg_attribute(transform).
551 is_svg_attribute(type).
552 is_svg_attribute(visibility).
553 is_svg_attribute('vector-effect').
554 is_svg_attribute('word-spacing').
555 is_svg_attribute('xlink:href').
556 is_svg_attribute(X) :- is_svg_number_attribute(X,_).
557 is_svg_attribute(X) :- is_svg_color_attribute(X).
558 % TODO: complete
559
560 is_svg_color_attribute(color). % can be applied to any element; provides currentcolor value
561 is_svg_color_attribute(fill). % can be applied to [circle,ellipse,path,polygon,polyline,rect,text,tref,tspan]).
562 is_svg_color_attribute(stroke). % can also be applied to all shapes we use circle, ...
563 is_svg_color_attribute('flood-color').
564 is_svg_color_attribute('lighting-color').
565 is_svg_color_attribute('stop-color').
566
567 is_svg_number_attribute(cx,[circle, ellipse, radialGradient]).
568 is_svg_number_attribute(cy,[circle, ellipse, radialGradient]).
569 is_svg_number_attribute(dx,_).
570 is_svg_number_attribute(dy,_).
571 is_svg_number_attribute(opacity,_).
572 is_svg_number_attribute(pathLength,_).
573 is_svg_number_attribute(x,[foreignObject,image,rect,svg,text,tspan,use]). % many more: cursor, image, mask, pattern, ...
574 is_svg_number_attribute(y,[foreignObject,image,rect,svg,text,tspan,use]).
575 is_svg_number_attribute(x1,[line,linearGradient]).
576 is_svg_number_attribute(x2,[line,linearGradient]).
577 is_svg_number_attribute(y1,[line,linearGradient]).
578 is_svg_number_attribute(y2,[line,linearGradient]).
579 is_svg_number_attribute('font-size',_).
580 is_svg_number_attribute('stop-opacity',_).
581 is_svg_number_attribute('stroke-opacity',_).
582 is_svg_number_attribute('stroke-width',_).
583 is_svg_number_attribute(height,[foreignObject,image,rect,svg]). % others like mask ,...
584 is_svg_number_attribute(width, [foreignObject,image,rect,svg]).
585 is_svg_number_attribute(r,[circle, radialGradient]).
586 is_svg_number_attribute(rx,[ellipse,rect]).
587 is_svg_number_attribute(ry,[ellipse,rect]).
588 is_svg_number_attribute(tabindex,_).
589 is_svg_number_attribute(z,_).
590
591 is_svg_color_name(aliceblue).
592 is_svg_color_name(antiquewhite).
593 is_svg_color_name(aqua).
594 is_svg_color_name(aquamarine).
595 is_svg_color_name(azure).
596 is_svg_color_name(beige).
597 is_svg_color_name(bisque).
598 is_svg_color_name(black).
599 is_svg_color_name(blanchedalmond).
600 is_svg_color_name(blue).
601 is_svg_color_name(blueviolet).
602 is_svg_color_name(brown).
603 is_svg_color_name(burlywood).
604 is_svg_color_name(cadetblue).
605 is_svg_color_name(chartreuse).
606 is_svg_color_name(chocolate).
607 is_svg_color_name(coral).
608 is_svg_color_name(cornflowerblue).
609 is_svg_color_name(cornsilk).
610 is_svg_color_name(crimson).
611 is_svg_color_name(cyan).
612 is_svg_color_name(darkblue).
613 is_svg_color_name(darkcyan).
614 is_svg_color_name(darkgoldenrod).
615 is_svg_color_name(darkgray).
616 is_svg_color_name(darkgreen).
617 is_svg_color_name(darkgrey).
618 is_svg_color_name(darkkhaki).
619 is_svg_color_name(darkmagenta).
620 is_svg_color_name(darkolivegreen).
621 is_svg_color_name(darkorange).
622 is_svg_color_name(darkorchid).
623 is_svg_color_name(darkred).
624 is_svg_color_name(darksalmon).
625 is_svg_color_name(darkseagreen).
626 is_svg_color_name(darkslateblue).
627 is_svg_color_name(darkslategray).
628 is_svg_color_name(darkslategrey).
629 is_svg_color_name(darkturquoise).
630 is_svg_color_name(darkviolet).
631 is_svg_color_name(deeppink).
632 is_svg_color_name(deepskyblue).
633 is_svg_color_name(dimgray).
634 is_svg_color_name(dimgrey).
635 is_svg_color_name(dodgerblue).
636 is_svg_color_name(firebrick).
637 is_svg_color_name(floralwhite).
638 is_svg_color_name(forestgreen).
639 is_svg_color_name(fuchsia).
640 is_svg_color_name(gainsboro).
641 is_svg_color_name(ghostwhite).
642 is_svg_color_name(gold).
643 is_svg_color_name(goldenrod).
644 is_svg_color_name(gray).
645 is_svg_color_name(green).
646 is_svg_color_name(greenyellow).
647 is_svg_color_name(grey).
648 is_svg_color_name(honeydew).
649 is_svg_color_name(hotpink).
650 is_svg_color_name(indianred).
651 is_svg_color_name(indigo).
652 is_svg_color_name(ivory).
653 is_svg_color_name(khaki).
654 is_svg_color_name(lavender).
655 is_svg_color_name(lavenderblush).
656 is_svg_color_name(lawngreen).
657 is_svg_color_name(lemonchiffon).
658 is_svg_color_name(lightblue).
659 is_svg_color_name(lightcoral).
660 is_svg_color_name(lightcyan).
661 is_svg_color_name(lightgoldenrodyellow).
662 is_svg_color_name(lightgray).
663 is_svg_color_name(lightgreen).
664 is_svg_color_name(lightgrey).
665 is_svg_color_name(lightpink).
666 is_svg_color_name(lightsalmon).
667 is_svg_color_name(lightseagreen).
668 is_svg_color_name(lightskyblue).
669 is_svg_color_name(lightslategray).
670 is_svg_color_name(lightslategrey).
671 is_svg_color_name(lightsteelblue).
672 is_svg_color_name(lightyellow).
673 is_svg_color_name(lime).
674 is_svg_color_name(limegreen).
675 is_svg_color_name(linen).
676 is_svg_color_name(magenta).
677 is_svg_color_name(maroon).
678 is_svg_color_name(mediumaquamarine).
679 is_svg_color_name(mediumblue).
680 is_svg_color_name(mediumorchid).
681 is_svg_color_name(mediumpurple).
682 is_svg_color_name(mediumseagreen).
683 is_svg_color_name(mediumslateblue).
684 is_svg_color_name(mediumspringgreen).
685 is_svg_color_name(mediumturquoise).
686 is_svg_color_name(mediumvioletred).
687 is_svg_color_name(midnightblue).
688 is_svg_color_name(mintcream).
689 is_svg_color_name(mistyrose).
690 is_svg_color_name(moccasin).
691 is_svg_color_name(navajowhite).
692 is_svg_color_name(navy).
693 is_svg_color_name(oldlace).
694 is_svg_color_name(olive).
695 is_svg_color_name(olivedrab).
696 is_svg_color_name(orange).
697 is_svg_color_name(orangered).
698 is_svg_color_name(orchid).
699 is_svg_color_name(palegoldenrod).
700 is_svg_color_name(palegreen).
701 is_svg_color_name(paleturquoise).
702 is_svg_color_name(palevioletred).
703 is_svg_color_name(papayawhip).
704 is_svg_color_name(peachpuff).
705 is_svg_color_name(peru).
706 is_svg_color_name(pink).
707 is_svg_color_name(plum).
708 is_svg_color_name(powderblue).
709 is_svg_color_name(purple).
710 is_svg_color_name(red).
711 is_svg_color_name(rosybrown).
712 is_svg_color_name(royalblue).
713 is_svg_color_name(saddlebrown).
714 is_svg_color_name(salmon).
715 is_svg_color_name(sandybrown).
716 is_svg_color_name(seagreen).
717 is_svg_color_name(seashell).
718 is_svg_color_name(sienna).
719 is_svg_color_name(silver).
720 is_svg_color_name(skyblue).
721 is_svg_color_name(slateblue).
722 is_svg_color_name(slategray).
723 is_svg_color_name(slategrey).
724 is_svg_color_name(snow).
725 is_svg_color_name(springgreen).
726 is_svg_color_name(steelblue).
727 is_svg_color_name(tan).
728 is_svg_color_name(teal).
729 is_svg_color_name(thistle).
730 is_svg_color_name(tomato).
731 is_svg_color_name(turquoise).
732 is_svg_color_name(violet).
733 is_svg_color_name(wheat).
734 is_svg_color_name(white).
735 is_svg_color_name(whitesmoke).
736 is_svg_color_name(yellow).
737 is_svg_color_name(yellowgreen).
738
739 % ----------------------------
740
741 % DOT
742 get_all_dot_attributes(SList) :- findall(A,is_dot_attribute(A),List), sort(List,SList).
743
744 % see https://graphviz.org/docs/nodes/, comments taken from there
745 is_dot_attribute(area).
746 is_dot_attribute(class). % Classnames to attach to the node, edge, graph, or cluster's SVG element. For svg only.
747 is_dot_attribute(color). % Basic drawing color for graphics, not text.
748 is_dot_attribute(colorscheme). % A color scheme namespace: the context for interpreting color names.
749 is_dot_attribute(comment). % Comments are inserted into output.
750 is_dot_attribute(distortion). % Distortion factor for shape=polygon.
751 is_dot_attribute(fillcolor). % Color used to fill the background of a node or cluster.
752 is_dot_attribute(fixedsize).
753 is_dot_attribute(fontcolor). % Color used for text.
754 is_dot_attribute(fontname). % Font used for text.
755 is_dot_attribute(fontsize). % Font size, in points, used for text.
756 is_dot_attribute(gradientangle). % If a gradient fill is being used, this determines the angle of the fill.
757 is_dot_attribute(group). % Name for a group of nodes, for bundling edges avoiding crossings. For dot only.
758 is_dot_attribute(height). % Height of node, in inches.
759 is_dot_attribute(href). % Synonym for URL. For map, postscript, svg only.
760 is_dot_attribute(id). % Identifier for graph objects. For map, postscript, svg only.
761 is_dot_attribute(image).
762 is_dot_attribute(imagepos).
763 is_dot_attribute(imagescale).
764 is_dot_attribute(label). % Text label attached to objects.
765 is_dot_attribute(labelloc). % Vertical placement of labels for nodes, root graphs and clusters.
766 is_dot_attribute(layer). % Specifies layers in which the node, edge or cluster is present.
767 %is_dot_attribute(margin). % For graphs, this sets x and y margins of canvas, in inches.
768 is_dot_attribute(nojustify). % Whether to justify multiline text vs the previous text line (rather than the side of the container).
769 is_dot_attribute(ordering). % default, out, in Constrains the left-to-right ordering of node edges. For dot only.
770 is_dot_attribute(orientation).% node shape rotation angle, or graph orientation.
771 is_dot_attribute(penwidth). % Specifies the width of the pen, in points, used to draw lines and curves.
772 is_dot_attribute(peripheries). % Set number of peripheries used in polygonal shapes and cluster boundaries.
773 is_dot_attribute(pin).
774 is_dot_attribute(pos).
775 is_dot_attribute(rects).
776 is_dot_attribute(regular).
777 is_dot_attribute(root).
778 is_dot_attribute(samplepoints). % Gives the number of points used for a circle/ellipse node.
779 is_dot_attribute(shape). % Sets the shape of a node.
780 is_dot_attribute(shapefile).
781 is_dot_attribute(showboxes). % Print guide boxes for debugging. For dot only.
782 is_dot_attribute(style). % Set style information for components of the graph.
783 is_dot_attribute(skew). % Skew factor for shape=polygon.
784 is_dot_attribute(sides). % Number of sides when shape=polygon.
785 is_dot_attribute(sortv). % Sort order of graph components for ordering packmode packing.
786 is_dot_attribute(target). % If the object has a URL, this attribute determines which window of the browser is used for the URL. For map, svg only.
787 is_dot_attribute(tooltip). % Tooltip (mouse hover text) attached to the node, edge, cluster, or graph
788 is_dot_attribute('URL').
789 is_dot_attribute(vertices).
790 is_dot_attribute(width). % Width of node, in inches.
791 is_dot_attribute(xlabel). % External label for a node or edge.
792 is_dot_attribute(xlp). % Position of an exterior label, in points. For write only.
793 is_dot_attribute(z). % Z-coordinate value for 3D layouts and displays.
794
795 % additional edge attributes from https://graphviz.org/docs/edges/
796 is_dot_attribute(arrowhead). % Style of arrowhead on the head node of an edge.
797 is_dot_attribute(arrowsize). % Multiplicative scale factor for arrowheads.
798 is_dot_attribute(arrowtail). % Style of arrowhead on the tail node of an edge.
799 is_dot_attribute(constraint). % If false, the edge is not used in ranking the nodes. For dot only.
800 is_dot_attribute(decorate). % Whether to connect the edge label to the edge with a line.
801 is_dot_attribute(dir). % Edge type for drawing arrowheads. (forward, back, both, none)
802 is_dot_attribute(headlabel). % Text label to be placed near head of edge.
803 is_dot_attribute(headport). % Indicates where on the head node to attach the head of the edge.
804 is_dot_attribute(labelangle).
805 is_dot_attribute(labeldistance).
806 is_dot_attribute(labelfloat).
807 is_dot_attribute(labelfontcolor). % Color used for headlabel and taillabel.
808 is_dot_attribute(labelfontname). % Font for headlabel and taillabel.
809 is_dot_attribute(labelfontsize). % Font size of headlabel and taillabel.
810 is_dot_attribute(len).
811 is_dot_attribute(lhead). % Logical head of an edge. For dot only.
812 is_dot_attribute(minlen). % Minimum edge length (rank difference between head and tail). For dot only.
813 is_dot_attribute(taillabel). % Text label to be placed near tail of edge.
814 is_dot_attribute(tailport). % Indicates where on the tail node to attach the tail of the edge.
815 is_dot_attribute(weight). % Weight of edge. In dot, the heavier the weight, the shorter, straighter and more vertical the edge is.
816
817 % for graphs:
818 is_dot_attribute(bgcolor).
819 % https://graphviz.org/doc/info/colors.html#brewer
820 % ex: accent8, blue9, brbg11, bugn9, bupu9, dark28, gnbu9, greeens9, greys9, oranges9, set312, set39, spectral11
821 % does not work as graph attribute, needs to be set as default node/edge attribute or added to nodes/edges
822 is_dot_attribute(compound). % If true, allow edges between clusters. For dot only, relevant for lhead/ltail edge attrs
823 is_dot_attribute(concentrate). % If true, use edge concentrators.
824 is_dot_attribute(landscape). % If true, the graph is rendered in landscape mode.
825 is_dot_attribute(layout). % Which layout engine to use. dot, neato, circo, fdp, sfdp, twopi, patchwork, nop, nop2
826 is_dot_attribute(mode). % Technique for optimizing the layout
827 %is_dot_attribute(ordering). % declared for nodes above, Constrains the left-to-right ordering of node edges. For dot only. out, in
828 %is_dot_attribute(orientation). % declared for nodes above, node shape rotation angle, or graph orientation
829 is_dot_attribute(outputorder). % Specify order in which nodes and edges are drawn
830 is_dot_attribute(overlap). % Determines if and how node overlaps should be removed
831 is_dot_attribute(rankdir). % Sets direction of graph layout. For dot only. TB, BT, LR, RL
832 is_dot_attribute(ranksep). % Specifies separation between ranks. For dot, twopi only.
833 is_dot_attribute(ratio). % Sets the aspect ratio (drawing height/drawing width) for the drawing.
834 is_dot_attribute(scale). % Scales layout by the given factor after the initial layout
835 is_dot_attribute(size). % Maximum width and height of drawing, in inches
836 is_dot_attribute(splines).
837
838 is_dot_attribute(directed). % virtual attribute -> influences whether dot_graph_generator writes digraph or graph
839 is_dot_attribute(strict). % virtual attribute -> influences whether dot_graph_generator writes strict digraph/graph
840
841 % -------------
842
843
844 % translate_keywords:classical_b_keyword(K), \+ tools_matching:keyword(K,_,_). % Note: items is not a B keyword
845 % TO DO: complete keywords for Alloy, TLA, Z minor modes; possibly add VisB/SVG and CUSTOM_GRAPH/GraphViz attributes
846
847 :- use_module(preferences,[eclipse_preference/2]).
848 get_possible_preferences(SPrefs) :-
849 findall(Pref,eclipse_preference(Pref,_),P),
850 sort(P,SPrefs).
851
852 get_possible_preferences_matches_msg(String,FuzzyMatchMsg) :-
853 get_possible_preferences(Prefs),
854 if(get_possible_fuzzy_matches_and_completions_msg(String,Prefs,FuzzyMatchMsg),
855 true,
856 get_possible_inner_matches_msg(String,Prefs,FuzzyMatchMsg)). % also look for inner matches
857
858 :- use_module(specfile,[get_possible_language_specific_top_level_event/3]).
859 :- use_module(bmachine,[b_is_operation_name/1]).
860 get_possible_top_level_event_matches_msg(String,FuzzyMatchMsg) :-
861 findall(Op,get_possible_language_specific_top_level_event(Op,_,_),Ops), sort(Ops,SOps),
862 if(get_possible_fuzzy_matches_and_completions_msg(String,SOps,FuzzyMatchMsg),
863 true,
864 get_possible_inner_matches_msg(String,SOps,FuzzyMatchMsg)). % also look for inner matches
865
866
867 get_possible_fuzzy_matches_and_completions_msg(String,AllIds,FuzzyMatchMsg) :-
868 (get_possible_fuzzy_matches_msg(String,AllIds,FuzzyMatchMsg) ;
869 get_possible_completions_msg(String,AllIds,FuzzyMatchMsg)).
870
871 get_possible_fuzzy_matches(ID,AllIDs,FuzzyMatches) :-
872 atom_codes(ID,IDCodes),
873 findall(Target,(member(Target,AllIDs),atom_codes(Target,TargetCodes),
874 fuzzy_match_codes_lower_case(IDCodes,TargetCodes)),FuzzyMatches).
875
876 % get possible matches as atom which can be used after phrase: Did you mean:
877 get_possible_fuzzy_matches_msg(ID,AllIDs,Msg) :-
878 get_possible_fuzzy_matches(ID,AllIDs,FuzzyMatches),
879 get_match_msg(FuzzyMatches,Msg).
880
881 get_match_msg(FuzzyMatches,Msg) :-
882 length(FuzzyMatches,Nr), Nr>0,
883 get_msg(FuzzyMatches,Nr,Msg).
884
885 :- use_module(tools_strings,[ajoin/2,ajoin_with_sep/3]).
886 get_msg([Match],1,Res) :- !, Res=Match.
887 get_msg(List,Nr,Msg) :- Nr < 6, !,
888 ajoin_with_sep(List,',',Msg).
889 get_msg([First|_],Nr,Msg) :- N1 is Nr-1,
890 ajoin([First,' (',N1,' more matches)'],Msg).
891
892
893
894 % get possible completions as atom which can be used after phrase: Did you mean:
895 get_possible_completions_msg(ID,SortedAllIDs,Msg) :-
896 atom_codes(ID,IDCodes0),
897 codes_to_lower_case(IDCodes0,IDCodes),
898 findall(Target,(member(Target,SortedAllIDs),atom_codes(Target,TargetCodes),
899 codes_to_lower_case(TargetCodes,TC2),
900 prefix(TC2,IDCodes) % IDCodes is a prefix of the target
901 ),Completions),
902 get_match_msg(Completions,Msg).
903
904
905 % get possible interior matches as atom which can be used after phrase: Did you mean:
906 get_possible_inner_matches_msg(ID,SortedAllIDs,Msg) :-
907 atom_codes(ID,IDCodes0),
908 length(IDCodes0,Len), Len>3, % only do this if the string is long enough
909 codes_to_lower_case(IDCodes0,IDCodes),
910 findall(Target,(member(Target,SortedAllIDs),atom_codes(Target,TargetCodes),
911 codes_to_lower_case(TargetCodes,TC2),
912 % format('Looking for ~s inside ~s or vice-versa~n',[IDCodes,TC2]),
913 (sublist(IDCodes,TC2,_Before) -> true
914 ; sublist(TC2,IDCodes,_))
915 ),Completions),
916 get_match_msg(Completions,Msg).
917
918