36
37:- module(prolog_edit,
38 [ edit/1, 39 edit/0
40 ]). 41:- autoload(library(lists), [member/2, append/3, select/3]). 42:- autoload(library(make), [make/0]). 43:- autoload(library(prolog_breakpoints), [breakpoint_property/2]). 44:- autoload(library(apply), [foldl/5, maplist/3, maplist/2]). 45:- use_module(library(dcg/high_order), [sequence/5]). 46:- autoload(library(readutil), [read_line_to_string/2]). 47
48
50
58
59:- multifile
60 locate/3, 61 locate/2, 62 select_location/3, 63 exists_location/1, 64 user_select/2, 65 edit_source/1, 66 edit_command/2, 67 load/0. 68
72
73edit(Spec) :-
74 notrace(edit_no_trace(Spec)).
75
76edit_no_trace(Spec) :-
77 var(Spec),
78 !,
79 throw(error(instantiation_error, _)).
80edit_no_trace(Spec) :-
81 load_extensions,
82 findall(Location-FullSpec,
83 locate(Spec, FullSpec, Location),
84 Pairs0),
85 sort(Pairs0, Pairs1),
86 merge_locations(Pairs1, Pairs),
87 do_select_location(Pairs, Spec, Location),
88 do_edit_source(Location).
89
98
99edit :-
100 current_prolog_flag(associated_file, File),
101 !,
102 edit(file(File)).
103edit :-
104 '$cmd_option_val'(script_file, OsFiles),
105 OsFiles = [OsFile],
106 !,
107 prolog_to_os_filename(File, OsFile),
108 edit(file(File)).
109edit :-
110 throw(error(context_error(edit, no_default_file), _)).
111
112
113 116
118
119locate(FileSpec:Line, file(Path, line(Line)), #{file:Path, line:Line}) :-
120 integer(Line), Line >= 1,
121 ground(FileSpec), 122 !,
123 locate(FileSpec, _, #{file:Path}).
124locate(FileSpec:Line:LinePos,
125 file(Path, line(Line), linepos(LinePos)),
126 #{file:Path, line:Line, linepos:LinePos}) :-
127 integer(Line), Line >= 1,
128 integer(LinePos), LinePos >= 1,
129 ground(FileSpec), 130 !,
131 locate(FileSpec, _, #{file:Path}).
132locate(Path, file(Path), #{file:Path}) :-
133 atom(Path),
134 exists_file(Path).
135locate(Pattern, file(Path), #{file:Path}) :-
136 atom(Pattern),
137 catch(expand_file_name(Pattern, Files), error(_,_), fail),
138 member(Path, Files),
139 exists_file(Path).
140locate(FileBase, file(File), #{file:File}) :-
141 atom(FileBase),
142 find_source(FileBase, File).
143locate(FileSpec, file(File), #{file:File}) :-
144 is_file_search_spec(FileSpec),
145 find_source(FileSpec, File).
146locate(FileBase, source_file(Path), #{file:Path}) :-
147 atom(FileBase),
148 source_file(Path),
149 file_base_name(Path, File),
150 ( File == FileBase
151 -> true
152 ; file_name_extension(FileBase, _, File)
153 ).
154locate(FileBase, include_file(Path), #{file:Path}) :-
155 atom(FileBase),
156 setof(Path, include_file(Path), Paths),
157 member(Path, Paths),
158 file_base_name(Path, File),
159 ( File == FileBase
160 -> true
161 ; file_name_extension(FileBase, _, File)
162 ).
163locate(Name, FullSpec, Location) :-
164 atom(Name),
165 locate(Name/_, FullSpec, Location).
166locate(Name/Arity, Module:Name/Arity, Location) :-
167 locate(Module:Name/Arity, Location).
168locate(Name//DCGArity, FullSpec, Location) :-
169 ( integer(DCGArity)
170 -> Arity is DCGArity+2,
171 locate(Name/Arity, FullSpec, Location)
172 ; locate(Name/_, FullSpec, Location) 173 ).
174locate(Name/Arity, library(File), #{file:PlPath}) :-
175 atom(Name),
176 '$in_library'(Name, Arity, Path),
177 ( absolute_file_name(library(.), Dir,
178 [ file_type(directory),
179 solutions(all)
180 ]),
181 atom_concat(Dir, File0, Path),
182 atom_concat(/, File, File0)
183 -> find_source(Path, PlPath)
184 ; fail
185 ).
186locate(Module:Name, Module:Name/Arity, Location) :-
187 locate(Module:Name/Arity, Location).
188locate(Module:Head, Module:Name/Arity, Location) :-
189 callable(Head),
190 \+ ( Head = (PName/_),
191 atom(PName)
192 ),
193 functor(Head, Name, Arity),
194 locate(Module:Name/Arity, Location).
195locate(Spec, module(Spec), Location) :-
196 locate(module(Spec), Location).
197locate(Spec, Spec, Location) :-
198 locate(Spec, Location).
199
200include_file(Path) :-
201 source_file_property(Path, included_in(_,_)).
202
206
207is_file_search_spec(Spec) :-
208 compound(Spec),
209 compound_name_arguments(Spec, Alias, [Arg]),
210 is_file_spec(Arg),
211 user:file_search_path(Alias, _),
212 !.
213
214is_file_spec(Name), atom(Name) => true.
215is_file_spec(Name), string(Name) => true.
216is_file_spec(Term), cyclic_term(Term) => fail.
217is_file_spec(A/B) => is_file_spec(A), is_file_spec(B).
218
223
224find_source(FileSpec, File) :-
225 catch(absolute_file_name(FileSpec, File0,
226 [ file_type(prolog),
227 access(read),
228 file_errors(fail)
229 ]),
230 error(_,_), fail),
231 prolog_source(File0, File).
232
233prolog_source(File0, File) :-
234 file_name_extension(_, Ext, File0),
235 user:prolog_file_type(Ext, qlf),
236 !,
237 '$qlf_module'(File0, Info),
238 File = Info.get(file).
239prolog_source(File, File).
240
241
245
246locate(file(File, line(Line)), #{file:File, line:Line}).
247locate(file(File), #{file:File}).
248locate(Module:Name/Arity, #{file:File, line:Line}) :-
249 ( atom(Name), integer(Arity)
250 -> functor(Head, Name, Arity)
251 ; Head = _ 252 ),
253 ( ( var(Module)
254 ; var(Name)
255 )
256 -> NonImport = true
257 ; NonImport = false
258 ),
259 current_predicate(Name, Module:Head),
260 \+ ( NonImport == true,
261 Module \== system,
262 predicate_property(Module:Head, imported_from(_))
263 ),
264 functor(Head, Name, Arity), 265 predicate_property(Module:Head, file(File)),
266 predicate_property(Module:Head, line_count(Line)).
267locate(module(Module), Location) :-
268 atom(Module),
269 module_property(Module, file(Path)),
270 ( module_property(Module, line_count(Line))
271 -> Location = #{file:Path, line:Line}
272 ; Location = #{file:Path}
273 ).
274locate(breakpoint(Id), Location) :-
275 integer(Id),
276 breakpoint_property(Id, clause(Ref)),
277 ( breakpoint_property(Id, file(File)),
278 breakpoint_property(Id, line_count(Line))
279 -> Location = #{file:File, line:Line}
280 ; locate(clause(Ref), Location)
281 ).
282locate(clause(Ref), #{file:File, line:Line}) :-
283 clause_property(Ref, file(File)),
284 clause_property(Ref, line_count(Line)).
285locate(clause(Ref, _PC), #{file:File, line:Line}) :- 286 clause_property(Ref, file(File)),
287 clause_property(Ref, line_count(Line)).
288
289
290 293
305
306do_edit_source(Location) :- 307 edit_source(Location),
308 !.
309do_edit_source(Location) :- 310 current_prolog_flag(editor, Editor),
311 is_pceemacs(Editor),
312 current_prolog_flag(gui, true),
313 !,
314 location_url(Location, URL), 315 run_pce_emacs(URL).
316do_edit_source(Location) :- 317 external_edit_command(Location, Command),
318 print_message(informational, edit(waiting_for_editor)),
319 ( catch(shell(Command), E,
320 (print_message(warning, E),
321 fail))
322 -> print_message(informational, edit(make)),
323 make
324 ; print_message(informational, edit(canceled))
325 ).
326
327external_edit_command(Location, Command) :-
328 #{file:File, line:Line} :< Location,
329 editor(Editor),
330 file_base_name(Editor, EditorFile),
331 file_name_extension(Base, _, EditorFile),
332 edit_command(Base, Cmd),
333 prolog_to_os_filename(File, OsFile),
334 atom_codes(Cmd, S0),
335 substitute('%e', Editor, S0, S1),
336 substitute('%f', OsFile, S1, S2),
337 substitute('%d', Line, S2, S),
338 !,
339 atom_codes(Command, S).
340external_edit_command(Location, Command) :-
341 #{file:File} :< Location,
342 editor(Editor),
343 file_base_name(Editor, EditorFile),
344 file_name_extension(Base, _, EditorFile),
345 edit_command(Base, Cmd),
346 prolog_to_os_filename(File, OsFile),
347 atom_codes(Cmd, S0),
348 substitute('%e', Editor, S0, S1),
349 substitute('%f', OsFile, S1, S),
350 \+ substitute('%d', 1, S, _),
351 !,
352 atom_codes(Command, S).
353external_edit_command(Location, Command) :-
354 #{file:File} :< Location,
355 editor(Editor),
356 format(string(Command), '"~w" "~w"', [Editor, File]).
357
358is_pceemacs(pce_emacs).
359is_pceemacs(built_in).
360
364
365run_pce_emacs(URL) :-
366 autoload_call(in_pce_thread(autoload_call(emacs(URL)))).
367
371
372editor(Editor) :- 373 current_prolog_flag(editor, Editor),
374 ( sub_atom(Editor, 0, _, _, $)
375 -> sub_atom(Editor, 1, _, 0, Var),
376 catch(getenv(Var, Editor), _, fail), !
377 ; Editor == default
378 -> catch(getenv('EDITOR', Editor), _, fail), !
379 ; \+ is_pceemacs(Editor)
380 -> !
381 ).
382editor(Editor) :- 383 getenv('EDITOR', Editor),
384 !.
385editor(vi) :- 386 current_prolog_flag(unix, true),
387 !.
388editor(notepad) :-
389 current_prolog_flag(windows, true),
390 !.
391editor(_) :- 392 throw(error(existence_error(editor), _)).
393
402
403
404edit_command(vi, '%e +%d \'%f\'').
405edit_command(vi, '%e \'%f\'').
406edit_command(emacs, '%e +%d \'%f\'').
407edit_command(emacs, '%e \'%f\'').
408edit_command(notepad, '"%e" "%f"').
409edit_command(wordpad, '"%e" "%f"').
410edit_command(uedit32, '%e "%f/%d/0"'). 411edit_command(jedit, '%e -wait \'%f\' +line:%d').
412edit_command(jedit, '%e -wait \'%f\'').
413edit_command(edit, '%e %f:%d'). 414edit_command(edit, '%e %f').
415
416edit_command(emacsclient, Command) :- edit_command(emacs, Command).
417edit_command(vim, Command) :- edit_command(vi, Command).
418edit_command(nvim, Command) :- edit_command(vi, Command).
419
420substitute(FromAtom, ToAtom, Old, New) :-
421 atom_codes(FromAtom, From),
422 ( atom(ToAtom)
423 -> atom_codes(ToAtom, To)
424 ; number_codes(ToAtom, To)
425 ),
426 append(Pre, S0, Old),
427 append(From, Post, S0) ->
428 append(Pre, To, S1),
429 append(S1, Post, New),
430 !.
431substitute(_, _, Old, Old).
432
433
434 437
438merge_locations([L1|T1], Locations) :-
439 L1 = Loc1-Spec1,
440 select(L2, T1, T2),
441 L2 = Loc2-Spec2,
442 same_location(Loc1, Loc2, Loc),
443 merge_specs(Spec1, Spec2, Spec),
444 !,
445 merge_locations([Loc-Spec|T2], Locations).
446merge_locations(Locations, Locations).
447
448same_location(L, L, L).
449same_location(#{file:F1}, #{file:F2}, #{file:F}) :-
450 best_same_file(F1, F2, F).
451same_location(#{file:F1, line:Line}, #{file:F2}, #{file:F, line:Line}) :-
452 best_same_file(F1, F2, F).
453same_location(#{file:F1}, #{file:F2, line:Line}, #{file:F, line:Line}) :-
454 best_same_file(F1, F2, F).
455
456best_same_file(F1, F2, F) :-
457 catch(same_file(F1, F2), _, fail),
458 !,
459 atom_length(F1, L1),
460 atom_length(F2, L2),
461 ( L1 < L2
462 -> F = F1
463 ; F = F2
464 ).
465
466merge_specs(Spec, Spec, Spec) :-
467 !.
468merge_specs(file(F1), file(F2), file(F)) :-
469 best_same_file(F1, F2, F),
470 !.
471merge_specs(Spec1, Spec2, Spec) :-
472 merge_specs_(Spec1, Spec2, Spec),
473 !.
474merge_specs(Spec1, Spec2, Spec) :-
475 merge_specs_(Spec2, Spec1, Spec),
476 !.
477
478merge_specs_(FileSpec, Spec, Spec) :-
479 is_filespec(FileSpec).
480
481is_filespec(source_file(_)) => true.
482is_filespec(Term),
483 compound(Term),
484 compound_name_arguments(Term, Alias, [_Arg]),
485 user:file_search_path(Alias, _) => true.
486is_filespec(_) =>
487 fail.
488
493
494do_select_location(Pairs, Spec, Location) :-
495 select_location(Pairs, Spec, Location), 496 !,
497 Location \== [].
498do_select_location([], Spec, _) :-
499 !,
500 print_message(warning, edit(not_found(Spec))),
501 fail.
502do_select_location([#{file:File}-file(File)], _, Location) :-
503 !,
504 Location = #{file:File}.
505do_select_location([Location-_Spec], _, Location) :-
506 existing_location(Location),
507 !.
508do_select_location(Pairs, _, Location) :-
509 foldl(number_location, Pairs, NPairs, 1, End),
510 print_message(help, edit(select(NPairs))),
511 ( End == 1
512 -> fail
513 ; Max is End - 1,
514 user_selection(Max, I),
515 memberchk(I-(Location-_Spec), NPairs)
516 ).
517
523
524existing_location(Location) :-
525 exists_location(Location),
526 !.
527existing_location(Location) :-
528 #{file:File} :< Location,
529 access_file(File, read).
530
531number_location(Pair, N-Pair, N, N1) :-
532 Pair = Location-_Spec,
533 existing_location(Location),
534 !,
535 N1 is N+1.
536number_location(Pair, 0-Pair, N, N).
537
538user_selection(Max, I) :-
539 user_select(Max, I),
540 !.
541user_selection(Max, I) :-
542 print_message(help, edit(choose(Max))),
543 read_number(Max, I).
544
548
549read_number(Max, X) :-
550 Max < 10,
551 !,
552 get_single_char(C),
553 put_code(user_error, C),
554 between(0'0, 0'9, C),
555 X is C - 0'0.
556read_number(_, X) :-
557 read_line_to_string(user_input, String),
558 number_string(X, String).
559
560
561 564
565:- multifile
566 prolog:message/3. 567
568prolog:message(edit(Msg)) -->
569 message(Msg).
570
571message(not_found(Spec)) -->
572 [ 'Cannot find anything to edit from "~p"'-[Spec] ],
573 ( { atom(Spec) }
574 -> [ nl, ' Use edit(file(~q)) to create a new file'-[Spec] ]
575 ; []
576 ).
577message(select(NPairs)) -->
578 { \+ (member(N-_, NPairs), N > 0) },
579 !,
580 [ 'Found the following locations:', nl ],
581 sequence(target, [nl], NPairs).
582message(select(NPairs)) -->
583 [ 'Please select item to edit:', nl ],
584 sequence(target, [nl], NPairs).
585message(choose(_Max)) -->
586 [ nl, 'Your choice? ', flush ].
587message(waiting_for_editor) -->
588 [ 'Waiting for editor ... ', flush ].
589message(make) -->
590 [ 'Running make to reload modified files' ].
591message(canceled) -->
592 [ 'Editor returned failure; skipped make/0 to reload files' ].
593
594target(0-(Location-Spec)) ==>
595 [ ansi(warning, '~t*~3| ', [])],
596 edit_specifier(Spec),
597 [ '~t~32|' ],
598 edit_location(Location, false),
599 [ ansi(warning, ' (no source available)', [])].
600target(N-(Location-Spec)) ==>
601 [ ansi(bold, '~t~d~3| ', [N])],
602 edit_specifier(Spec),
603 [ '~t~32|' ],
604 edit_location(Location, true).
605
606edit_specifier(Module:Name/Arity) ==>
607 [ '~w:'-[Module],
608 ansi(code, '~w/~w', [Name, Arity]) ].
609edit_specifier(file(_Path)) ==>
610 [ '<file>' ].
611edit_specifier(source_file(_Path)) ==>
612 [ '<loaded file>' ].
613edit_specifier(include_file(_Path)) ==>
614 [ '<included file>' ].
615edit_specifier(Term) ==>
616 [ '~p'-[Term] ].
617
618edit_location(Location, false) ==>
619 { location_label(Location, Label) },
620 [ ansi(warning, '~s', [Label]) ].
621edit_location(Location, true) ==>
622 { location_label(Location, Label),
623 location_url(Location, URL)
624 },
625 [ url(URL, Label) ].
626
627location_label(Location, Label) :-
628 #{file:File, line:Line} :< Location,
629 !,
630 short_filename(File, ShortFile),
631 format(string(Label), '~w:~d', [ShortFile, Line]).
632location_label(Location, Label) :-
633 #{file:File} :< Location,
634 !,
635 short_filename(File, ShortFile),
636 format(string(Label), '~w', [ShortFile]).
637
638location_url(Location, File:Line:LinePos) :-
639 #{file:File, line:Line, linepos:LinePos} :< Location,
640 !.
641location_url(Location, File:Line) :-
642 #{file:File, line:Line} :< Location,
643 !.
644location_url(Location, File) :-
645 #{file:File} :< Location.
646
652
653short_filename(Path, Spec) :-
654 working_directory(Here, Here),
655 atom_concat(Here, Local0, Path),
656 !,
657 remove_leading_slash(Local0, Spec).
658short_filename(Path, Spec) :-
659 findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
660 keysort(Keyed, [_-Spec|_]).
661short_filename(Path, Path).
662
663aliased_path(Path, Len-Spec) :-
664 setof(Alias, file_alias_path(Alias), Aliases),
665 member(Alias, Aliases),
666 Alias \== autoload, 667 Term =.. [Alias, '.'],
668 absolute_file_name(Term, Prefix,
669 [ file_type(directory),
670 file_errors(fail),
671 solutions(all)
672 ]),
673 atom_concat(Prefix, Local0, Path),
674 remove_leading_slash(Local0, Local1),
675 remove_extension(Local1, Local2),
676 unquote_segments(Local2, Local),
677 atom_length(Local2, Len),
678 Spec =.. [Alias, Local].
679
680file_alias_path(Alias) :-
681 user:file_search_path(Alias, _).
682
683remove_leading_slash(Path, Local) :-
684 atom_concat(/, Local, Path),
685 !.
686remove_leading_slash(Path, Path).
687
688remove_extension(File0, File) :-
689 file_name_extension(File, Ext, File0),
690 user:prolog_file_type(Ext, source),
691 !.
692remove_extension(File, File).
693
694unquote_segments(File, Segments) :-
695 split_string(File, "/", "/", SegmentStrings),
696 maplist(atom_string, SegmentList, SegmentStrings),
697 maplist(no_quote_needed, SegmentList),
698 !,
699 segments(SegmentList, Segments).
700unquote_segments(File, File).
701
702
703no_quote_needed(A) :-
704 format(atom(Q), '~q', [A]),
705 Q == A.
706
707segments([Segment], Segment) :-
708 !.
709segments(List, A/Segment) :-
710 append(L1, [Segment], List),
711 !,
712 segments(L1, A).
713
714
715 718
719load_extensions :-
720 load,
721 fail.
722load_extensions.
723
724:- load_extensions.