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