windows stuff.
This commit is contained in:
Vitor Santos Costa
2
LGPL/Makefile.in
Normal file → Executable file
2
LGPL/Makefile.in
Normal file → Executable file
@@ -30,6 +30,7 @@ PROGRAMS= $(srcdir)/base64.pl \
|
||||
$(srcdir)/debug.pl \
|
||||
$(srcdir)/main.pl \
|
||||
$(srcdir)/maplist.pl \
|
||||
$(srcdir)/menu.pl \
|
||||
$(srcdir)/nb_set.pl \
|
||||
$(srcdir)/operators.pl \
|
||||
$(srcdir)/option.pl \
|
||||
@@ -48,6 +49,7 @@ PROGRAMS= $(srcdir)/base64.pl \
|
||||
$(srcdir)/thread_pool.pl \
|
||||
$(srcdir)/url.pl \
|
||||
$(srcdir)/utf8.pl \
|
||||
$(srcdir)/win_menu.pl \
|
||||
$(srcdir)/www_browser.pl
|
||||
|
||||
|
||||
|
||||
76
LGPL/menu.pl
Executable file
76
LGPL/menu.pl
Executable file
@@ -0,0 +1,76 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: J.Wielemaker@uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2009, University of 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 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('$win_menu',
|
||||
[ win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal
|
||||
win_has_menu/0 % Test whether we have menus
|
||||
]).
|
||||
|
||||
:- meta_predicate
|
||||
win_insert_menu_item(+,+,+,:).
|
||||
%:- multifile
|
||||
% prolog:on_menu/1.
|
||||
:- dynamic
|
||||
menu_action/2.
|
||||
:- volatile
|
||||
menu_action/2.
|
||||
|
||||
prolog:on_menu(Label) :-
|
||||
menu_action(Label, Action),
|
||||
catch(Action, Error,
|
||||
print_message(error, Error)).
|
||||
|
||||
% win_has_menu
|
||||
%
|
||||
% Test whether the system provides the menu interface
|
||||
|
||||
prolog:win_has_menu :-
|
||||
current_predicate(_, system:'$win_insert_menu_item'(_, _, _)).
|
||||
|
||||
% win_insert_menu_item(+Popup, +Item, +Before, :Goal)
|
||||
%
|
||||
% Add a menu-item to the PLWIN.EXE menu. See the reference manual
|
||||
% for details.
|
||||
|
||||
prolog:win_insert_menu_item(Popup, --, Before, _Goal) :- !,
|
||||
call(system:'$win_insert_menu_item'(Popup, --, Before)). % fool check/0
|
||||
prolog:win_insert_menu_item(Popup, Item, Before, Goal) :-
|
||||
insert_menu_item(Popup, Item, Before, Goal).
|
||||
|
||||
insert_menu_item(Popup, Item, Before, Goal) :-
|
||||
( menu_action(Item, OldGoal),
|
||||
OldGoal \== Goal
|
||||
-> throw(error(permission_error(redefine, Item),
|
||||
win_insert_menu_item/4))
|
||||
; true
|
||||
),
|
||||
call(system:'$win_insert_menu_item'(Popup, Item, Before)),
|
||||
assert(menu_action(Item, Goal)).
|
||||
252
LGPL/win_menu.pl
Executable file
252
LGPL/win_menu.pl
Executable file
@@ -0,0 +1,252 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: jan@swi.psy.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2002, University of 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(win_menu,
|
||||
[ init_win_menus/0
|
||||
]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(www_browser)).
|
||||
|
||||
:- 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.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
menu('&File',
|
||||
[ '&Consult ...' = win_menu: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'))),
|
||||
--,
|
||||
'&Reload modified files' = user:make,
|
||||
% --,
|
||||
% '&Navigator ...' = prolog_ide(open_navigator),
|
||||
--
|
||||
],
|
||||
[ before_item('&Exit')
|
||||
]).
|
||||
/*
|
||||
menu('&Settings',
|
||||
[ --,
|
||||
'&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
|
||||
],
|
||||
[ before_menu(-)
|
||||
]).
|
||||
*/
|
||||
menu('&Help',
|
||||
[ '&About ...' = about,
|
||||
'&Help ...' = help,
|
||||
'YAP &Manual (on www) ...' = win_menu:www_open(yap_man),
|
||||
--,
|
||||
'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,
|
||||
% --,
|
||||
'Submit &Bug report (on www) ...' = win_menu:www_open(yap_bugs)
|
||||
],
|
||||
[ before_menu(-)
|
||||
]).
|
||||
|
||||
|
||||
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
|
||||
),
|
||||
( member(Item, Items),
|
||||
( Item = (Label = Action)
|
||||
-> true
|
||||
; Item == --
|
||||
-> Label = --
|
||||
),
|
||||
win_insert_menu_item(Menu, Label, Before, Action),
|
||||
fail
|
||||
; true
|
||||
),
|
||||
fail
|
||||
; insert_associated_file
|
||||
).
|
||||
|
||||
insert_associated_file :-
|
||||
current_prolog_flag(associated_file, File),
|
||||
file_base_name(File, Base),
|
||||
atom_concat('Edit &', Base, Label),
|
||||
win_insert_menu_item('&File', Label, '&New ...', edit(file(File))).
|
||||
insert_associated_file.
|
||||
|
||||
|
||||
:- initialization
|
||||
( win_has_menu
|
||||
-> init_win_menus
|
||||
; true
|
||||
).
|
||||
|
||||
/*******************************
|
||||
* ACTIONS *
|
||||
*******************************/
|
||||
|
||||
edit_new(File) :-
|
||||
call(edit(file(File))). % avoid autoloading
|
||||
|
||||
www_open(Id) :-
|
||||
Spec =.. [Id, '.'],
|
||||
call(expand_url_path(Spec, URL)),
|
||||
print_message(informational, opening_url(URL)),
|
||||
call(www_open_url(URL)), % avoid autoloading
|
||||
print_message(informational, opened_url(URL)).
|
||||
|
||||
html_open(Spec) :-
|
||||
absolute_file_name(Spec, [access(read)], Path),
|
||||
call(win_shell(open, Path)).
|
||||
|
||||
about :-
|
||||
print_message(informational, about).
|
||||
|
||||
|
||||
/*******************************
|
||||
* HANDLE CALLBACK *
|
||||
*******************************/
|
||||
|
||||
action(Action) :-
|
||||
strip_module(Action, Module, Plain),
|
||||
Plain =.. [Name|Args],
|
||||
gather_args(Args, Values),
|
||||
Goal =.. [Name|Values],
|
||||
Module:Goal.
|
||||
|
||||
gather_args([], []).
|
||||
gather_args([+H0|T0], [H|T]) :- !,
|
||||
gather_arg(H0, H),
|
||||
gather_args(T0, T).
|
||||
gather_args([H|T0], [H|T]) :-
|
||||
gather_args(T0, T).
|
||||
|
||||
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],
|
||||
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)).
|
||||
|
||||
prolog_file_pattern(Pattern) :-
|
||||
user:prolog_file_type(Ext, prolog),
|
||||
atom_concat('*.', Ext, Pattern).
|
||||
|
||||
|
||||
|
||||
|
||||
/*******************************
|
||||
* APPLICATION *
|
||||
*******************************/
|
||||
|
||||
%% init_win_app
|
||||
%
|
||||
% If Prolog is started using --win_app, try to change directory
|
||||
% to <My Documents>\Prolog.
|
||||
|
||||
init_win_app :-
|
||||
current_prolog_flag(associated_file, _), !.
|
||||
init_win_app :-
|
||||
current_prolog_flag(argv, Argv),
|
||||
append(Pre, ['--win_app'|_Post], Argv),
|
||||
\+ member(--, Pre), !,
|
||||
catch(my_prolog, E, print_message(warning, E)).
|
||||
init_win_app.
|
||||
|
||||
my_prolog :-
|
||||
win_folder(personal, MyDocs),
|
||||
atom_concat(MyDocs, '/Prolog', PrologDir),
|
||||
( ensure_dir(PrologDir)
|
||||
-> working_directory(_, PrologDir)
|
||||
; working_directory(_, MyDocs)
|
||||
).
|
||||
|
||||
|
||||
ensure_dir(Dir) :-
|
||||
exists_directory(Dir), !.
|
||||
ensure_dir(Dir) :-
|
||||
catch(make_directory(Dir), E, (print_message(warning, E), fail)).
|
||||
|
||||
|
||||
:- initialization
|
||||
init_win_app.
|
||||
|
||||
|
||||
/*******************************
|
||||
* MESSAGES *
|
||||
*******************************/
|
||||
|
||||
:- multifile
|
||||
prolog:message/3.
|
||||
|
||||
prolog:message(opening_url(Url)) -->
|
||||
[ 'Opening ~w ... '-[Url], flush ].
|
||||
prolog:message(opened_url(_Url)) -->
|
||||
[ at_same_line, 'ok' ].
|
||||
9
LGPL/www_browser.pl
Normal file → Executable file
9
LGPL/www_browser.pl
Normal file → Executable file
@@ -194,6 +194,15 @@ user:url_path(swipl_download, swipl('Download.html')).
|
||||
user:url_path(swipl_bugs, swipl('bugzilla')).
|
||||
user:url_path(swipl_quick, swipl('man/quickstart.html')).
|
||||
|
||||
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_bugs, 'http://sourceforge.net/tracker/?group_id=24437&atid=381483').
|
||||
user:url_path(yap_git, 'http://yap.git.sourceforge.net/git/gitweb-index.cgi').
|
||||
|
||||
|
||||
|
||||
%% expand_url_path(+Spec, -URL)
|
||||
%
|
||||
% Expand URL specifications similar to absolute_file_name/3. The
|
||||
|
||||
Reference in New Issue
Block a user