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-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_main,
   38          [ main/0,
   39            argv_options/3,             % +Argv, -RestArgv, -Options
   40            argv_options/4,             % +Argv, -RestArgv, -Options, +ParseOpts
   41            argv_usage/1,               % +Level
   42            cli_parse_debug_options/2,  % +OptionsIn, -Options
   43            cli_enable_development_system/0
   44          ]).   45% use autoload/1 to avoid checking these files at load time.
   46:- autoload(library(debug)).   47:- autoload(library(threadutil)).   48% These are fine to be checked and loaded
   49:- autoload(library(apply), [maplist/3, partition/4]).   50:- autoload(library(lists), [append/3]).   51:- autoload(library(pairs), [pairs_keys/2, pairs_values/2]).   52:- autoload(library(prolog_code), [pi_head/2]).   53:- autoload(library(prolog_debug), [spy/1]).   54:- autoload(library(dcg/high_order), [sequence//3, sequence//2]).   55:- autoload(library(option), [option/2]).   56
   57:- meta_predicate
   58    argv_options(:, -, -),
   59    argv_options(:, -, -, +),
   60    argv_usage(:).   61
   62:- dynamic
   63    interactive/0.   64
   65/** <module> Provide entry point for scripts
   66
   67This library is intended for supporting   PrologScript on Unix using the
   68``#!`` magic sequence for scripts using   commandline options. The entry
   69point main/0 calls the user-supplied predicate  main/1 passing a list of
   70commandline options. Below is a simle `echo` implementation in Prolog.
   71
   72```
   73#!/usr/bin/env swipl
   74
   75:- initialization(main, main).
   76
   77main(Argv) :-
   78    echo(Argv).
   79
   80echo([]) :- nl.
   81echo([Last]) :- !,
   82    write(Last), nl.
   83echo([H|T]) :-
   84    write(H), write(' '),
   85    echo(T).
   86```
   87
   88@see	library(prolog_stack) to force backtraces in case of an
   89	uncaught exception.
   90@see    XPCE users should have a look at library(pce_main), which
   91        starts the GUI and processes events until all windows have gone.
   92*/
   93
   94:- module_transparent
   95    main/0.   96
   97%!  main
   98%
   99%   Call main/1 using the passed  command-line arguments. Before calling
  100%   main/1  this  predicate  installs  a  signal  handler  for  =SIGINT=
  101%   (Control-C) that terminates the process with status 1.
  102%
  103%   When main/0 is called interactively it  simply calls main/1 with the
  104%   arguments. This allows for debugging scripts as follows:
  105%
  106%   ```
  107%   $ swipl -l script.pl -- arg ...
  108%   ?- gspy(suspect/1).		% setup debugging
  109%   ?- main.			% run program
  110%   ```
  111
  112main :-
  113    current_prolog_flag(break_level, _),
  114    !,
  115    current_prolog_flag(argv, Av),
  116    context_module(M),
  117    M:main(Av).
  118main :-
  119    context_module(M),
  120    set_signals,
  121    current_prolog_flag(argv, Av),
  122    catch_with_backtrace(M:main(Av), Error, throw(Error)),
  123    (   interactive
  124    ->  cli_enable_development_system
  125    ;   true
  126    ).
  127
  128set_signals :-
  129    on_signal(int, _, interrupt).
  130
  131%!  interrupt(+Signal)
  132%
  133%   We received an interrupt.  This handler is installed using
  134%   on_signal/3.
  135
  136interrupt(_Sig) :-
  137    halt(1).
  138
  139		 /*******************************
  140		 *            OPTIONS		*
  141		 *******************************/
  142
  143%!  argv_options(:Argv, -Positional, -Options) is det.
  144%
  145%   Parse command line arguments. This  predicate   acts  in  one of two
  146%   modes.
  147%
  148%     - If the calling module defines opt_type/3, full featured parsing
  149%       with long and short options, type conversion and help is
  150%       provided.
  151%     - If opt_type/3 is not defined, only unguided transformation
  152%       using long options is supported. See argv_untyped_options/3
  153%       for details.
  154%
  155%   When __guided__, three predicates are called  in the calling module.
  156%   opt_type/3 __must__ be defined, the others need not. Note that these
  157%   three predicates _may_ be defined as   _multifile_ to allow multiple
  158%   modules contributing to the provided   commandline options. Defining
  159%   them as _discontiguous_ allows for creating   blocks that describe a
  160%   group of related options.
  161%
  162%     - opt_type(Opt, Name, Type)
  163%       Defines Opt to add an option Name(Value), where Value statisfies
  164%       Type.  Opt does not include the leading `-`.  A single character
  165%       implies a short option, multiple a long option.  Long options
  166%       use ``_`` as _word separator_, user options may use either ``_``
  167%       or ``-``.  Type is one of:
  168%
  169%       - A|B
  170%         Disjunctive type.
  171%       - boolean(Default)
  172%       - boolean
  173%         Boolean options are special.  They do not take a value except
  174%         for when using the long ``--opt=value`` notation. This
  175%         explicit value specification converts ``true``, ``True``,
  176%         ``TRUE``, ``on``, ``On``, ``ON``, ``1`` and the obvious
  177%         false equivalents to Prolog `true` or `false`.  If the
  178%         option is specified, Default is used.  If ``--no-opt`` or
  179%         ``--noopt`` is used, the inverse of Default is used.
  180%       - integer
  181%         Argument is converted to an integer
  182%       - float
  183%         Argument is converted to a float.  User may specify an integer
  184%       - nonneg
  185%         As `integer`.  Requires value >= 0.
  186%       - natural
  187%         As `integer`.  Requires value >= 1.
  188%       - number
  189%         Any number (integer, float, rational).
  190%       - between(Low, High)
  191%         If both one of Low and High is a float, convert as `float`,
  192%         else convert as `integer`.  Then check the range.
  193%       - atom
  194%         No conversion
  195%       - oneof(List)
  196%         As `atom`, but requires the value to be a member of List
  197%         (_enum_ type).
  198%       - string
  199%         Convert to a SWI-Prolog string
  200%       - file
  201%         Convert to a file name in Prolog canonical notation
  202%         using prolog_to_os_filename/2.
  203%       - file(Access)
  204%         As `file`, and check access using access_file/2.  A value `-`
  205%         is not checked for access, assuming the application handles
  206%         this as standard input or output.
  207%       - term
  208%         Parse option value to a Prolog term.
  209%       - term(+Options)
  210%         As `term`, but passes Options to term_string/3. If the option
  211%         variable_names(Bindings) is given the option value is set to
  212%         the _pair_ `Term-Bindings`.
  213%
  214%     - opt_help(Name, HelpString)
  215%       Help string used by argv_usage/1.
  216%
  217%     - opt_meta(Name, Meta)
  218%       If a typed argument is required this defines the placeholder
  219%       in the help message.  The default is the uppercase version of
  220%       the type _functor name_. This produces the ``FILE`` in e.g. ``-f
  221%       FILE``.
  222%
  223%    By default, ``-h``, ``-?`` and  ``--help``   are  bound to help. If
  224%    opt_type(Opt, help, boolean) is true for   some  `Opt`, the default
  225%    help binding and help message  are   disabled  and  the normal user
  226%    rules apply. In particular, the user should also provide a rule for
  227%    opt_help(help, String).
  228
  229argv_options(M:Argv, Positional, Options) :-
  230    in(M:opt_type(_,_,_)),
  231    !,
  232    argv_options(M:Argv, Positional, Options, [on_error(halt(1))]).
  233argv_options(_:Argv, Positional, Options) :-
  234    argv_untyped_options(Argv, Positional, Options).
  235
  236%!  argv_options(:Argv, -Positional, -Options, +ParseOptions) is det.
  237%
  238%   As argv_options/3 in __guided__ mode,  Currently this version allows
  239%   parsing argument options throwing an   exception rather than calling
  240%   halt/1 by passing an empty list to ParseOptions. ParseOptions:
  241%
  242%     - on_error(+Goal)
  243%       If Goal is halt(Code), exit with Code.  Other goals are
  244%       currently not supported.
  245%     - options_after_arguments(+Boolean)
  246%       If `false` (default `true`), stop parsing after the first
  247%       positional argument, returning options that follow this
  248%       argument as positional arguments.  E.g, ``-x file -y``
  249%       results in positional arguments `[file, '-y']`
  250
  251argv_options(Argv, Positional, Options, POptions) :-
  252    option(on_error(halt(Code)), POptions),
  253    !,
  254    E = error(_,_),
  255    catch(opt_parse(Argv, Positional, Options, POptions), E,
  256          ( print_message(error, E),
  257            halt(Code)
  258          )).
  259argv_options(Argv, Positional, Options, POptions) :-
  260    opt_parse(Argv, Positional, Options, POptions).
  261
  262%!  argv_untyped_options(+Argv, -RestArgv, -Options) is det.
  263%
  264%   Generic transformation of long  commandline   arguments  to options.
  265%   Each ``--Name=Value`` is mapped to Name(Value).   Each plain name is
  266%   mapped to Name(true), unless Name starts with ``no-``, in which case
  267%   the option is mapped  to  Name(false).   Numeric  option  values are
  268%   mapped to Prolog numbers.
  269
  270argv_untyped_options([], Pos, Opts) =>
  271    Pos = [], Opts = [].
  272argv_untyped_options([--|R], Pos, Ops) =>
  273    Pos = R, Ops = [].
  274argv_untyped_options([H0|T0], R, Ops), sub_atom(H0, 0, _, _, --) =>
  275    Ops = [H|T],
  276    (   sub_atom(H0, B, _, A, =)
  277    ->  B2 is B-2,
  278        sub_atom(H0, 2, B2, _, Name),
  279        sub_string(H0, _, A,  0, Value0),
  280        convert_option(Name, Value0, Value)
  281    ;   sub_atom(H0, 2, _, 0, Name0),
  282        (   sub_atom(Name0, 0, _, _, 'no-')
  283        ->  sub_atom(Name0, 3, _, 0, Name),
  284            Value = false
  285        ;   Name = Name0,
  286            Value = true
  287        )
  288    ),
  289    canonical_name(Name, PlName),
  290    H =.. [PlName,Value],
  291    argv_untyped_options(T0, R, T).
  292argv_untyped_options([H|T0], Ops, T) =>
  293    Ops = [H|R],
  294    argv_untyped_options(T0, R, T).
  295
  296convert_option(password, String, String) :- !.
  297convert_option(_, String, Number) :-
  298    number_string(Number, String),
  299    !.
  300convert_option(_, String, Atom) :-
  301    atom_string(Atom, String).
  302
  303canonical_name(Name, PlName) :-
  304    split_string(Name, "-_", "", Parts),
  305    atomic_list_concat(Parts, '_', PlName).
  306
  307%!  opt_parse(:Argv, -Positional, -Options, +POptions) is det.
  308%
  309%   Rules follow those of Python optparse:
  310%
  311%     - Short options must be boolean, except for the last.
  312%     - The value of a short option can be connected or the next
  313%       argument
  314%     - Long options can have "=value" or have the value in the
  315%       next argument.
  316
  317opt_parse(M:Argv, _Positional, _Options, _POptions) :-
  318    opt_needs_help(M:Argv),
  319    !,
  320    argv_usage(M:debug),
  321    halt(0).
  322opt_parse(M:Argv, Positional, Options, POptions) :-
  323    opt_parse(Argv, Positional, Options, M, POptions).
  324
  325opt_needs_help(M:[Arg]) :-
  326    in(M:opt_type(_, help, boolean)),
  327    !,
  328    in(M:opt_type(Opt, help, boolean)),
  329    (   short_opt(Opt)
  330    ->  atom_concat(-, Opt, Arg)
  331    ;   atom_concat(--, Opt, Arg)
  332    ),
  333    !.
  334opt_needs_help(_:['-h']).
  335opt_needs_help(_:['-?']).
  336opt_needs_help(_:['--help']).
  337
  338opt_parse([], Positional, Options, _, _) =>
  339    Positional = [],
  340    Options = [].
  341opt_parse([--|T], Positional, Options, _, _) =>
  342    Positional = T,
  343    Options = [].
  344opt_parse([H|T], Positional, Options, M, POptions), atom_concat(--, Long, H) =>
  345    take_long(Long, T, Positional, Options, M, POptions).
  346opt_parse([H|T], Positional, Options, M, POptions),
  347    H \== '-',
  348    string_concat(-, Opts, H) =>
  349    string_chars(Opts, Shorts),
  350    take_shorts(Shorts, T, Positional, Options, M, POptions).
  351opt_parse(Argv, Positional, Options, _M, POptions),
  352    option(options_after_arguments(false), POptions) =>
  353    Positional = Argv,
  354    Options = [].
  355opt_parse([H|T], Positional, Options, M, POptions) =>
  356    Positional = [H|PT],
  357    opt_parse(T, PT, Options, M, POptions).
  358
  359
  360take_long(Long, T, Positional, Options, M, POptions) :- % --long=Value
  361    sub_atom(Long, B, _, A, =),
  362    !,
  363    sub_atom(Long, 0, B, _, LName0),
  364    sub_atom(Long, _, A, 0, VAtom),
  365    canonical_name(LName0, LName),
  366    (   in(M:opt_type(LName, Name, Type))
  367    ->  opt_value(Type, Long, VAtom, Value),
  368        Opt =.. [Name,Value],
  369        Options = [Opt|OptionsT],
  370        opt_parse(T, Positional, OptionsT, M, POptions)
  371    ;   opt_error(unknown_option(M:LName0))
  372    ).
  373take_long(LName0, T, Positional, Options, M, POptions) :- % --long
  374    canonical_name(LName0, LName),
  375    take_long_(LName, T, Positional, Options, M, POptions).
  376
  377take_long_(Long, T, Positional, Options, M, POptions) :- % --long
  378    opt_bool_type(Long, Name, Value, M),
  379    !,
  380    Opt =.. [Name,Value],
  381    Options = [Opt|OptionsT],
  382    opt_parse(T, Positional, OptionsT, M, POptions).
  383take_long_(Long, T, Positional, Options, M, POptions) :- % --no-long, --nolong
  384    (   atom_concat('no_', LName, Long)
  385    ;   atom_concat('no', LName, Long)
  386    ),
  387    opt_bool_type(LName, Name, Value0, M),
  388    !,
  389    negate(Value0, Value),
  390    Opt =.. [Name,Value],
  391    Options = [Opt|OptionsT],
  392    opt_parse(T, Positional, OptionsT, M, POptions).
  393take_long_(Long, T, Positional, Options, M, POptions) :- % --long
  394    in(M:opt_type(Long, Name, Type)),
  395    !,
  396    (   T = [VAtom|T1]
  397    ->  opt_value(Type, Long, VAtom, Value),
  398        Opt =.. [Name,Value],
  399        Options = [Opt|OptionsT],
  400        opt_parse(T1, Positional, OptionsT, M, POptions)
  401    ;   opt_error(missing_value(Long, Type))
  402    ).
  403take_long_(Long, _, _, _, M, _) :-
  404    opt_error(unknown_option(M:Long)).
  405
  406take_shorts([], T, Positional, Options, M, POptions) :-
  407    opt_parse(T, Positional, Options, M, POptions).
  408take_shorts([H|T], Argv, Positional, Options, M, POptions) :-
  409    opt_bool_type(H, Name, Value, M),
  410    !,
  411    Opt =.. [Name,Value],
  412    Options = [Opt|OptionsT],
  413    take_shorts(T, Argv, Positional, OptionsT, M, POptions).
  414take_shorts([H|T], Argv, Positional, Options, M, POptions) :-
  415    in(M:opt_type(H, Name, Type)),
  416    !,
  417    (   T == []
  418    ->  (   Argv = [VAtom|ArgvT]
  419        ->  opt_value(Type, H, VAtom, Value),
  420            Opt =.. [Name,Value],
  421            Options = [Opt|OptionsT],
  422            take_shorts(T, ArgvT, Positional, OptionsT, M, POptions)
  423        ;   opt_error(missing_value(H, Type))
  424        )
  425    ;   atom_chars(VAtom, T),
  426        opt_value(Type, H, VAtom, Value),
  427        Opt =.. [Name,Value],
  428        Options = [Opt|OptionsT],
  429        take_shorts([], Argv, Positional, OptionsT, M, POptions)
  430    ).
  431take_shorts([H|_], _, _, _, M, _) :-
  432    opt_error(unknown_option(M:H)).
  433
  434opt_bool_type(Opt, Name, Value, M) :-
  435    in(M:opt_type(Opt, Name, Type)),
  436    (   Type == boolean
  437    ->  Value = true
  438    ;   Type = boolean(Value)
  439    ).
  440
  441negate(true, false).
  442negate(false, true).
  443
  444%!  opt_value(+Type, +Opt, +VAtom, -Value) is det.
  445%
  446%   @error opt_error(Error)
  447
  448opt_value(Type, _Opt, VAtom, Value) :-
  449    opt_convert(Type, VAtom, Value),
  450    !.
  451opt_value(Type, Opt, VAtom, _) :-
  452    opt_error(value_type(Opt, Type, VAtom)).
  453
  454%!  opt_convert(+Type, +VAtom, -Value) is semidet.
  455
  456opt_convert(A|B, Spec, Value) :-
  457    (   opt_convert(A, Spec, Value)
  458    ->  true
  459    ;   opt_convert(B, Spec, Value)
  460    ).
  461opt_convert(boolean, Spec, Value) :-
  462    to_bool(Spec, Value).
  463opt_convert(boolean(_), Spec, Value) :-
  464    to_bool(Spec, Value).
  465opt_convert(number, Spec, Value) :-
  466    atom_number(Spec, Value).
  467opt_convert(integer, Spec, Value) :-
  468    atom_number(Spec, Value),
  469    integer(Value).
  470opt_convert(float, Spec, Value) :-
  471    atom_number(Spec, Value0),
  472    Value is float(Value0).
  473opt_convert(nonneg, Spec, Value) :-
  474    atom_number(Spec, Value),
  475    integer(Value),
  476    Value >= 0.
  477opt_convert(natural, Spec, Value) :-
  478    atom_number(Spec, Value),
  479    integer(Value),
  480    Value >= 1.
  481opt_convert(between(Low, High), Spec, Value) :-
  482    atom_number(Spec, Value0),
  483    (   ( float(Low) ; float(High) )
  484    ->  Value is float(Value0)
  485    ;   integer(Value0),
  486        Value = Value0
  487    ),
  488    Value >= Low, Value =< High.
  489opt_convert(atom, Value, Value).
  490opt_convert(oneof(List), Value, Value) :-
  491    memberchk(Value, List).
  492opt_convert(string, Value0, Value) :-
  493    atom_string(Value0, Value).
  494opt_convert(file, Spec, Value) :-
  495    prolog_to_os_filename(Value, Spec).
  496opt_convert(file(Access), Spec, Value) :-
  497    (   Spec == '-'
  498    ->  Value = '-'
  499    ;   prolog_to_os_filename(Value, Spec),
  500        (   access_file(Value, Access)
  501        ->  true
  502        ;   opt_error(access_file(Spec, Access))
  503        )
  504    ).
  505opt_convert(term, Spec, Value) :-
  506    term_string(Value, Spec, []).
  507opt_convert(term(Options), Spec, Value) :-
  508    term_string(Term, Spec, Options),
  509    (   option(variable_names(Bindings), Options)
  510    ->  Value = Term-Bindings
  511    ;   Value = Term
  512    ).
  513
  514to_bool(true,    true).
  515to_bool('True',  true).
  516to_bool('TRUE',  true).
  517to_bool(on,      true).
  518to_bool('On',    true).
  519to_bool('1',     true).
  520to_bool(false,   false).
  521to_bool('False', false).
  522to_bool('FALSE', false).
  523to_bool(off,     false).
  524to_bool('Off',   false).
  525to_bool('0',     false).
  526
  527%!  argv_usage(:Level) is det.
  528%
  529%   Use print_message/2 to print a usage message  at Level. To print the
  530%   message as plain text indefault color, use `debug`. Other meaningful
  531%   options are `informational` or `warning`. The  help page consists of
  532%   four sections, two of which are optional:
  533%
  534%     1. The __header__ is created from opt_help(help(header), String).
  535%        It is optional.
  536%     2. The __usage__ is added by default.  The part behind
  537%        ``Usage: <command>`` is by default ``[options]`` and can be
  538%        overruled using opt_help(help(usage), String).
  539%     3. The actual option descriptions.  The options are presented
  540%        in the order they are defined in opt_type/3.  Subsequent
  541%        options for the same _destination_ (option name) are joined
  542%        with the first.
  543%     4. The _footer__ is created from opt_help(help(footer), String).
  544%        It is optional.
  545%
  546%   The help provided by help(header),  help(usage) and help(footer) are
  547%   either a simple  string  or  a  list   of  elements  as  defined  by
  548%   print_message_lines/3. In the latter case, the construct `\Callable`
  549%   can be used to call a DCG  rule   in  the module from which the user
  550%   calls argv_options/3.  For example, we can add a bold title using
  551%
  552%       opt_help(help(header), [ansi(bold, '~w', ['My title'])]).
  553
  554argv_usage(M:Level) :-
  555    print_message(Level, opt_usage(M)).
  556
  557:- multifile
  558    prolog:message//1.  559
  560prolog:message(opt_usage(M)) -->
  561    usage(M).
  562
  563usage(M) -->
  564    usage_text(M:header),
  565    usage_line(M),
  566    usage_options(M),
  567    usage_text(M:footer).
  568
  569%!  usage_text(:Which)// is det.
  570%
  571%   Emit  a  user  element.  This  may    use  elements  as  defined  by
  572%   print_message_lines/3 or can be a simple string.
  573
  574usage_text(M:Which) -->
  575    { in(M:opt_help(help(Which), Help))
  576    },
  577    !,
  578    (   {Which == header}
  579    ->  user_text(M:Help), [nl]
  580    ;   [nl], user_text(M:Help)
  581    ).
  582usage_text(_) -->
  583    [].
  584
  585user_text(M:Entries) -->
  586    { is_list(Entries) },
  587    sequence(help_elem(M), Entries).
  588user_text(_:Help) -->
  589    [ '~w'-[Help] ].
  590
  591help_elem(M, \Callable) -->
  592    { callable(Callable) },
  593    call(M:Callable),
  594    !.
  595help_elem(_M, Elem) -->
  596    [ Elem ].
  597
  598usage_line(M) -->
  599    [ ansi(comment, 'Usage: ', []) ],
  600    cmdline(M),
  601    (   {in(M:opt_help(help(usage), Help))}
  602    ->  user_text(M:Help)
  603    ;   [ ' [options]'-[] ]
  604    ),
  605    [ nl, nl ].
  606
  607cmdline(_M) -->
  608    { current_prolog_flag(associated_file, AbsFile),
  609      file_base_name(AbsFile, Base),
  610      current_prolog_flag(os_argv, Argv),
  611      append(Pre, [File|_], Argv),
  612      file_base_name(File, Base),
  613      append(Pre, [File], Cmd),
  614      !
  615    },
  616    sequence(cmdarg, [' '-[]], Cmd).
  617cmdline(_M) -->
  618    { current_prolog_flag(saved_program, true),
  619      current_prolog_flag(os_argv, OsArgv),
  620      append(_, ['-x', State|_], OsArgv),
  621      !
  622    },
  623    cmdarg(State).
  624cmdline(_M) -->
  625    { current_prolog_flag(os_argv, [Argv0|_])
  626    },
  627    cmdarg(Argv0).
  628
  629cmdarg(A) -->
  630    [ '~w'-[A] ].
  631
  632%!  usage_options(+Module)//
  633%
  634%   Find the defined options and display   help on them. Uses opt_type/3
  635%   to find the options and their type,   opt_help/2  to find the option
  636%   help comment and opt_meta/2 for _meta types_.
  637
  638usage_options(M) -->
  639    { findall(Opt, get_option(M, Opt), Opts),
  640      maplist(options_width, Opts, OptWidths),
  641      max_list(OptWidths, MaxOptWidth),
  642      catch(tty_size(_, Width), _, Width = 80),
  643      OptColW is min(MaxOptWidth, 30),
  644      HelpColW is Width-4-OptColW
  645    },
  646    [ ansi(comment, 'Options:', []), nl ],
  647    sequence(opt_usage(OptColW, HelpColW), [nl], Opts).
  648
  649opt_usage(OptColW, HelpColW, opt(_Name, Type, Short, Long, Help, Meta)) -->
  650    options(Type, Short, Long, Meta),
  651    [ '~t~*:| '-[OptColW] ],
  652    help_text(Help, OptColW, HelpColW).
  653
  654help_text([First|Lines], Indent, _Width) -->
  655    !,
  656    [ '~w'-[First], nl ],
  657    sequence(rest_line(Indent), [nl], Lines).
  658help_text(Text, _Indent, Width) -->
  659    { string_length(Text, Len),
  660      Len =< Width
  661    },
  662    !,
  663    [ '~w'-[Text] ].
  664help_text(Text, Indent, Width) -->
  665    { wrap_text(Width, Text, [First|Lines])
  666    },
  667    [ '~w'-[First], nl ],
  668    sequence(rest_line(Indent), [nl], Lines).
  669
  670rest_line(Indent, Line) -->
  671    [ '~t~*| ~w'-[Indent, Line] ].
  672
  673%!  wrap_text(+Width, +Text, -Wrapped)
  674%
  675%   Simple text wrapper. Breaks Text into   words and creates lines with
  676%   minimally one word and as many  additional   words  as fit in Width.
  677%   Wrapped is a list of strings.
  678
  679wrap_text(Width, Text, Wrapped) :-
  680    split_string(Text, " \t\n", " \t\n", Words),
  681    wrap_lines(Words, Width, Wrapped).
  682
  683wrap_lines([], _, []).
  684wrap_lines([H|T0], Width, [Line|Lines]) :-
  685    !,
  686    string_length(H, Len),
  687    take_line(T0, T1, Width, Len, LineWords),
  688    atomics_to_string([H|LineWords], " ", Line),
  689    wrap_lines(T1, Width, Lines).
  690
  691take_line([H|T0], T, Width, Here, [H|Line]) :-
  692    string_length(H, Len),
  693    NewHere is Here+Len+1,
  694    NewHere =< Width,
  695    !,
  696    take_line(T0, T, Width, NewHere, Line).
  697take_line(T, T, _, _, []).
  698
  699%!  options(+Type, +ShortOpt, +LongOpts, +Meta)//
  700%
  701%   Emit a line with options.
  702
  703options(Type, ShortOpt, LongOpts, Meta) -->
  704    { append(ShortOpt, LongOpts, Opts) },
  705    sequence(option(Type, Meta), [', '-[]], Opts).
  706
  707option(boolean, _, Opt) -->
  708    opt(Opt).
  709option(_, Meta, Opt) -->
  710    opt(Opt),
  711    (   { short_opt(Opt) }
  712    ->  [ ' '-[] ]
  713    ;   [ '='-[] ]
  714    ),
  715    [ ansi(var, '~w', [Meta]) ].
  716
  717%!  options_width(+Opt, -Width) is det.
  718%
  719%   Compute the width of the column we need for the options.
  720
  721options_width(opt(_Name, boolean, Short, Long, _Help, _Meta), W) =>
  722    length(Short, SCount),
  723    length(Long, LCount),
  724    maplist(atom_length, Long, LLens),
  725    sum_list(LLens, LLen),
  726    W is ((SCount+LCount)-1)*2 +               % ', ' seps
  727         SCount*2 +
  728         LCount*2 + LLen.
  729options_width(opt(_Name, _Type, Short, Long, _Help, Meta), W) =>
  730    length(Short, SCount),
  731    length(Long, LCount),
  732    atom_length(Meta, MLen),
  733    maplist(atom_length, Long, LLens),
  734    sum_list(LLens, LLen),
  735    W is ((SCount+LCount)-1)*2 +               % ', ' seps
  736         SCount*3 + SCount*MLen +
  737         LCount*3 + LLen + LCount*MLen.
  738
  739%!  get_option(+Module, -Opt) is multi.
  740%
  741%   Get a description for a single option.  Opt is a term
  742%
  743%       opt(Name, Type, ShortFlags, Longflags, Help, Meta).
  744
  745get_option(M, opt(help, boolean, [h,?], [help],
  746                  Help, -)) :-
  747    \+ in(M:opt_type(_, help, boolean)),       % user defined help
  748    (   in(M:opt_help(help, Help))
  749    ->  true
  750    ;   Help = "Show this help message and exit"
  751    ).
  752get_option(M, opt(Name, Type, Short, Long, Help, Meta)) :-
  753    findall(Name, in(M:opt_type(_, Name, _)), Names),
  754    list_to_set(Names, UNames),
  755    member(Name, UNames),
  756    findall(Opt-Type,
  757            in(M:opt_type(Opt, Name, Type)),
  758            Pairs),
  759    option_type(Name, Pairs, TypeT),
  760    functor(TypeT, Type, _),
  761    pairs_keys(Pairs, Opts),
  762    partition(short_opt, Opts, Short, Long),
  763    (   in(M:opt_help(Name, Help))
  764    ->  true
  765    ;   Help = ''
  766    ),
  767    (   in(M:opt_meta(Name, Meta))
  768    ->  true
  769    ;   upcase_atom(Type, Meta)
  770    ).
  771
  772option_type(Name, Pairs, Type) :-
  773    pairs_values(Pairs, Types),
  774    sort(Types, [Type|UTypes]),
  775    (   UTypes = []
  776    ->  true
  777    ;   print_message(warning,
  778                      error(opt_error(multiple_types(Name, [Type|UTypes])),_))
  779    ).
  780
  781%!  in(:Goal)
  782%
  783%   As call/1, but  fails  silently  if   there  is  no  predicate  that
  784%   implements Goal.
  785
  786in(Goal) :-
  787    pi_head(PI, Goal),
  788    current_predicate(PI),
  789    call(Goal).
  790
  791short_opt(Opt) :-
  792    atom_length(Opt, 1).
  793
  794		 /*******************************
  795		 *      OPT ERROR HANDLING	*
  796		 *******************************/
  797
  798%!  opt_error(+Error)
  799%
  800%   @error opt_error(Term)
  801
  802opt_error(Error) :-
  803    throw(error(opt_error(Error), _)).
  804
  805:- multifile
  806    prolog:error_message//1.  807
  808prolog:error_message(opt_error(Error)) -->
  809    opt_error(Error).
  810
  811opt_error(unknown_option(M:Opt)) -->
  812    [ 'Unknown option: '-[] ],
  813    opt(Opt),
  814    hint_help(M).
  815opt_error(missing_value(Opt, Type)) -->
  816    [ 'Option '-[] ],
  817    opt(Opt),
  818    [ ' requires an argument (of type ~p)'-[Type] ].
  819opt_error(value_type(Opt, Type, Found)) -->
  820    [ 'Option '-[] ],
  821    opt(Opt), [' requires'],
  822    type(Type),
  823    [ ' (found '-[], ansi(code, '~w', [Found]), ')'-[] ].
  824opt_error(access_file(File, exist)) -->
  825    [ 'File '-[], ansi(code, '~w', [File]),
  826      ' does not exist'-[]
  827    ].
  828opt_error(access_file(File, Access)) -->
  829    { access_verb(Access, Verb) },
  830    [ 'Cannot access file '-[], ansi(code, '~w', [File]),
  831      ' for '-[], ansi(code, '~w', [Verb])
  832    ].
  833
  834access_verb(read,    reading).
  835access_verb(write,   writing).
  836access_verb(append,  writing).
  837access_verb(execute, executing).
  838
  839hint_help(M) -->
  840    { in(M:opt_type(Opt, help, boolean)) },
  841    !,
  842    [ ' (' ], opt(Opt), [' for help)'].
  843hint_help(_) -->
  844    [ ' (-h for help)'-[] ].
  845
  846opt(Opt) -->
  847    { short_opt(Opt) },
  848    !,
  849    [ ansi(bold, '-~w', [Opt]) ].
  850opt(Opt) -->
  851    [ ansi(bold, '--~w', [Opt]) ].
  852
  853type(A|B) -->
  854    type(A), [' or'],
  855    type(B).
  856type(oneof([One])) -->
  857    !,
  858    [ ' ' ],
  859    atom(One).
  860type(oneof(List)) -->
  861    !,
  862    [ ' one of '-[] ],
  863    sequence(atom, [', '], List).
  864type(between(Low, High)) -->
  865    !,
  866    [ ' a number '-[],
  867      ansi(code, '~w', [Low]), '..', ansi(code, '~w', [High])
  868    ].
  869type(nonneg) -->
  870    [ ' a non-negative integer'-[] ].
  871type(natural) -->
  872    [ ' a positive integer (>= 1)'-[] ].
  873type(file(Access)) -->
  874    [ ' a file with ~w access'-[Access] ].
  875type(Type) -->
  876    [ ' an argument of type '-[], ansi(code, '~w', [Type]) ].
  877
  878atom(A) -->
  879    [ ansi(code, '~w', [A]) ].
  880
  881
  882		 /*******************************
  883		 *         DEBUG SUPPORT	*
  884		 *******************************/
  885
  886%!	cli_parse_debug_options(+OptionsIn, -Options) is det.
  887%
  888%       Parse certain commandline options for  debugging and development
  889%       purposes. Options processed are  below.   Note  that  the option
  890%       argument is an atom such that these  options may be activated as
  891%       e.g., ``--debug='http(_)'``.
  892%
  893%         - debug(Topic)
  894%           Call debug(Topic).  See debug/1 and debug/3.
  895%         - spy(Predicate)
  896%           Place a spy-point on Predicate.
  897%         - gspy(Predicate)
  898%           As spy using the graphical debugger.  See tspy/1.
  899%         - interactive(true)
  900%           Start the Prolog toplevel after main/1 completes.
  901
  902cli_parse_debug_options([], []).
  903cli_parse_debug_options([H|T0], Opts) :-
  904    debug_option(H),
  905    !,
  906    cli_parse_debug_options(T0, Opts).
  907cli_parse_debug_options([H|T0], [H|T]) :-
  908    cli_parse_debug_options(T0, T).
  909
  910debug_option(interactive(true)) :-
  911    asserta(interactive).
  912debug_option(debug(TopicS)) :-
  913    term_string(Topic, TopicS),
  914    debug(Topic).
  915debug_option(spy(Atom)) :-
  916    atom_pi(Atom, PI),
  917    spy(PI).
  918debug_option(gspy(Atom)) :-
  919    atom_pi(Atom, PI),
  920    tspy(PI).
  921
  922atom_pi(Atom, Module:PI) :-
  923    split(Atom, :, Module, PiAtom),
  924    !,
  925    atom_pi(PiAtom, PI).
  926atom_pi(Atom, Name//Arity) :-
  927    split(Atom, //, Name, Arity),
  928    !.
  929atom_pi(Atom, Name/Arity) :-
  930    split(Atom, /, Name, Arity),
  931    !.
  932atom_pi(Atom, _) :-
  933    format(user_error, 'Invalid predicate indicator: "~w"~n', [Atom]),
  934    halt(1).
  935
  936split(Atom, Sep, Before, After) :-
  937    sub_atom(Atom, BL, _, AL, Sep),
  938    !,
  939    sub_atom(Atom, 0, BL, _, Before),
  940    sub_atom(Atom, _, AL, 0, AfterAtom),
  941    (   atom_number(AfterAtom, After)
  942    ->  true
  943    ;   After = AfterAtom
  944    ).
  945
  946
  947%!  cli_enable_development_system
  948%
  949%   Re-enable the development environment. Currently  re-enables xpce if
  950%   this was loaded, but not  initialised   and  causes  the interactive
  951%   toplevel to be re-enabled.
  952%
  953%   This predicate may  be  called  from   main/1  to  enter  the Prolog
  954%   toplevel  rather  than  terminating  the  application  after  main/1
  955%   completes.
  956
  957cli_enable_development_system :-
  958    on_signal(int, _, debug),
  959    set_prolog_flag(xpce_threaded, true),
  960    set_prolog_flag(message_ide, true),
  961    (   current_prolog_flag(xpce_version, _)
  962    ->  use_module(library(pce_dispatch)),
  963        memberchk(Goal, [pce_dispatch([])]),
  964        call(Goal)
  965    ;   true
  966    ),
  967    set_prolog_flag(toplevel_goal, prolog).
  968
  969
  970		 /*******************************
  971		 *          IDE SUPPORT		*
  972		 *******************************/
  973
  974:- multifile
  975    prolog:called_by/2.  976
  977prolog:called_by(main, [main(_)]).
  978prolog:called_by(argv_options(_,_,_),
  979                 [ opt_type(_,_,_),
  980                   opt_help(_,_),
  981                   opt_meta(_,_)
  982                 ])