imrove support for yap-win
This commit is contained in:
Vitor Santos Costa
parent
b7fbd08f7a
commit
aba6d5741e
|
|
@ -31,6 +31,7 @@ PROGRAMS= \
|
|||
$(srcdir)/ctypes.pl \
|
||||
$(srcdir)/date.pl \
|
||||
$(srcdir)/debug.pl \
|
||||
$(srcdir)/edit.pl \
|
||||
$(srcdir)/error.pl \
|
||||
$(srcdir)/main.pl \
|
||||
$(srcdir)/maplist.pl \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,573 @@
|
|||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: J.Wielemaker@vu.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2013, University of Amsterdam
|
||||
VU University Amsterdam
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
As a special exception, if you link this library with other files,
|
||||
compiled with a Free Software compiler, to produce an executable, this
|
||||
library does not by itself cause the resulting executable to be covered
|
||||
by the GNU General Public License. This exception does not however
|
||||
invalidate any other reasons why the executable file might be covered by
|
||||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
:- module(prolog_edit,
|
||||
[ edit/1, % +Spec
|
||||
edit/0
|
||||
]).
|
||||
:- use_module(library(lists), [append/3, member/2, nth1/3, memberchk/2]).
|
||||
:- use_module(library(maplist)).
|
||||
:- use_module(library(system)).
|
||||
%:- use_module(library(make), [make/0]).
|
||||
:- set_prolog_flag(generate_debug_info, false).
|
||||
|
||||
/** <module> 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.
|
||||
*/
|
||||
|
||||
:- multifile
|
||||
locate/3, % +Partial, -FullSpec, -Location
|
||||
locate/2, % +FullSpec, -Location
|
||||
select_location/3, % +Pairs, +Spec, -Location
|
||||
edit_source/1, % +Location
|
||||
edit_command/2, % +Editor, -Command
|
||||
load/0. % provides load-hooks
|
||||
|
||||
%% edit(+Spec)
|
||||
%
|
||||
% Edit indicated object.
|
||||
|
||||
edit(Spec) :-
|
||||
notrace(edit_no_trace(Spec)).
|
||||
|
||||
edit_no_trace(Spec) :-
|
||||
var(Spec), !,
|
||||
throw(error(instantiation_error, _)).
|
||||
edit_no_trace(Spec) :-
|
||||
load_extensions,
|
||||
findall(Location-FullSpec,
|
||||
locate(Spec, FullSpec, Location),
|
||||
Pairs0),
|
||||
merge_locations(Pairs0, Pairs),
|
||||
do_select_location(Pairs, Spec, Location),
|
||||
do_edit_source(Location).
|
||||
|
||||
%% edit
|
||||
%
|
||||
% Edit associated or script file. This is the Prolog file opened
|
||||
% by double-clicking or the file loaded using
|
||||
%
|
||||
% ==
|
||||
% % swipl [-s] file.pl
|
||||
% ==
|
||||
|
||||
edit :-
|
||||
current_prolog_flag(associated_file, File), !,
|
||||
edit(file(File)).
|
||||
edit :-
|
||||
fail, '$cmd_option_val'(script_file, OsFiles),
|
||||
OsFiles = [OsFile], !,
|
||||
prolog_to_os_filename(File, OsFile),
|
||||
edit(file(File)).
|
||||
edit :-
|
||||
throw(error(context_error(edit, no_default_file), _)).
|
||||
|
||||
|
||||
/*******************************
|
||||
* LOCATE *
|
||||
*******************************/
|
||||
|
||||
%% locate(+Spec, -FullSpec, -Location)
|
||||
|
||||
locate(FileSpec:Line, file(Path, line(Line)), [file(Path), line(Line)]) :-
|
||||
integer(Line), Line >= 1,
|
||||
ground(FileSpec), !, % so specific; do not try alts
|
||||
locate(FileSpec, _, [file(Path)]).
|
||||
locate(FileSpec:Line:LinePos,
|
||||
file(Path, line(Line), linepos(LinePos)),
|
||||
[file(Path), line(Line), linepos(LinePos)]) :-
|
||||
integer(Line), Line >= 1,
|
||||
integer(LinePos), LinePos >= 1,
|
||||
ground(FileSpec), !, % so specific; do not try alts
|
||||
locate(FileSpec, _, [file(Path)]).
|
||||
locate(Path, file(Path), [file(Path)]) :-
|
||||
atom(Path),
|
||||
exists_file(Path),
|
||||
\+ exists_directory(Path).
|
||||
locate(Pattern, file(Path), [file(Path)]) :-
|
||||
atom(Pattern),
|
||||
catch(expand_file_name(Pattern, Files), _, fail),
|
||||
member(Path, Files),
|
||||
exists_file(Path),
|
||||
\+ exists_directory(Path).
|
||||
locate(FileBase, file(File), [file(File)]) :-
|
||||
atom(FileBase),
|
||||
absolute_file_name(FileBase,
|
||||
[ file_type(prolog),
|
||||
access(read),
|
||||
file_errors(fail)
|
||||
],
|
||||
File),
|
||||
\+ exists_directory(File).
|
||||
locate(FileSpec, file(File), [file(File)]) :-
|
||||
catch(absolute_file_name(FileSpec,
|
||||
[ file_type(prolog),
|
||||
access(read),
|
||||
file_errors(fail)
|
||||
],
|
||||
File),
|
||||
_, fail).
|
||||
locate(FileBase, source_file(Path), [file(Path)]) :-
|
||||
atom(FileBase),
|
||||
source_file(Path),
|
||||
file_base_name(Path, File),
|
||||
( File == FileBase
|
||||
-> true
|
||||
; file_name_extension(FileBase, _, File)
|
||||
).
|
||||
locate(FileBase, include_file(Path), [file(Path)]) :-
|
||||
atom(FileBase),
|
||||
setof(Path, include_file(Path), Paths),
|
||||
member(Path, Paths),
|
||||
file_base_name(Path, File),
|
||||
( File == FileBase
|
||||
-> true
|
||||
; file_name_extension(FileBase, _, File)
|
||||
).
|
||||
locate(Name, FullSpec, Location) :-
|
||||
atom(Name),
|
||||
locate(Name/_, FullSpec, Location).
|
||||
locate(Name/Arity, Module:Name/Arity, Location) :-
|
||||
locate(Module:Name/Arity, Location).
|
||||
locate(Name//DCGArity, FullSpec, Location) :-
|
||||
( integer(DCGArity)
|
||||
-> Arity is DCGArity+2,
|
||||
locate(Name/Arity, FullSpec, Location)
|
||||
; locate(Name/_, FullSpec, Location) % demand arity >= 2
|
||||
).
|
||||
locate(Name/Arity, library(File), [file(PlPath)]) :-
|
||||
atom(Name),
|
||||
fail, %'$in_library'(Name, Arity, Path),
|
||||
( absolute_file_name(library(.),
|
||||
[ file_type(directory),
|
||||
solutions(all)
|
||||
],
|
||||
Dir),
|
||||
atom_concat(Dir, File0, Path),
|
||||
atom_concat(/, File, File0)
|
||||
-> absolute_file_name(Path,
|
||||
[ file_type(prolog),
|
||||
access(read),
|
||||
file_errors(fail)
|
||||
],
|
||||
PlPath)
|
||||
; fail
|
||||
).
|
||||
locate(Module:Name, Module:Name/Arity, Location) :-
|
||||
locate(Module:Name/Arity, Location).
|
||||
locate(Module:Head, Module:Name/Arity, Location) :-
|
||||
callable(Head),
|
||||
functor(Head, Name, Arity),
|
||||
locate(Module:Name/Arity, Location).
|
||||
locate(Spec, module(Spec), Location) :-
|
||||
locate(module(Spec), Location).
|
||||
locate(Spec, Spec, Location) :-
|
||||
locate(Spec, Location).
|
||||
|
||||
include_file(Path) :-
|
||||
source_file_property(Path, included_in(_,_)).
|
||||
|
||||
|
||||
%% locate(+Spec, -Location)
|
||||
%
|
||||
% Locate object from the specified location.
|
||||
|
||||
locate(file(File, line(Line)), [file(File), line(Line)]).
|
||||
locate(file(File), [file(File)]).
|
||||
locate(Module:Name/Arity, [file(File), line(Line)]) :-
|
||||
( atom(Name), integer(Arity)
|
||||
-> functor(Head, Name, Arity)
|
||||
; Head = _ % leave unbound
|
||||
),
|
||||
( ( var(Module)
|
||||
; var(Name)
|
||||
)
|
||||
-> NonImport = true
|
||||
; NonImport = false
|
||||
),
|
||||
current_predicate(Name, Module:Head),
|
||||
\+ ( NonImport == true,
|
||||
Module \== system,
|
||||
predicate_property(Module:Head, imported_from(_))
|
||||
),
|
||||
functor(Head, Name, Arity), % bind arity
|
||||
predicate_property(Module:Head, file(File)),
|
||||
predicate_property(Module:Head, line_count(Line)).
|
||||
locate(module(Module), [file(Path)|Rest]) :-
|
||||
atom(Module),
|
||||
module_property(Module, file(Path)),
|
||||
( module_property(Module, line_count(Line))
|
||||
-> Rest = [line(Line)]
|
||||
; Rest = []
|
||||
).
|
||||
locate(breakpoint(Id), Location) :-
|
||||
integer(Id),
|
||||
breakpoint_property(Id, clause(Ref)),
|
||||
( breakpoint_property(Id, file(File)),
|
||||
breakpoint_property(Id, line_count(Line))
|
||||
-> Location = [file(File),line(Line)]
|
||||
; locate(clause(Ref), Location)
|
||||
).
|
||||
locate(clause(Ref), [file(File), line(Line)]) :-
|
||||
clause_property(Ref, file(File)),
|
||||
clause_property(Ref, line_count(Line)).
|
||||
locate(clause(Ref, _PC), [file(File), line(Line)]) :- % TBD: use clause
|
||||
clause_property(Ref, file(File)),
|
||||
clause_property(Ref, line_count(Line)).
|
||||
|
||||
|
||||
/*******************************
|
||||
* EDIT *
|
||||
*******************************/
|
||||
|
||||
%% do_edit_source(+Location)
|
||||
%
|
||||
% Actually call the editor to edit Location, a list of Name(Value)
|
||||
% that contains 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.
|
||||
|
||||
do_edit_source(Location) :- % hook
|
||||
edit_source(Location), !.
|
||||
do_edit_source(Location) :- % PceEmacs
|
||||
current_prolog_flag(editor, Editor),
|
||||
pceemacs(Editor),
|
||||
current_prolog_flag(gui, true), !,
|
||||
memberchk(file(File), Location),
|
||||
( memberchk(line(Line), Location)
|
||||
-> ( memberchk(linepos(LinePos), Location)
|
||||
-> Pos = (File:Line:LinePos)
|
||||
; Pos = (File:Line)
|
||||
)
|
||||
; Pos = File
|
||||
),
|
||||
in_pce_thread(emacs(Pos)).
|
||||
do_edit_source(Location) :- % External editor
|
||||
external_edit_command(Location, Command),
|
||||
print_message(informational, edit(waiting_for_editor)),
|
||||
( catch(system(Command), E,
|
||||
(print_message(warning, E),
|
||||
fail))
|
||||
-> print_message(informational, edit(make)),
|
||||
make
|
||||
; print_message(informational, edit(canceled))
|
||||
).
|
||||
|
||||
external_edit_command(Location, Command) :-
|
||||
memberchk(file(File), Location),
|
||||
memberchk(line(Line), Location),
|
||||
editor(Editor),
|
||||
file_base_name(Editor, EditorFile),
|
||||
file_name_extension(Base, _, EditorFile),
|
||||
edit_command(Base, Cmd),
|
||||
prolog_to_os_filename(File, OsFile),
|
||||
atom_codes(Cmd, S0),
|
||||
substitute('%e', Editor, S0, S1),
|
||||
substitute('%f', OsFile, S1, S2),
|
||||
substitute('%d', Line, S2, S), !,
|
||||
atom_codes(Command, S).
|
||||
external_edit_command(Location, Command) :-
|
||||
memberchk(file(File), Location),
|
||||
editor(Editor),
|
||||
file_base_name(Editor, EditorFile),
|
||||
file_name_extension(Base, _, EditorFile),
|
||||
edit_command(Base, Cmd),
|
||||
prolog_to_os_filename(File, OsFile),
|
||||
atom_codes(Cmd, S0),
|
||||
substitute('%e', Editor, S0, S1),
|
||||
substitute('%f', OsFile, S1, S),
|
||||
\+ substitute('%d', 1, S, _), !,
|
||||
atom_codes(Command, S).
|
||||
external_edit_command(Location, Command) :-
|
||||
memberchk(file(File), Location),
|
||||
editor(Editor),
|
||||
atomic_list_concat(['"', Editor, '" "', File, '"'], Command).
|
||||
|
||||
pceemacs(pce_emacs).
|
||||
pceemacs(built_in).
|
||||
|
||||
%% editor(-Editor)
|
||||
%
|
||||
% Determine the external editor to run.
|
||||
|
||||
editor(Editor) :- % $EDITOR
|
||||
current_prolog_flag(editor, Editor),
|
||||
( sub_atom(Editor, 0, _, _, $)
|
||||
-> sub_atom(Editor, 1, _, 0, Var),
|
||||
catch(getenv(Var, Editor), _, fail), !
|
||||
; Editor == default
|
||||
-> catch(getenv('EDITOR', Editor), _, fail), !
|
||||
; \+ pceemacs(Editor)
|
||||
-> !
|
||||
).
|
||||
editor(Editor) :- % User defaults
|
||||
getenv('EDITOR', Editor), !.
|
||||
editor(vi) :- % Platform defaults
|
||||
current_prolog_flag(unix, true), !.
|
||||
editor(notepad) :-
|
||||
current_prolog_flag(windows, true), !.
|
||||
editor(_) :- % No luck
|
||||
throw(error(existence_error(editor), _)).
|
||||
|
||||
%% edit_command(+Editor, -Command)
|
||||
%
|
||||
% This predicate should specify the shell-command called to invoke
|
||||
% the user's editor. The following substitutions will be made:
|
||||
%
|
||||
% | %e | Path name of the editor |
|
||||
% | %f | Path name of the file to be edited |
|
||||
% | %d | Line number of the target |
|
||||
|
||||
|
||||
edit_command(vi, '%e +%d \'%f\'').
|
||||
edit_command(vi, '%e \'%f\'').
|
||||
edit_command(emacs, '%e +%d \'%f\'').
|
||||
edit_command(emacs, '%e \'%f\'').
|
||||
edit_command(notepad, '"%e" "%f"').
|
||||
edit_command(wordpad, '"%e" "%f"').
|
||||
edit_command(uedit32, '%e "%f/%d/0"'). % ultraedit (www.ultraedit.com)
|
||||
edit_command(jedit, '%e -wait \'%f\' +line:%d').
|
||||
edit_command(jedit, '%e -wait \'%f\'').
|
||||
edit_command(edit, '%e %f:%d'). % PceEmacs client script
|
||||
edit_command(edit, '%e %f').
|
||||
|
||||
edit_command(emacsclient, Command) :- edit_command(emacs, Command).
|
||||
edit_command(vim, Command) :- edit_command(vi, Command).
|
||||
|
||||
substitute(FromAtom, ToAtom, Old, New) :-
|
||||
atom_codes(FromAtom, From),
|
||||
( atom(ToAtom)
|
||||
-> atom_codes(ToAtom, To)
|
||||
; number_codes(ToAtom, To)
|
||||
),
|
||||
append(Pre, S0, Old),
|
||||
append(From, Post, S0) ->
|
||||
append(Pre, To, S1),
|
||||
append(S1, Post, New), !.
|
||||
substitute(_, _, Old, Old).
|
||||
|
||||
|
||||
/*******************************
|
||||
* SELECT *
|
||||
*******************************/
|
||||
|
||||
merge_locations(Pairs0, Pairs) :-
|
||||
keysort(Pairs0, Pairs1),
|
||||
merge_locations2(Pairs1, Pairs).
|
||||
|
||||
merge_locations2([], []).
|
||||
merge_locations2([H0|T0], [H|T]) :-
|
||||
remove_same_location(H0, H, T0, T1),
|
||||
merge_locations2(T1, T).
|
||||
|
||||
remove_same_location(Pair0, H, [Pair1|T0], L) :-
|
||||
merge_locations(Pair0, Pair1, Pair2), !,
|
||||
remove_same_location(Pair2, H, T0, L).
|
||||
remove_same_location(H, H, L, L).
|
||||
|
||||
merge_locations(Loc1-Spec1, Loc2-Spec2, Loc-Spec) :-
|
||||
same_location(Loc1, Loc2, Loc), !,
|
||||
( merge_specs(Spec1, Spec2, Spec)
|
||||
; merge_specs(Spec2, Spec1, Spec)
|
||||
; Spec = Spec1
|
||||
), !.
|
||||
merge_locations([file(X)]-_, Loc-Spec, Loc-Spec) :-
|
||||
memberchk(file(X), Loc),
|
||||
memberchk(line(_), Loc).
|
||||
|
||||
same_location(L, L, L).
|
||||
same_location([file(F1)], [file(F2)], [file(F)]) :-
|
||||
best_same_file(F1, F2, F).
|
||||
same_location([file(F1),line(L)], [file(F2)], [file(F),line(L)]) :-
|
||||
best_same_file(F1, F2, F).
|
||||
same_location([file(F1)], [file(F2),line(L)], [file(F),line(L)]) :-
|
||||
best_same_file(F1, F2, F).
|
||||
|
||||
best_same_file(F1, F2, F) :-
|
||||
catch(same_file(F1, F2), _, fail), !,
|
||||
atom_length(F1, L1),
|
||||
atom_length(F2, L2),
|
||||
( L1 < L2
|
||||
-> F = F1
|
||||
; F = F2
|
||||
).
|
||||
|
||||
merge_specs(source_file(Path), _, source_file(Path)).
|
||||
|
||||
%% select_location(+Pairs, +UserSpec, -Location)
|
||||
|
||||
do_select_location(Pairs, Spec, Location) :-
|
||||
select_location(Pairs, Spec, Location), !, % HOOK
|
||||
Location \== [].
|
||||
do_select_location([], Spec, _) :- !,
|
||||
print_message(warning, edit(not_found(Spec))),
|
||||
fail.
|
||||
do_select_location([Location-_Spec], _, Location) :- !.
|
||||
do_select_location(Pairs, _, Location) :-
|
||||
print_message(help, edit(select)),
|
||||
list_pairs(Pairs, 0, N),
|
||||
print_message(help, edit(prompt_select)),
|
||||
read_number(N, I),
|
||||
nth1(I, Pairs, Location-_Spec), !.
|
||||
|
||||
list_pairs([], N, N).
|
||||
list_pairs([H|T], N0, N) :-
|
||||
NN is N0 + 1,
|
||||
list_pair(H, NN),
|
||||
list_pairs(T, NN, N).
|
||||
|
||||
list_pair(Pair, N) :-
|
||||
print_message(help, edit(target(Pair, N))).
|
||||
|
||||
|
||||
read_number(Max, X) :-
|
||||
Max < 10, !,
|
||||
get_single_char(C),
|
||||
between(0'0, 0'9, C),
|
||||
X is C - 0'0.
|
||||
read_number(_, X) :-
|
||||
read_line(Chars),
|
||||
name(X, Chars),
|
||||
integer(X).
|
||||
|
||||
read_line(Chars) :-
|
||||
get0(user_input, C0),
|
||||
read_line(C0, Chars).
|
||||
|
||||
read_line(10, []) :- !.
|
||||
read_line(-1, []) :- !.
|
||||
read_line(C, [C|T]) :-
|
||||
get0(user_input, C1),
|
||||
read_line(C1, T).
|
||||
|
||||
|
||||
/*******************************
|
||||
* MESSAGES *
|
||||
*******************************/
|
||||
|
||||
:- multifile
|
||||
prolog:message/3.
|
||||
|
||||
prolog:message(edit(not_found(Spec))) -->
|
||||
[ 'Cannot find anything to edit from "~p"'-[Spec] ],
|
||||
( { atom(Spec) }
|
||||
-> [ nl, ' Use edit(file(~q)) to create a new file'-[Spec] ]
|
||||
; []
|
||||
).
|
||||
prolog:message(edit(select)) -->
|
||||
[ 'Please select item to edit:', nl, nl ].
|
||||
prolog:message(edit(prompt_select)) -->
|
||||
[ nl, 'Your choice? ', flush ].
|
||||
prolog:message(edit(target(Location-Spec, N))) -->
|
||||
[ '~t~d~3| '-[N]],
|
||||
edit_specifier(Spec),
|
||||
[ '~t~32|' ],
|
||||
edit_location(Location).
|
||||
prolog:message(edit(waiting_for_editor)) -->
|
||||
[ 'Waiting for editor ... ', flush ].
|
||||
prolog:message(edit(make)) -->
|
||||
[ 'Running make to reload modified files' ].
|
||||
prolog:message(edit(canceled)) -->
|
||||
[ 'Editor returned failure; skipped make/0 to reload files' ].
|
||||
|
||||
edit_specifier(Module:Name/Arity) --> !,
|
||||
[ '~w:~w/~w'-[Module, Name, Arity] ].
|
||||
edit_specifier(file(_Path)) --> !,
|
||||
[ '<file>' ].
|
||||
edit_specifier(source_file(_Path)) --> !,
|
||||
[ '<loaded file>' ].
|
||||
edit_specifier(include_file(_Path)) --> !,
|
||||
[ '<included file>' ].
|
||||
edit_specifier(Term) -->
|
||||
[ '~p'-[Term] ].
|
||||
|
||||
edit_location(Location) -->
|
||||
{ memberchk(file(File), Location),
|
||||
memberchk(line(Line), Location),
|
||||
short_filename(File, Spec)
|
||||
}, !,
|
||||
[ '~q:~d'-[Spec, Line] ].
|
||||
edit_location(Location) -->
|
||||
{ memberchk(file(File), Location),
|
||||
short_filename(File, Spec)
|
||||
}, !,
|
||||
[ '~q'-[Spec] ].
|
||||
|
||||
short_filename(Path, Spec) :-
|
||||
absolute_file_name('', Here),
|
||||
atom_concat(Here, Local0, Path), !,
|
||||
remove_leading_slash(Local0, Spec).
|
||||
short_filename(Path, Spec) :-
|
||||
findall(LenAlias, aliased_path(Path, LenAlias), Keyed),
|
||||
keysort(Keyed, [_-Spec|_]).
|
||||
short_filename(Path, Path).
|
||||
|
||||
aliased_path(Path, Len-Spec) :-
|
||||
setof(Alias, file_alias_path(Alias), Aliases),
|
||||
member(Alias, Aliases),
|
||||
Alias \== autoload, % confusing and covered by something else
|
||||
Term =.. [Alias, '.'],
|
||||
absolute_file_name(Term,
|
||||
[ file_type(directory),
|
||||
file_errors(fail),
|
||||
solutions(all)
|
||||
], Prefix),
|
||||
atom_concat(Prefix, Local0, Path),
|
||||
remove_leading_slash(Local0, Local),
|
||||
atom_length(Local, Len),
|
||||
Spec =.. [Alias, Local].
|
||||
|
||||
file_alias_path(Alias) :-
|
||||
user:file_search_path(Alias, _).
|
||||
|
||||
remove_leading_slash(Path, Local) :-
|
||||
atom_concat(/, Local, Path), !.
|
||||
remove_leading_slash(Path, Path).
|
||||
|
||||
|
||||
/*******************************
|
||||
* LOAD EXTENSIONS *
|
||||
*******************************/
|
||||
|
||||
load_extensions :-
|
||||
load,
|
||||
fail.
|
||||
load_extensions.
|
||||
|
||||
:- load_extensions.
|
||||
|
|
@ -35,7 +35,8 @@
|
|||
]).
|
||||
|
||||
:- meta_predicate
|
||||
win_insert_menu_item(+,+,+,:).
|
||||
prolog:win_insert_menu_item(+,+,+,0).
|
||||
|
||||
%:- multifile
|
||||
% prolog:on_menu/1.
|
||||
:- dynamic
|
||||
|
|
|
|||
|
|
@ -1,11 +1,10 @@
|
|||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: jan@swi.psy.uva.nl
|
||||
E-mail: J.Wielemaker@vu.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2002, University of Amsterdam
|
||||
Copyright (C): 1985-2013, University of Amsterdam
|
||||
VU University Amsterdam
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
|
|
@ -29,90 +28,146 @@
|
|||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
|
||||
:- module(win_menu,
|
||||
[ init_win_menus/0
|
||||
]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(apply)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(www_browser)).
|
||||
|
||||
:- use_module(library(edit)).
|
||||
:- set_prolog_flag(generate_debug_info, false).
|
||||
:- op(200, fy, @).
|
||||
:- op(990, xfx, :=).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
This library sets up the menu of PLWIN.EXE. It is called from the system
|
||||
initialisation file plwin.rc, predicate gui_setup_/0.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
/** <module> Console window menu
|
||||
|
||||
This library sets up the menu of *swipl-win.exe*. It is called from the
|
||||
system initialisation file =plwin-win.rc=, predicate gui_setup_/0.
|
||||
*/
|
||||
|
||||
:- if(current_prolog_flag(console_menu_version, qt)).
|
||||
% The traditional swipl-win.exe predefines some menus. The Qt version
|
||||
% does not. Here, we predefine the same menus to make the remainder
|
||||
% compatiple.
|
||||
menu('&File',
|
||||
[ 'E&xit' = pqConsole:quit_console
|
||||
],
|
||||
[
|
||||
]).
|
||||
menu('&Edit',
|
||||
[ '&Copy' = pqConsole:copy,
|
||||
'&Paste' = pqConsole:paste
|
||||
],
|
||||
[]).
|
||||
menu('&Settings',
|
||||
[ '&Font ...' = pqConsole:select_font,
|
||||
'&Colors ...' = pqConsole:select_ANSI_term_colors
|
||||
],
|
||||
[]).
|
||||
menu('&Run',
|
||||
[ '&Interrupt' = interrupt,
|
||||
'&New thread' = interactor
|
||||
],
|
||||
[]).
|
||||
|
||||
menu(File,
|
||||
[ '&Consult ...' = action(user:consult(+file(open,
|
||||
'Load file into Prolog'))),
|
||||
'&Reconsult ...' = action(user:reconsult(+file(open,
|
||||
'Reload file into Prolog'))),
|
||||
'&Edit ...' = action(prolog_edit:edit(+file(open,
|
||||
'Edit existing file'))),
|
||||
'&New ...' = action(edit_new(+file(save,
|
||||
'Create new Prolog source'))),
|
||||
--
|
||||
| MRU
|
||||
], []) :-
|
||||
File = '&File',
|
||||
findall(Mru=true, mru_info(File, Mru, _, _, _), MRU, MRUTail),
|
||||
MRUTail = [ --,
|
||||
'&Reload modified files' = user:make,
|
||||
--,
|
||||
'&Navigator ...' = prolog_ide(open_navigator),
|
||||
--
|
||||
].
|
||||
|
||||
:- else.
|
||||
|
||||
menu('&File',
|
||||
[ '&Consult ...' = win_menu:action(user:compile(+file(open,
|
||||
[ '&Compile ...' = action(user:compile(+file(open,
|
||||
'Load file into Prolog'))),
|
||||
% '&Edit ...' = win_menu:action(user:edit(+file(open,
|
||||
% 'Edit existing file'))),
|
||||
% '&New ...' = win_menu:action(edit_new(+file(save,
|
||||
% 'Create new Prolog source'))),
|
||||
'&Consult ...' = action(user:consult(+file(open,
|
||||
'Load file into Prolog'))),
|
||||
'&Edit ...' = action(prolog_edit:edit(+file(open,
|
||||
'Edit existing file'))),
|
||||
'&New ...' = action(edit_new(+file(save,
|
||||
'Create new Prolog source'))),
|
||||
--,
|
||||
'&Reload modified files' = user:make,
|
||||
% --,
|
||||
% '&Navigator ...' = prolog_ide(open_navigator),
|
||||
%% --,
|
||||
%% '&Navigator ...' = prolog_ide(open_navigator),
|
||||
--
|
||||
],
|
||||
[ before_item('&Exit')
|
||||
[ before_item('E&xit')
|
||||
]).
|
||||
/*
|
||||
:- endif.
|
||||
|
||||
menu('&Settings',
|
||||
[ --,
|
||||
'&User init file ...' = prolog_edit_preferences(prolog)
|
||||
'&User init file ...' = prolog_edit_preferences(prolog) %,
|
||||
% '&GUI preferences ...' = prolog_edit_preferences(xpce)
|
||||
],
|
||||
[]).
|
||||
menu('&Debug',
|
||||
[ %'&Trace' = trace,
|
||||
%'&Debug mode' = debug,
|
||||
%'&No debug mode' = nodebug,
|
||||
'&Edit spy points ...' = user:prolog_ide(open_debug_status),
|
||||
'&Edit exceptions ...' = user:prolog_ide(open_exceptions(@on)),
|
||||
'&Threads monitor ...' = user:prolog_ide(thread_monitor),
|
||||
'Debug &messages ...' = user:prolog_ide(debug_monitor),
|
||||
'Cross &referencer ...'= user:prolog_ide(xref),
|
||||
--,
|
||||
'&Graphical debugger' = user:guitracer
|
||||
[ '&Trace' = trace,
|
||||
'&Debug mode' = debug,
|
||||
'&No debug mode' = nodebug %,
|
||||
%% '&Edit spy points ...' = user:prolog_ide(open_debug_status),
|
||||
%% '&Edit exceptions ...' = user:prolog_ide(open_exceptions(@on)),
|
||||
%% '&Threads monitor ...' = user:prolog_ide(thread_monitor),
|
||||
%% 'Debug &messages ...' = user:prolog_ide(debug_monitor),
|
||||
%% 'Cross &referencer ...'= user:prolog_ide(xref),
|
||||
%% --,
|
||||
%% '&Graphical debugger' = user:guitracer
|
||||
],
|
||||
[ before_menu(-)
|
||||
]).
|
||||
*/
|
||||
menu('&Help',
|
||||
[ '&About ...' = about,
|
||||
'&Help ...' = help,
|
||||
'YAP &Manual (on www) ...' = win_menu:www_open(yap_man),
|
||||
%'&Help ...' = help,
|
||||
%'Browse &PlDoc ...' = doc_browser,
|
||||
--,
|
||||
'YAP &WWW home (on www) ...' = win_menu:www_open(yap),
|
||||
'YAP &GIT (on www) ...' = win_menu:www_open(yap_git),
|
||||
% 'YAP Mailing &List (on www) ...' = win_menu:www_open(swipl_mail),
|
||||
'YAP &Download (on www) ...' = win_menu:www_open(yap_download),
|
||||
--,
|
||||
% '&XPCE (GUI) Manual ...' = manpce,
|
||||
'YAP website ...' = www_open(yap),
|
||||
' &Manual ...' = www_open(yap_man),
|
||||
' &SWI Manual ...' = www_open(swipl_man),
|
||||
% ' &FAQ ...' = www_open(swipl_faq),
|
||||
% ' &Quick Start ...' = www_open(swipl_quick),
|
||||
' Mailing &List ...' = www_open(yap_mail),
|
||||
' &Download ...' = www_open(yap_download),
|
||||
' &Extension packs ...' = www_open(swipl_pack),
|
||||
% --,
|
||||
'Submit &Bug report (on www) ...' = win_menu:www_open(yap_bugs)
|
||||
% '&XPCE (GUI) Manual ...' = manpce,
|
||||
--,
|
||||
'Submit &Bug report ...' = www_open(yap_bugs)
|
||||
],
|
||||
[ before_menu(-)
|
||||
]).
|
||||
|
||||
|
||||
init_win_menus :-
|
||||
init_win_menus :-
|
||||
( menu(Menu, Items, Options),
|
||||
( memberchk(before_item(Before), Options)
|
||||
-> true
|
||||
; Before = (-)
|
||||
),
|
||||
( memberchk(before_menu(BM), Options)
|
||||
-> system:win_insert_menu(Menu, BM)
|
||||
; true
|
||||
-> true
|
||||
; BM = (-)
|
||||
),
|
||||
( member(Item, Items),
|
||||
( Item = (Label = Action)
|
||||
system:win_insert_menu(Menu, BM),
|
||||
( lists:member(Item, Items),
|
||||
( Item = (Label = Action)
|
||||
-> true
|
||||
; Item == --
|
||||
-> Label = --
|
||||
|
|
@ -122,22 +177,34 @@ init_win_menus :-
|
|||
; true
|
||||
),
|
||||
fail
|
||||
; current_prolog_flag(associated_file, File),
|
||||
add_to_mru(load, File)
|
||||
; insert_associated_file
|
||||
).
|
||||
),
|
||||
refresh_mru.
|
||||
|
||||
associated_file(File) :-
|
||||
current_prolog_flag(associated_file, File), !.
|
||||
associated_file(File) :-
|
||||
fail, '$cmd_option_val'(script_file, O1sFiles),
|
||||
OsFiles = [OsFile], !,
|
||||
prolog_to_os_filename(File, OsFile).
|
||||
|
||||
insert_associated_file :-
|
||||
current_prolog_flag(associated_file, File),
|
||||
associated_file(File), !,
|
||||
file_base_name(File, Base),
|
||||
atom_concat('Edit &', Base, Label),
|
||||
win_insert_menu_item('&File', Label, '&New ...', edit(file(File))).
|
||||
system:win_insert_menu_item('&File', Label, '&New ...', edit(file(File))).
|
||||
insert_associated_file.
|
||||
|
||||
|
||||
:- if(current_predicate(win_has_menu/0)).
|
||||
:- initialization
|
||||
( win_has_menu
|
||||
( system:win_has_menu
|
||||
-> init_win_menus
|
||||
; true
|
||||
).
|
||||
:- endif.
|
||||
|
||||
/*******************************
|
||||
* ACTIONS *
|
||||
|
|
@ -157,9 +224,40 @@ html_open(Spec) :-
|
|||
absolute_file_name(Spec, [access(read)], Path),
|
||||
call(win_shell(open, Path)).
|
||||
|
||||
:- if(current_predicate(win_message_box/2)).
|
||||
|
||||
about :-
|
||||
message_to_string(about, AboutSWI),
|
||||
( current_prolog_flag(console_menu_version, qt)
|
||||
-> message_to_string(about_qt, AboutQt),
|
||||
format(atom(About), '<p>~w\n<p>~w', [AboutSWI, AboutQt])
|
||||
; About = AboutSWI
|
||||
),
|
||||
atomic_list_concat(Lines, '\n', About),
|
||||
atomic_list_concat(Lines, '<br>', AboutHTML),
|
||||
win_message_box(
|
||||
AboutHTML,
|
||||
[ title('About swipl-win'),
|
||||
image(':/swipl.png'),
|
||||
min_width(700)
|
||||
]).
|
||||
|
||||
:- else.
|
||||
|
||||
about :-
|
||||
print_message(informational, about).
|
||||
|
||||
:- endif.
|
||||
|
||||
load(Path) :-
|
||||
( \+ current_prolog_flag(associated_file, _)
|
||||
-> file_directory_name(Path, Dir),
|
||||
working_directory(_, Dir),
|
||||
set_prolog_flag(associated_file, Path)
|
||||
; true
|
||||
),
|
||||
user:load_files(Path).
|
||||
|
||||
|
||||
/*******************************
|
||||
* HANDLE CALLBACK *
|
||||
|
|
@ -170,7 +268,7 @@ action(Action) :-
|
|||
Plain =.. [Name|Args],
|
||||
gather_args(Args, Values),
|
||||
Goal =.. [Name|Values],
|
||||
Module:Goal.
|
||||
call(Module:Goal).
|
||||
|
||||
gather_args([], []).
|
||||
gather_args([+H0|T0], [H|T]) :- !,
|
||||
|
|
@ -179,28 +277,61 @@ gather_args([+H0|T0], [H|T]) :- !,
|
|||
gather_args([H|T0], [H|T]) :-
|
||||
gather_args(T0, T).
|
||||
|
||||
:- if(current_prolog_flag(console_menu_version, qt)).
|
||||
|
||||
gather_arg(file(open, Title), File) :- !,
|
||||
source_types_desc(Desc),
|
||||
pqConsole:getOpenFileName(Title, _, Desc, File),
|
||||
add_to_mru(edit, File).
|
||||
|
||||
gather_arg(file(save, Title), File) :-
|
||||
source_types_desc(Desc),
|
||||
pqConsole:getSaveFileName(Title, _, Desc, File),
|
||||
add_to_mru(edit, File).
|
||||
|
||||
source_types_desc(Desc) :-
|
||||
findall(Pattern, prolog_file_pattern(Pattern), Patterns),
|
||||
atomic_list_concat(Patterns, ' ', Atom),
|
||||
format(atom(Desc), 'Prolog Source (~w)', [Atom]).
|
||||
|
||||
:- else.
|
||||
|
||||
gather_arg(file(Mode, Title), File) :-
|
||||
findall(tuple('Prolog Source', Pattern),
|
||||
prolog_file_pattern(Pattern),
|
||||
Tuples),
|
||||
append(Tuples, [tuple('All files', '*.*')], AllTuples),
|
||||
Filter =.. [chain|AllTuples],
|
||||
lists:append(Tuples, [tuple('All files', '*.*')], AllTuples),
|
||||
current_prolog_flag(hwnd, HWND),
|
||||
working_directory(CWD, CWD),
|
||||
% filter(AllTuples, Filter),
|
||||
win_open_file_name(HWND, CWD, File).
|
||||
%% call(get(@display, win_file_name, % avoid autoloading
|
||||
%% Mode, Filter, Title,
|
||||
%% directory := CWD,
|
||||
%% owner := HWND,
|
||||
%% File)).
|
||||
system:win_file_name(
|
||||
Mode, AllTuples, Title,
|
||||
CWD,
|
||||
HWND,
|
||||
File).
|
||||
|
||||
:- if( current_prolog_flag( dialect, swi ) ).
|
||||
win_file_name(
|
||||
Mode, AllTuples, Title,
|
||||
CWD,
|
||||
HWND,
|
||||
File) :-
|
||||
% avoid autoloading
|
||||
Filter =.. [chain|AllTuples],
|
||||
call(get(@display, win_file_name, % avoid autoloading
|
||||
Mode, Filter, Title,
|
||||
directory := CWD,
|
||||
owner := HWND,
|
||||
File)).
|
||||
:- endif.
|
||||
|
||||
:- endif.
|
||||
|
||||
prolog_file_pattern(Pattern) :-
|
||||
user:prolog_file_type(Ext, prolog),
|
||||
atom_concat('*.', Ext, Pattern).
|
||||
|
||||
|
||||
|
||||
:- if(current_prolog_flag(windows, true)).
|
||||
|
||||
/*******************************
|
||||
* APPLICATION *
|
||||
|
|
@ -214,9 +345,7 @@ prolog_file_pattern(Pattern) :-
|
|||
init_win_app :-
|
||||
current_prolog_flag(associated_file, _), !.
|
||||
init_win_app :-
|
||||
current_prolog_flag(argv, Argv),
|
||||
append(Pre, ['--win_app'|_Post], Argv),
|
||||
\+ member(--, Pre), !,
|
||||
fail, '$cmd_option_val'(win_app, true), !,
|
||||
catch(my_prolog, E, print_message(warning, E)).
|
||||
init_win_app.
|
||||
|
||||
|
|
@ -238,6 +367,138 @@ ensure_dir(Dir) :-
|
|||
:- initialization
|
||||
init_win_app.
|
||||
|
||||
:- endif. /*windows*/
|
||||
|
||||
|
||||
/*******************************
|
||||
* MacOS *
|
||||
*******************************/
|
||||
|
||||
:- if(current_prolog_flag(console_menu_version, qt)).
|
||||
|
||||
:- multifile
|
||||
prolog:file_open_event/1.
|
||||
|
||||
:- create_prolog_flag(app_open_first, load, []).
|
||||
:- create_prolog_flag(app_open, edit, []).
|
||||
|
||||
%% prolog:file_open_event(+Name)
|
||||
%
|
||||
% Called when opening a file from the MacOS finder. The action
|
||||
% depends on whether this is the first file or not, and defined by
|
||||
% one of these flags:
|
||||
%
|
||||
% - =app_open_first= defines the action for the first open event
|
||||
% - =app_open= defines the action for subsequent open event
|
||||
%
|
||||
% On the _first_ open event, the working directory of the process
|
||||
% is changed to the directory holding the file. Action is one of
|
||||
% the following:
|
||||
%
|
||||
% * load
|
||||
% Load the file into Prolog
|
||||
% * edit
|
||||
% Open the file in the editor
|
||||
% * new_instance
|
||||
% Open the file in a new instance of Prolog and load it there.
|
||||
|
||||
prolog:file_open_event(Path) :-
|
||||
( current_prolog_flag(associated_file, _)
|
||||
-> current_prolog_flag(app_open, Action)
|
||||
; current_prolog_flag(app_open_first, Action),
|
||||
file_directory_name(Path, Dir),
|
||||
working_directory(_, Dir),
|
||||
set_prolog_flag(associated_file, Path),
|
||||
insert_associated_file
|
||||
),
|
||||
must_be(oneof([edit,load,new_instance]), Action),
|
||||
file_open_event(Action, Path).
|
||||
|
||||
file_open_event(edit, Path) :-
|
||||
edit(Path).
|
||||
file_open_event(load, Path) :-
|
||||
add_to_mru(load, Path),
|
||||
user:load_files(Path).
|
||||
:- if(current_prolog_flag(apple, true)).
|
||||
file_open_event(new_instance, Path) :-
|
||||
current_app(Me),
|
||||
print_message(informational, new_instance(Path)),
|
||||
process_create(path(open), [ '-n', '-a', Me, Path ], []).
|
||||
:- else.
|
||||
file_open_event(new_instance, Path) :-
|
||||
current_prolog_flag(executable, Exe),
|
||||
process_create(Exe, [Path], [process(_Pid)]).
|
||||
:- endif.
|
||||
|
||||
|
||||
:- if(current_prolog_flag(apple, true)).
|
||||
current_app(App) :-
|
||||
current_prolog_flag(executable, Exe),
|
||||
file_directory_name(Exe, MacOSDir),
|
||||
atom_concat(App, '/Contents/MacOS', MacOSDir).
|
||||
|
||||
%% go_home_on_plain_app_start is det.
|
||||
%
|
||||
% On Apple, we start in the users home dir if the application is
|
||||
% started by opening the app directly.
|
||||
|
||||
go_home_on_plain_app_start :-
|
||||
current_prolog_flag(os_argv, [_Exe]),
|
||||
current_app(App),
|
||||
file_directory_name(App, Above),
|
||||
working_directory(PWD, PWD),
|
||||
same_file(PWD, Above),
|
||||
expand_file_name(~, [Home]), !,
|
||||
working_directory(_, Home).
|
||||
go_home_on_plain_app_start.
|
||||
|
||||
:- initialization
|
||||
go_home_on_plain_app_start.
|
||||
|
||||
:- endif.
|
||||
:- endif.
|
||||
|
||||
:- if(current_predicate(win_current_preference/3)).
|
||||
|
||||
mru_info('&File', 'Edit &Recent', 'MRU2', path, edit).
|
||||
mru_info('&File', 'Load &Recent', 'MRULoad', path, load).
|
||||
|
||||
add_to_mru(Action, File) :-
|
||||
mru_info(_Top, _Menu, PrefGroup, PrefKey, Action),
|
||||
( win_current_preference(PrefGroup, PrefKey, CPs), nonvar(CPs)
|
||||
-> ( select(File, CPs, Rest)
|
||||
-> Updated = [File|Rest]
|
||||
; length(CPs, Len),
|
||||
Len > 10
|
||||
-> append(CPs1, [_], CPs),
|
||||
Updated = [File|CPs1]
|
||||
; Updated = [File|CPs]
|
||||
)
|
||||
; Updated = [File]
|
||||
),
|
||||
win_set_preference(PrefGroup, PrefKey, Updated),
|
||||
refresh_mru.
|
||||
|
||||
refresh_mru :-
|
||||
( mru_info(FileMenu, Menu, PrefGroup, PrefKey, Action),
|
||||
win_current_preference(PrefGroup, PrefKey, CPs),
|
||||
maplist(action_path_menu(Action), CPs, Labels, Actions),
|
||||
win_insert_menu_item(FileMenu, Menu/Labels, -, Actions),
|
||||
fail
|
||||
; true
|
||||
).
|
||||
|
||||
action_path_menu(ActionItem, Path, Label, win_menu:Action) :-
|
||||
file_base_name(Path, Label),
|
||||
Action =.. [ActionItem, Path].
|
||||
|
||||
:- else.
|
||||
|
||||
add_to_mru(_, _).
|
||||
refresh_mru.
|
||||
|
||||
:- endif.
|
||||
|
||||
|
||||
/*******************************
|
||||
* MESSAGES *
|
||||
|
|
@ -250,3 +511,9 @@ prolog:message(opening_url(Url)) -->
|
|||
[ 'Opening ~w ... '-[Url], flush ].
|
||||
prolog:message(opened_url(_Url)) -->
|
||||
[ at_same_line, 'ok' ].
|
||||
prolog:message(new_instance(Path)) -->
|
||||
[ 'Opening new Prolog instance for ~p'-[Path] ].
|
||||
:- if(current_prolog_flag(console_menu_version, qt)).
|
||||
prolog:message(about_qt) -->
|
||||
[ 'Qt-based console by Carlo Capelli' ].
|
||||
:- endif.
|
||||
|
|
|
|||
|
|
@ -198,8 +198,9 @@ user:url_path(yap, 'http://www.dcc.fc.up.pt/~vsc/Yap').
|
|||
|
||||
user:url_path(yap_download, 'http://www.dcc.fc.up.pt/~vsc/Yap/downloads.html').
|
||||
user:url_path(yap_man, yap('documentation.html')).
|
||||
user:url_path(yap_mail, 'https://lists.sourceforge.net/lists/listinfo/yap-users').
|
||||
user:url_path(yap_bugs, 'http://sourceforge.net/tracker/?group_id=24437&atid=381483').
|
||||
user:url_path(yap_git, 'http://yap.git.sourceforge.net/git/gitweb-index.cgi').
|
||||
user:url_path(yap_git, 'http://sourceforge.net/p/yap/yap-6.3/ref/master/').
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Reference in New Issue