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