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, append/2]). 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:- autoload(library(dcg/basics), [string/3, integer/3]). 48:- autoload(library(solution_sequences), [distinct/2]). 49 50 51% :- set_prolog_flag(generate_debug_info, false).
61:- multifile 62 locate/3, % +Partial, -FullSpec, -Location 63 locate/2, % +FullSpec, -Location 64 select_location/3, % +Pairs, +Spec, -Location 65 exists_location/1, % +Location 66 user_select/2, % +Max, -I 67 edit_source/1, % +Location 68 edit_command/2, % +Editor, -Command 69 load/0. % provides load-hooks 70 71:- public 72 predicate_location/2. % :Pred, -Location
78edit(Spec) :- 79 notrace(edit_no_trace(Spec)). 80 81edit_no_trace(Spec) :- 82 var(Spec), 83 !, 84 throw(error(instantiation_error, _)). 85edit_no_trace(Spec) :- 86 load_extensions, 87 findall(Location-FullSpec, 88 locate(Spec, FullSpec, Location), 89 Pairs0), 90 sort(Pairs0, Pairs1), 91 merge_locations(Pairs1, Pairs), 92 do_select_location(Pairs, Spec, Location), 93 do_edit_source(Location).
% swipl [-s] file.pl
104edit :- 105 current_prolog_flag(associated_file, File), 106 !, 107 edit(file(File)). 108edit :- 109 '$cmd_option_val'(script_file, OsFiles), 110 OsFiles = [OsFile], 111 !, 112 prolog_to_os_filename(File, OsFile), 113 edit(file(File)). 114edit :- 115 throw(error(context_error(edit, no_default_file), _)). 116 117 118 /******************************* 119 * LOCATE * 120 *******************************/
124locate(FileSpec:Line, file(Path, line(Line)), #{file:Path, line:Line}) :- 125 integer(Line), Line >= 1, 126 ground(FileSpec), % so specific; do not try alts 127 !, 128 locate(FileSpec, _, #{file:Path}). 129locate(FileSpec:Line:LinePos, 130 file(Path, line(Line), linepos(LinePos)), 131 #{file:Path, line:Line, linepos:LinePos}) :- 132 integer(Line), Line >= 1, 133 integer(LinePos), LinePos >= 1, 134 ground(FileSpec), % so specific; do not try alts 135 !, 136 locate(FileSpec, _, #{file:Path}). 137locate(Path, file(Path), #{file:Path}) :- 138 atom(Path), 139 exists_file(Path). 140locate(Pattern, file(Path), #{file:Path}) :- 141 atom(Pattern), 142 catch(expand_file_name(Pattern, Files), error(_,_), fail), 143 member(Path, Files), 144 exists_file(Path). 145locate(FileBase, file(File), #{file:File}) :- 146 atom(FileBase), 147 find_source(FileBase, File). 148locate(FileSpec, file(File), #{file:File}) :- 149 is_file_search_spec(FileSpec), 150 find_source(FileSpec, File). 151locate(FileBase, source_file(Path), #{file:Path}) :- 152 atom(FileBase), 153 source_file(Path), 154 file_base_name(Path, File), 155 ( File == FileBase 156 -> true 157 ; file_name_extension(FileBase, _, File) 158 ). 159locate(FileBase, include_file(Path), #{file:Path}) :- 160 atom(FileBase), 161 setof(Path, include_file(Path), Paths), 162 member(Path, Paths), 163 file_base_name(Path, File), 164 ( File == FileBase 165 -> true 166 ; file_name_extension(FileBase, _, File) 167 ). 168locate(Name, FullSpec, Location) :- 169 atom(Name), 170 locate(Name/_, FullSpec, Location). 171locate(Name/Arity, Module:Name/Arity, Location) :- 172 locate(Module:Name/Arity, Location). 173locate(Name//DCGArity, FullSpec, Location) :- 174 ( integer(DCGArity) 175 -> Arity is DCGArity+2, 176 locate(Name/Arity, FullSpec, Location) 177 ; locate(Name/_, FullSpec, Location) % demand arity >= 2 178 ). 179locate(Name/Arity, library(File), #{file:PlPath}) :- 180 atom(Name), 181 '$in_library'(Name, Arity, Path), 182 ( absolute_file_name(library(.), Dir, 183 [ file_type(directory), 184 solutions(all) 185 ]), 186 atom_concat(Dir, File0, Path), 187 atom_concat(/, File, File0) 188 -> find_source(Path, PlPath) 189 ; fail 190 ). 191locate(Module:Name, Module:Name/Arity, Location) :- 192 locate(Module:Name/Arity, Location). 193locate(Module:Head, Module:Name/Arity, Location) :- 194 callable(Head), 195 \+ ( Head = (PName/_), 196 atom(PName) 197 ), 198 functor(Head, Name, Arity), 199 locate(Module:Name/Arity, Location). 200locate(Spec, module(Spec), Location) :- 201 locate(module(Spec), Location). 202locate(Spec, Spec, Location) :- 203 locate(Spec, Location). 204 205include_file(Path) :- 206 source_file_property(Path, included_in(_,_)).
212is_file_search_spec(Spec) :- 213 compound(Spec), 214 compound_name_arguments(Spec, Alias, [Arg]), 215 is_file_spec(Arg), 216 user:file_search_path(Alias, _), 217 !. 218 219is_file_spec(Name), atom(Name) => true. 220is_file_spec(Name), string(Name) => true. 221is_file_spec(Term), cyclic_term(Term) => fail. 222is_file_spec(A/B) => is_file_spec(A), is_file_spec(B). 223is_file_spec(_) => fail.
230find_source(FileSpec, File) :- 231 catch(absolute_file_name(FileSpec, File0, 232 [ file_type(prolog), 233 access(read), 234 file_errors(fail) 235 ]), 236 error(_,_), fail), 237 prolog_source(File0, File). 238 239prolog_source(File0, File) :- 240 file_name_extension(_, Ext, File0), 241 user:prolog_file_type(Ext, qlf), 242 !, 243 '$qlf_module'(File0, Info), 244 File = Info.get(file). 245prolog_source(File, File).
252locate(file(File, line(Line)), #{file:File, line:Line}). 253locate(file(File), #{file:File}). 254locate(Module:Name/Arity, Location) :- 255 ( atom(Name), integer(Arity) 256 -> functor(Head, Name, Arity) 257 ; Head = _ % leave unbound 258 ), 259 ( ( var(Module) 260 ; var(Name) 261 ) 262 -> NonImport = true 263 ; NonImport = false 264 ), 265 current_predicate(Name, Module:Head), 266 \+ ( NonImport == true, 267 Module \== system, 268 predicate_property(Module:Head, imported_from(_)) 269 ), 270 functor(Head, Name, Arity), % bind arity 271 predicate_location(Module:Head, Location). 272locate(module(Module), Location) :- 273 atom(Module), 274 module_property(Module, file(Path)), 275 ( module_property(Module, line_count(Line)) 276 -> Location = #{file:Path, line:Line} 277 ; Location = #{file:Path} 278 ). 279locate(breakpoint(Id), Location) :- 280 integer(Id), 281 breakpoint_property(Id, clause(Ref)), 282 ( breakpoint_property(Id, file(File)), 283 breakpoint_property(Id, line_count(Line)) 284 -> Location = #{file:File, line:Line} 285 ; locate(clause(Ref), Location) 286 ). 287locate(clause(Ref), #{file:File, line:Line}) :- 288 clause_property(Ref, file(File)), 289 clause_property(Ref, line_count(Line)). 290locate(clause(Ref, _PC), #{file:File, line:Line}) :- % TBD: use clause 291 clause_property(Ref, file(File)), 292 clause_property(Ref, line_count(Line)).
301predicate_location(Pred, #{file:File, line:Line}) :- 302 copy_term(Pred, Pred2), 303 distinct(Primary, primary_foreign_predicate(Pred2, Primary)), 304 ignore(Pred = Primary), 305 ( predicate_property(Primary, file(File)), 306 predicate_property(Primary, line_count(Line)) 307 -> true 308 ; '$foreign_predicate_source'(Primary, Source), 309 string_codes(Source, Codes), 310 phrase(addr2line_output(File, Line), Codes) 311 ). 312 313primary_foreign_predicate(Pred, Primary) :- 314 predicate_property(Pred, foreign), 315 ( predicate_property(Pred, imported_from(Source)) 316 -> strip_module(Pred, _, Head), 317 Primary = Source:Head 318 ; Primary = Pred 319 ).
addr2line utility. This implementation
works for Linux. Additional lines may be needed for other
environments.328addr2line_output(File, Line) --> 329 string(_), " at ", string(FileCodes), ":", integer(Line), 330 !, 331 { atom_codes(File, FileCodes) }. 332 333 334 /******************************* 335 * EDIT * 336 *******************************/
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.
350do_edit_source(Location) :- % hook 351 edit_source(Location), 352 !. 353do_edit_source(Location) :- % PceEmacs 354 current_prolog_flag(editor, Editor), 355 is_pceemacs(Editor), 356 current_prolog_flag(gui, true), 357 !, 358 location_url(Location, URL), % File[:Line[:LinePos]] 359 run_pce_emacs(URL). 360do_edit_source(Location) :- % External editor 361 external_edit_command(Location, Command), 362 print_message(informational, edit(waiting_for_editor)), 363 ( catch(shell(Command), E, 364 (print_message(warning, E), 365 fail)) 366 -> print_message(informational, edit(make)), 367 make 368 ; print_message(informational, edit(canceled)) 369 ). 370 371external_edit_command(Location, Command) :- 372 #{file:File, line:Line} :< Location, 373 editor(Editor), 374 file_base_name(Editor, EditorFile), 375 file_name_extension(Base, _, EditorFile), 376 edit_command(Base, Cmd), 377 prolog_to_os_filename(File, OsFile), 378 atom_codes(Cmd, S0), 379 substitute('%e', Editor, S0, S1), 380 substitute('%f', OsFile, S1, S2), 381 substitute('%d', Line, S2, S), 382 !, 383 atom_codes(Command, S). 384external_edit_command(Location, Command) :- 385 #{file:File} :< Location, 386 editor(Editor), 387 file_base_name(Editor, EditorFile), 388 file_name_extension(Base, _, EditorFile), 389 edit_command(Base, Cmd), 390 prolog_to_os_filename(File, OsFile), 391 atom_codes(Cmd, S0), 392 substitute('%e', Editor, S0, S1), 393 substitute('%f', OsFile, S1, S), 394 \+ substitute('%d', 1, S, _), 395 !, 396 atom_codes(Command, S). 397external_edit_command(Location, Command) :- 398 #{file:File} :< Location, 399 editor(Editor), 400 format(string(Command), '"~w" "~w"', [Editor, File]). 401 402is_pceemacs(pce_emacs). 403is_pceemacs(built_in).
409run_pce_emacs(URL) :-
410 autoload_call(in_pce_thread(autoload_call(emacs(URL)))).416editor(Editor) :- % $EDITOR 417 current_prolog_flag(editor, Editor), 418 ( sub_atom(Editor, 0, _, _, $) 419 -> sub_atom(Editor, 1, _, 0, Var), 420 catch(getenv(Var, Editor), _, fail), ! 421 ; Editor == default 422 -> catch(getenv('EDITOR', Editor), _, fail), ! 423 ; \+ is_pceemacs(Editor) 424 -> ! 425 ). 426editor(Editor) :- % User defaults 427 getenv('EDITOR', Editor), 428 !. 429editor(vi) :- % Platform defaults 430 current_prolog_flag(unix, true), 431 !. 432editor(notepad) :- 433 current_prolog_flag(windows, true), 434 !. 435editor(_) :- % No luck 436 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 |
448edit_command(vi, '%e +%d \'%f\''). 449edit_command(vi, '%e \'%f\''). 450edit_command(emacs, '%e +%d \'%f\''). 451edit_command(emacs, '%e \'%f\''). 452edit_command(notepad, '"%e" "%f"'). 453edit_command(wordpad, '"%e" "%f"'). 454edit_command(uedit32, '%e "%f/%d/0"'). % ultraedit (www.ultraedit.com) 455edit_command(jedit, '%e -wait \'%f\' +line:%d'). 456edit_command(jedit, '%e -wait \'%f\''). 457edit_command(edit, '%e %f:%d'). % PceEmacs client script 458edit_command(edit, '%e %f'). 459 460edit_command(emacsclient, Command) :- edit_command(emacs, Command). 461edit_command(vim, Command) :- edit_command(vi, Command). 462edit_command(nvim, Command) :- edit_command(vi, Command). 463 464substitute(FromAtom, ToAtom, Old, New) :- 465 atom_codes(FromAtom, From), 466 ( atom(ToAtom) 467 -> atom_codes(ToAtom, To) 468 ; number_codes(ToAtom, To) 469 ), 470 append(Pre, S0, Old), 471 append(From, Post, S0) -> 472 append(Pre, To, S1), 473 append(S1, Post, New), 474 !. 475substitute(_, _, Old, Old). 476 477 478 /******************************* 479 * SELECT * 480 *******************************/ 481 482merge_locations(Locations0, Locations) :- 483 append(Before, [L1|Rest], Locations0), 484 L1 = Loc1-Spec1, 485 select(L2, Rest, Rest1), 486 L2 = Loc2-Spec2, 487 same_location(Loc1, Loc2, Loc), 488 merge_specs(Spec1, Spec2, Spec), 489 !, 490 append([Before, [Loc-Spec], Rest1], Locations1), 491 merge_locations(Locations1, Locations). 492merge_locations(Locations, Locations). 493 494same_location(L, L, L). 495same_location(#{file:F1}, #{file:F2}, #{file:F}) :- 496 best_same_file(F1, F2, F). 497same_location(#{file:F1, line:Line}, #{file:F2}, #{file:F, line:Line}) :- 498 best_same_file(F1, F2, F). 499same_location(#{file:F1}, #{file:F2, line:Line}, #{file:F, line:Line}) :- 500 best_same_file(F1, F2, F). 501 502best_same_file(F1, F2, F) :- 503 catch(same_file(F1, F2), _, fail), 504 !, 505 atom_length(F1, L1), 506 atom_length(F2, L2), 507 ( L1 < L2 508 -> F = F1 509 ; F = F2 510 ). 511 512merge_specs(Spec, Spec, Spec) :- 513 !. 514merge_specs(file(F1), file(F2), file(F)) :- 515 best_same_file(F1, F2, F), 516 !. 517merge_specs(Spec1, Spec2, Spec) :- 518 merge_specs_(Spec1, Spec2, Spec), 519 !. 520merge_specs(Spec1, Spec2, Spec) :- 521 merge_specs_(Spec2, Spec1, Spec), 522 !. 523 524merge_specs_(FileSpec, Spec, Spec) :- 525 is_filespec(FileSpec). 526 527is_filespec(source_file(_)) => true. 528is_filespec(Term), 529 compound(Term), 530 compound_name_arguments(Term, Alias, [_Arg]), 531 user:file_search_path(Alias, _) => true. 532is_filespec(_) => 533 fail.
540do_select_location(Pairs, Spec, Location) :- 541 select_location(Pairs, Spec, Location), % HOOK 542 !, 543 Location \== []. 544do_select_location([], Spec, _) :- 545 !, 546 print_message(warning, edit(not_found(Spec))), 547 fail. 548do_select_location([#{file:File}-file(File)], _, Location) :- 549 !, 550 Location = #{file:File}. 551do_select_location([Location-_Spec], _, Location) :- 552 existing_location(Location), 553 !. 554do_select_location(Pairs, _, Location) :- 555 foldl(number_location, Pairs, NPairs, 1, End), 556 print_message(help, edit(select(NPairs))), 557 ( End == 1 558 -> fail 559 ; Max is End - 1, 560 user_selection(Max, I), 561 memberchk(I-(Location-_Spec), NPairs) 562 ).
570existing_location(Location) :- 571 exists_location(Location), 572 !. 573existing_location(Location) :- 574 #{file:File} :< Location, 575 access_file(File, read). 576 577number_location(Pair, N-Pair, N, N1) :- 578 Pair = Location-_Spec, 579 existing_location(Location), 580 !, 581 N1 is N+1. 582number_location(Pair, 0-Pair, N, N). 583 584user_selection(Max, I) :- 585 user_select(Max, I), 586 !. 587user_selection(Max, I) :- 588 print_message(help, edit(choose(Max))), 589 read_number(Max, I).
595read_number(Max, X) :- 596 Max < 10, 597 !, 598 get_single_char(C), 599 put_code(user_error, C), 600 between(0'0, 0'9, C), 601 X is C - 0'0. 602read_number(_, X) :- 603 read_line_to_string(user_input, String), 604 number_string(X, String). 605 606 607 /******************************* 608 * MESSAGES * 609 *******************************/ 610 611:- multifile 612 prolog:message/3. 613 614prologmessage(edit(Msg)) --> 615 message(Msg). 616 617message(not_found(Spec)) --> 618 [ 'Cannot find anything to edit from "~p"'-[Spec] ], 619 ( { atom(Spec) } 620 -> [ nl, ' Use edit(file(~q)) to create a new file'-[Spec] ] 621 ; [] 622 ). 623message(select(NPairs)) --> 624 { \+ (member(N-_, NPairs), N > 0) }, 625 !, 626 [ 'Found the following locations:', nl ], 627 sequence(target, [nl], NPairs). 628message(select(NPairs)) --> 629 [ 'Please select item to edit:', nl ], 630 sequence(target, [nl], NPairs). 631message(choose(_Max)) --> 632 [ nl, 'Your choice? ', flush ]. 633message(waiting_for_editor) --> 634 [ 'Waiting for editor ... ', flush ]. 635message(make) --> 636 [ 'Running make to reload modified files' ]. 637message(canceled) --> 638 [ 'Editor returned failure; skipped make/0 to reload files' ]. 639 640target(0-(Location-Spec)) ==> 641 [ ansi(warning, '~t*~3| ', [])], 642 edit_specifier(Spec), 643 [ '~t~32|' ], 644 edit_location(Location, false), 645 [ ansi(warning, ' (no source available)', [])]. 646target(N-(Location-Spec)) ==> 647 [ ansi(bold, '~t~d~3| ', [N])], 648 edit_specifier(Spec), 649 [ '~t~32|' ], 650 edit_location(Location, true). 651 652edit_specifier(Module:Name/Arity) ==> 653 [ '~w:'-[Module], 654 ansi(code, '~w/~w', [Name, Arity]) ]. 655edit_specifier(file(_Path)) ==> 656 [ '<file>' ]. 657edit_specifier(source_file(_Path)) ==> 658 [ '<loaded file>' ]. 659edit_specifier(include_file(_Path)) ==> 660 [ '<included file>' ]. 661edit_specifier(Term) ==> 662 [ '~p'-[Term] ]. 663 664edit_location(Location, false) ==> 665 { location_label(Location, Label) }, 666 [ ansi(warning, '~s', [Label]) ]. 667edit_location(Location, true) ==> 668 { location_label(Location, Label), 669 location_url(Location, URL) 670 }, 671 [ url(URL, Label) ]. 672 673location_label(Location, Label) :- 674 #{file:File, line:Line} :< Location, 675 !, 676 short_filename(File, ShortFile), 677 format(string(Label), '~w:~d', [ShortFile, Line]). 678location_label(Location, Label) :- 679 #{file:File} :< Location, 680 !, 681 short_filename(File, ShortFile), 682 format(string(Label), '~w', [ShortFile]). 683 684location_url(Location, File:Line:LinePos) :- 685 #{file:File, line:Line, linepos:LinePos} :< Location, 686 !. 687location_url(Location, File:Line) :- 688 #{file:File, line:Line} :< Location, 689 !. 690location_url(Location, File) :- 691 #{file:File} :< Location.
699short_filename(Path, Spec) :- 700 working_directory(Here, Here), 701 atom_concat(Here, Local0, Path), 702 !, 703 remove_leading_slash(Local0, Spec). 704short_filename(Path, Spec) :- 705 findall(LenAlias, aliased_path(Path, LenAlias), Keyed), 706 keysort(Keyed, [_-Spec|_]). 707short_filename(Path, Path). 708 709aliased_path(Path, Len-Spec) :- 710 setof(Alias, file_alias_path(Alias), Aliases), 711 member(Alias, Aliases), 712 Alias \== autoload, % confusing and covered by something else 713 Term =.. [Alias, '.'], 714 absolute_file_name(Term, Prefix, 715 [ file_type(directory), 716 file_errors(fail), 717 solutions(all) 718 ]), 719 atom_concat(Prefix, Local0, Path), 720 remove_leading_slash(Local0, Local1), 721 remove_extension(Local1, Local2), 722 unquote_segments(Local2, Local), 723 atom_length(Local2, Len), 724 Spec =.. [Alias, Local]. 725 726file_alias_path(Alias) :- 727 user:file_search_path(Alias, _). 728 729remove_leading_slash(Path, Local) :- 730 atom_concat(/, Local, Path), 731 !. 732remove_leading_slash(Path, Path). 733 734remove_extension(File0, File) :- 735 file_name_extension(File, Ext, File0), 736 user:prolog_file_type(Ext, source), 737 !. 738remove_extension(File, File). 739 740unquote_segments(File, Segments) :- 741 split_string(File, "/", "/", SegmentStrings), 742 maplist(atom_string, SegmentList, SegmentStrings), 743 maplist(no_quote_needed, SegmentList), 744 !, 745 segments(SegmentList, Segments). 746unquote_segments(File, File). 747 748 749no_quote_needed(A) :- 750 format(atom(Q), '~q', [A]), 751 Q == A. 752 753segments([Segment], Segment) :- 754 !. 755segments(List, A/Segment) :- 756 append(L1, [Segment], List), 757 !, 758 segments(L1, A). 759 760 761 /******************************* 762 * LOAD EXTENSIONS * 763 *******************************/ 764 765load_extensions :- 766 load, 767 fail. 768load_extensions. 769 770:- 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. */