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)  2002-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(win_menu,
   37          [ init_win_menus/0
   38          ]).   39:- use_module(library(lists)).   40:- use_module(library(apply)).   41:- use_module(library(error)).   42:- set_prolog_flag(generate_debug_info, false).   43:- op(200, fy, @).   44:- op(990, xfx, :=).   45
   46/** <module> Console window menu
   47
   48This library sets up the menu of  *swipl-win.exe*. It is called from the
   49system initialisation file =plwin-win.rc=, predicate gui_setup_/0.
   50*/
   51
   52:- if(current_prolog_flag(console_menu_version, qt)).   53% The traditional swipl-win.exe predefines some menus.  The Qt version
   54% does not.  Here, we predefine the same menus to make the remainder
   55% compatiple.
   56menu('&File',
   57     [ 'E&xit' = pqConsole:quit_console
   58     ],
   59     [
   60     ]).
   61menu('&Edit',
   62     [ '&Copy'  = pqConsole:copy,
   63       '&Paste' = pqConsole:paste
   64     ],
   65     []).
   66menu('&Settings',
   67     [ '&Font ...' = pqConsole:select_font,
   68       '&Colors ...' = pqConsole:select_ANSI_term_colors
   69     ],
   70     []).
   71menu('&Run',
   72     [ '&Interrupt' = interrupt,
   73       '&New thread' = interactor
   74     ],
   75     []).
   76
   77menu(File,
   78     [ '&Consult ...' = action(user:load_files(+file(open,
   79                                                     'Load file into Prolog'),
   80                                               [silent(false)])),
   81       '&Edit ...'    = action(user:edit(+file(open,
   82                                               'Edit existing file'))),
   83       '&New ...'     = action(edit_new(+file(save,
   84                                              'Create new Prolog source'))),
   85       --
   86     | MRU
   87     ], [before_item('E&xit')]) :-
   88    File = '&File',
   89    findall(Mru=true, mru_info(File, Mru, _, _, _), MRU, MRUTail),
   90    MRUTail = [ --,
   91                '&Reload modified files' = user:make,
   92                --,
   93                '&Navigator ...' = prolog_ide(open_navigator),
   94                --
   95              ].
   96
   97:- else.   98
   99menu('&File',
  100     [ '&Consult ...' = action(user:consult(+file(open,
  101                                                  'Load file into Prolog'))),
  102       '&Edit ...'    = action(user:edit(+file(open,
  103                                               'Edit existing file'))),
  104       '&New ...'     = action(edit_new(+file(save,
  105                                              'Create new Prolog source'))),
  106       --,
  107       '&Reload modified files' = user:make,
  108       --,
  109       '&Navigator ...' = prolog_ide(open_navigator),
  110       --
  111     ],
  112     [ before_item('&Exit')
  113     ]).
  114:- endif.  115
  116menu('&Settings',
  117     [ --,
  118       '&User init file ...'  = prolog_edit_preferences(prolog),
  119       '&GUI preferences ...' = prolog_edit_preferences(xpce)
  120     ],
  121     []).
  122menu('&Debug',
  123     [ %'&Trace'             = trace,
  124       %'&Debug mode'        = debug,
  125       %'&No debug mode'     = nodebug,
  126       '&Edit spy points ...' = user:prolog_ide(open_debug_status),
  127       '&Edit exceptions ...' = user:prolog_ide(open_exceptions(@on)),
  128       '&Threads monitor ...' = user:prolog_ide(thread_monitor),
  129       'Debug &messages ...'  = user:prolog_ide(debug_monitor),
  130       'Cross &referencer ...'= user:prolog_ide(xref),
  131       --,
  132       '&Graphical debugger' = user:guitracer
  133     ],
  134     [ before_menu(-)
  135     ]).
  136menu('&Help',
  137     [ '&About ...'                             = about,
  138       '&Help ...'                              = help,
  139       'Browse &PlDoc ...'                      = doc_browser,
  140       --,
  141       'SWI-Prolog website ...'                 = www_open(swipl),
  142       '  &Manual ...'                          = www_open(swipl_man),
  143       '  &FAQ ...'                             = www_open(swipl_faq),
  144       '  &Quick Start ...'                     = www_open(swipl_quick),
  145       '  Mailing &List ...'                    = www_open(swipl_mail),
  146       '  &Download ...'                        = www_open(swipl_download),
  147       '  &Extension packs ...'                 = www_open(swipl_pack),
  148       --,
  149       '&XPCE (GUI) Manual ...'                 = manpce,
  150       --,
  151       '&Check installation'                    = check_installation,
  152       'Submit &Bug report ...'                 = www_open(swipl_bugs)
  153     ],
  154     [ before_menu(-)
  155     ]).
  156
  157
  158init_win_menus :-
  159    (   menu(Menu, Items, Options),
  160        (   memberchk(before_item(Before), Options)
  161        ->  true
  162        ;   Before = (-)
  163        ),
  164        (   memberchk(before_menu(BM), Options)
  165        ->  true
  166        ;   BM = (-)
  167        ),
  168        win_insert_menu(Menu, BM),
  169        (   '$member'(Item, Items),
  170            (   Item = (Label = Action)
  171            ->  true
  172            ;   Item == --
  173            ->  Label = --
  174            ),
  175            win_insert_menu_item(Menu, Label, Before, Action),
  176            fail
  177        ;   true
  178        ),
  179        fail
  180    ;   current_prolog_flag(associated_file, File),
  181        add_to_mru(load, File)
  182    ;   insert_associated_file
  183    ),
  184    refresh_mru.
  185
  186associated_file(File) :-
  187    current_prolog_flag(associated_file, File),
  188    !.
  189associated_file(File) :-
  190    '$cmd_option_val'(script_file, OsFiles),
  191    OsFiles = [OsFile],
  192    !,
  193    prolog_to_os_filename(File, OsFile).
  194
  195insert_associated_file :-
  196    associated_file(File),
  197    !,
  198    file_base_name(File, Base),
  199    atom_concat('Edit &', Base, Label),
  200    win_insert_menu_item('&File', Label, '&New ...', edit(file(File))).
  201insert_associated_file.
  202
  203
  204:- if(current_predicate(win_has_menu/0)).  205:- initialization
  206   (   win_has_menu
  207   ->  init_win_menus
  208   ;   true
  209   ).  210:- endif.  211
  212                 /*******************************
  213                 *            ACTIONS           *
  214                 *******************************/
  215
  216edit_new(File) :-
  217    call(edit(file(File))).         % avoid autoloading
  218
  219www_open(Id) :-
  220    Spec =.. [Id, '.'],
  221    call(expand_url_path(Spec, URL)),
  222    print_message(informational, opening_url(URL)),
  223    call(www_open_url(URL)),        % avoid autoloading
  224    print_message(informational, opened_url(URL)).
  225
  226html_open(Spec) :-
  227    absolute_file_name(Spec, [access(read)], Path),
  228    call(win_shell(open, Path)).
  229
  230:- if(current_predicate(win_message_box/2)).  231
  232about :-
  233    message_to_string(about, AboutSWI),
  234    (   current_prolog_flag(console_menu_version, qt)
  235    ->  message_to_string(about_qt, AboutQt),
  236        format(atom(About), '<p>~w\n<p>~w', [AboutSWI, AboutQt])
  237    ;   About = AboutSWI
  238    ),
  239    atomic_list_concat(Lines, '\n', About),
  240    atomic_list_concat(Lines, '<br>', AboutHTML),
  241    win_message_box(
  242        AboutHTML,
  243        [ title('About swipl-win'),
  244          image(':/swipl.png'),
  245          min_width(700)
  246        ]).
  247
  248:- else.  249
  250about :-
  251    print_message(informational, about).
  252
  253:- endif.  254
  255load(Path) :-
  256    (   \+ current_prolog_flag(associated_file, _)
  257    ->  file_directory_name(Path, Dir),
  258        working_directory(_, Dir),
  259        set_prolog_flag(associated_file, Path)
  260    ;   true
  261    ),
  262    user:load_files(Path).
  263
  264
  265                 /*******************************
  266                 *       HANDLE CALLBACK        *
  267                 *******************************/
  268
  269action(Action) :-
  270    strip_module(Action, Module, Plain),
  271    Plain =.. [Name|Args],
  272    gather_args(Args, Values),
  273    Goal =.. [Name|Values],
  274    call(Module:Goal).
  275
  276gather_args([], []).
  277gather_args([+H0|T0], [H|T]) :-
  278    !,
  279    gather_arg(H0, H),
  280    gather_args(T0, T).
  281gather_args([H|T0], [H|T]) :-
  282    gather_args(T0, T).
  283
  284:- if(current_prolog_flag(console_menu_version, qt)).  285
  286gather_arg(file(open, Title), File) :-
  287    !,
  288    source_types_desc(Desc),
  289    pqConsole:getOpenFileName(Title, _, Desc, File),
  290    add_to_mru(edit, File).
  291
  292gather_arg(file(save, Title), File) :-
  293    source_types_desc(Desc),
  294    pqConsole:getSaveFileName(Title, _, Desc, File),
  295    add_to_mru(edit, File).
  296
  297source_types_desc(Desc) :-
  298    findall(Pattern, prolog_file_pattern(Pattern), Patterns),
  299    atomic_list_concat(Patterns, ' ', Atom),
  300    format(atom(Desc), 'Prolog Source (~w)', [Atom]).
  301
  302:- else.  303
  304gather_arg(file(Mode, Title), File) :-
  305    findall(tuple('Prolog Source', Pattern),
  306            prolog_file_pattern(Pattern),
  307            Tuples),
  308    '$append'(Tuples, [tuple('All files', '*.*')], AllTuples),
  309    Filter =.. [chain|AllTuples],
  310    current_prolog_flag(hwnd, HWND),
  311    working_directory(CWD, CWD),
  312    call(get(@display, win_file_name,       % avoid autoloading
  313             Mode, Filter, Title,
  314             directory := CWD,
  315             owner := HWND,
  316             File)).
  317
  318:- endif.  319
  320prolog_file_pattern(Pattern) :-
  321    user:prolog_file_type(Ext, prolog),
  322    atom_concat('*.', Ext, Pattern).
  323
  324
  325:- if(current_prolog_flag(windows, true)).  326
  327                 /*******************************
  328                 *          APPLICATION         *
  329                 *******************************/
  330
  331%!  init_win_app
  332%
  333%   If Prolog is started using --win_app, try to change directory
  334%   to <My Documents>\Prolog.
  335
  336init_win_app :-
  337    current_prolog_flag(associated_file, _),
  338    !.
  339init_win_app :-
  340    '$cmd_option_val'(win_app, true),
  341    !,
  342    catch(my_prolog, E, print_message(warning, E)).
  343init_win_app.
  344
  345my_prolog :-
  346    win_folder(personal, MyDocs),
  347    atom_concat(MyDocs, '/Prolog', PrologDir),
  348    (   ensure_dir(PrologDir)
  349    ->  working_directory(_, PrologDir)
  350    ;   working_directory(_, MyDocs)
  351    ).
  352
  353
  354ensure_dir(Dir) :-
  355    exists_directory(Dir),
  356    !.
  357ensure_dir(Dir) :-
  358    catch(make_directory(Dir), E, (print_message(warning, E), fail)).
  359
  360
  361:- initialization
  362   init_win_app.  363
  364:- endif. /*windows*/
  365
  366
  367                 /*******************************
  368                 *             MacOS            *
  369                 *******************************/
  370
  371:- if(current_prolog_flag(console_menu_version, qt)).  372
  373:- multifile
  374    prolog:file_open_event/1.  375
  376:- create_prolog_flag(app_open_first, load, []).  377:- create_prolog_flag(app_open,       edit, []).  378
  379%!  prolog:file_open_event(+Name)
  380%
  381%   Called when opening a file  from   the  MacOS finder. The action
  382%   depends on whether this is the first file or not, and defined by
  383%   one of these flags:
  384%
  385%     - =app_open_first= defines the action for the first open event
  386%     - =app_open= defines the action for subsequent open event
  387%
  388%   On the _first_ open event, the  working directory of the process
  389%   is changed to the directory holding the   file. Action is one of
  390%   the following:
  391%
  392%     * load
  393%     Load the file into Prolog
  394%     * edit
  395%     Open the file in the editor
  396%     * new_instance
  397%     Open the file in a new instance of Prolog and load it there.
  398
  399prolog:file_open_event(Path) :-
  400    (   current_prolog_flag(associated_file, _)
  401    ->  current_prolog_flag(app_open, Action)
  402    ;   current_prolog_flag(app_open_first, Action),
  403        file_directory_name(Path, Dir),
  404        working_directory(_, Dir),
  405        set_prolog_flag(associated_file, Path),
  406        insert_associated_file
  407    ),
  408    must_be(oneof([edit,load,new_instance]), Action),
  409    file_open_event(Action, Path).
  410
  411file_open_event(edit, Path) :-
  412    edit(Path).
  413file_open_event(load, Path) :-
  414    add_to_mru(load, Path),
  415    user:load_files(Path).
  416:- if(current_prolog_flag(apple, true)).  417file_open_event(new_instance, Path) :-
  418    current_app(Me),
  419    print_message(informational, new_instance(Path)),
  420    process_create(path(open), [ '-n', '-a', Me, Path ], []).
  421:- else.  422file_open_event(new_instance, Path) :-
  423    current_prolog_flag(executable, Exe),
  424    process_create(Exe, [Path], [process(_Pid)]).
  425:- endif.  426
  427
  428:- if(current_prolog_flag(apple, true)).  429current_app(App) :-
  430    current_prolog_flag(executable, Exe),
  431    file_directory_name(Exe, MacOSDir),
  432    atom_concat(App, '/Contents/MacOS', MacOSDir).
  433
  434%!  go_home_on_plain_app_start is det.
  435%
  436%   On Apple, we start in the users   home dir if the application is
  437%   started by opening the app directly.
  438
  439go_home_on_plain_app_start :-
  440    current_prolog_flag(os_argv, [_Exe]),
  441    current_app(App),
  442    file_directory_name(App, Above),
  443    working_directory(PWD, PWD),
  444    same_file(PWD, Above),
  445    expand_file_name(~, [Home]),
  446    !,
  447    working_directory(_, Home).
  448go_home_on_plain_app_start.
  449
  450:- initialization
  451    go_home_on_plain_app_start.  452
  453:- endif.  454:- endif.  455
  456:- if(current_predicate(win_current_preference/3)).  457
  458mru_info('&File', 'Edit &Recent', 'MRU2',    path, edit).
  459mru_info('&File', 'Load &Recent', 'MRULoad', path, load).
  460
  461add_to_mru(Action, File) :-
  462    mru_info(_Top, _Menu, PrefGroup, PrefKey, Action),
  463    (   win_current_preference(PrefGroup, PrefKey, CPs), nonvar(CPs)
  464    ->  (   select(File, CPs, Rest)
  465        ->  Updated = [File|Rest]
  466        ;   length(CPs, Len),
  467            Len > 10
  468        ->  append(CPs1, [_], CPs),
  469            Updated = [File|CPs1]
  470        ;   Updated = [File|CPs]
  471        )
  472    ;   Updated = [File]
  473    ),
  474    win_set_preference(PrefGroup, PrefKey, Updated),
  475    refresh_mru.
  476
  477refresh_mru :-
  478    (   mru_info(FileMenu, Menu, PrefGroup, PrefKey, Action),
  479        win_current_preference(PrefGroup, PrefKey, CPs),
  480        maplist(action_path_menu(Action), CPs, Labels, Actions),
  481        win_insert_menu_item(FileMenu, Menu/Labels, -, Actions),
  482        fail
  483    ;   true
  484    ).
  485
  486action_path_menu(ActionItem, Path, Label, win_menu:Action) :-
  487    file_base_name(Path, Label),
  488    Action =.. [ActionItem, Path].
  489
  490:- else.  491
  492add_to_mru(_, _).
  493refresh_mru.
  494
  495:- endif.  496
  497
  498                 /*******************************
  499                 *            MESSAGES          *
  500                 *******************************/
  501
  502:- multifile
  503    prolog:message/3.  504
  505prolog:message(opening_url(Url)) -->
  506    [ 'Opening ~w ... '-[Url], flush ].
  507prolog:message(opened_url(_Url)) -->
  508    [ at_same_line, 'ok' ].
  509prolog:message(new_instance(Path)) -->
  510    [ 'Opening new Prolog instance for ~p'-[Path] ].
  511:- if(current_prolog_flag(console_menu_version, qt)).  512prolog:message(about_qt) -->
  513    [ 'Qt-based console by Carlo Capelli' ].
  514:- endif.