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