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