1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 1998-2025, University of Amsterdam 7 VU University 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(prolog_edit, 38 [ edit/1, % +Spec 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 49% :- set_prolog_flag(generate_debug_info, false).
59:- multifile 60 locate/3, % +Partial, -FullSpec, -Location 61 locate/2, % +FullSpec, -Location 62 select_location/3, % +Pairs, +Spec, -Location 63 exists_location/1, % +Location 64 user_select/2, % +Max, -I 65 edit_source/1, % +Location 66 edit_command/2, % +Editor, -Command 67 load/0. % provides load-hooks
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).
% swipl [-s] file.pl
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 /******************************* 114 * LOCATE * 115 *******************************/
119locate(FileSpec:Line, file(Path, line(Line)), #{file:Path, line:Line}) :- 120 integer(Line), Line >= 1, 121 ground(FileSpec), % so specific; do not try alts 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), % so specific; do not try alts 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) % demand arity >= 2 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(_,_)).
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).
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).
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 = _ % leave unbound 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), % bind 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}) :- % TBD: use clause 286 clause_property(Ref, file(File)), 287 clause_property(Ref, line_count(Line)). 288 289 290 /******************************* 291 * EDIT * 292 *******************************/
file(File)
and may contain line(Line)
. First the
multifile hook edit_source/1 is called. If this fails the system
checks for XPCE and the prolog-flag editor. If the latter is
built_in or pce_emacs, it will start PceEmacs.
Finally, it will get the editor to use from the prolog-flag editor and use edit_command/2 to determine how this editor should be called.
306do_edit_source(Location) :- % hook 307 edit_source(Location), 308 !. 309do_edit_source(Location) :- % PceEmacs 310 current_prolog_flag(editor, Editor), 311 is_pceemacs(Editor), 312 current_prolog_flag(gui, true), 313 !, 314 location_url(Location, URL), % File[:Line[:LinePos]] 315 run_pce_emacs(URL). 316do_edit_source(Location) :- % External editor 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).
365run_pce_emacs(URL) :-
366 autoload_call(in_pce_thread(autoload_call(emacs(URL)))).
372editor(Editor) :- % $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) :- % User defaults 383 getenv('EDITOR', Editor), 384 !. 385editor(vi) :- % Platform defaults 386 current_prolog_flag(unix, true), 387 !. 388editor(notepad) :- 389 current_prolog_flag(windows, true), 390 !. 391editor(_) :- % No luck 392 throw(error(existence_error(editor), _)).
%e | Path name of the editor |
%f | Path name of the file to be edited |
%d | Line number of the target |
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"'). % ultraedit (www.ultraedit.com) 411edit_command(jedit, '%e -wait \'%f\' +line:%d'). 412edit_command(jedit, '%e -wait \'%f\''). 413edit_command(edit, '%e %f:%d'). % PceEmacs client script 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 /******************************* 435 * SELECT * 436 *******************************/ 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.
494do_select_location(Pairs, Spec, Location) :- 495 select_location(Pairs, Spec, Location), % HOOK 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 ).
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).
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 /******************************* 562 * MESSAGES * 563 *******************************/ 564 565:- multifile 566 prolog:message/3. 567 568prologmessage(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.
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, % confusing and covered by something else 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 /******************************* 716 * LOAD EXTENSIONS * 717 *******************************/ 718 719load_extensions :- 720 load, 721 fail. 722load_extensions. 723 724:- load_extensions.
Editor interface
This module implements the generic editor interface. It consists of two extensible parts with little in between. The first part deals with translating the input into source-location, and the second with starting an editor. */