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      tty_width(Width),
  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
  709% Just  catch/3  is   enough,   but    dependency   tracking   in  e.g.,
  710% list_undefined/0 still considers this a missing dependency.
  711:- if(current_predicate(tty_size/2)).  712tty_width(Width) :-
  713     catch(tty_size(_, Width), _, Width = 80).
  714:- else.  715tty_width(80).
  716:- endif.  717
  718opt_usage(OptColW, HelpColW, opt(_Name, Type, Short, Long, Help, Meta)) -->
  719    options(Type, Short, Long, Meta),
  720    [ '~t~*:| '-[OptColW] ],
  721    help_text(Help, OptColW, HelpColW).
  722
  723help_text([First|Lines], Indent, _Width) -->
  724    !,
  725    [ '~w'-[First], nl ],
  726    sequence(rest_line(Indent), [nl], Lines).
  727help_text(Text, _Indent, Width) -->
  728    { string_length(Text, Len),
  729      Len =< Width
  730    },
  731    !,
  732    [ '~w'-[Text] ].
  733help_text(Text, Indent, Width) -->
  734    { wrap_text(Width, Text, [First|Lines])
  735    },
  736    [ '~w'-[First], nl ],
  737    sequence(rest_line(Indent), [nl], Lines).
  738
  739rest_line(Indent, Line) -->
  740    [ '~t~*| ~w'-[Indent, Line] ].
  741
  742%!  wrap_text(+Width, +Text, -Wrapped)
  743%
  744%   Simple text wrapper. Breaks Text into   words and creates lines with
  745%   minimally one word and as many  additional   words  as fit in Width.
  746%   Wrapped is a list of strings.
  747
  748wrap_text(Width, Text, Wrapped) :-
  749    split_string(Text, " \t\n", " \t\n", Words),
  750    wrap_lines(Words, Width, Wrapped).
  751
  752wrap_lines([], _, []).
  753wrap_lines([H|T0], Width, [Line|Lines]) :-
  754    !,
  755    string_length(H, Len),
  756    take_line(T0, T1, Width, Len, LineWords),
  757    atomics_to_string([H|LineWords], " ", Line),
  758    wrap_lines(T1, Width, Lines).
  759
  760take_line([H|T0], T, Width, Here, [H|Line]) :-
  761    string_length(H, Len),
  762    NewHere is Here+Len+1,
  763    NewHere =< Width,
  764    !,
  765    take_line(T0, T, Width, NewHere, Line).
  766take_line(T, T, _, _, []).
  767
  768%!  options(+Type, +ShortOpt, +LongOpts, +Meta)//
  769%
  770%   Emit a line with options.
  771
  772options(Type, ShortOpt, LongOpts, Meta) -->
  773    { append(ShortOpt, LongOpts, Opts) },
  774    sequence(option(Type, Meta), [', '-[]], Opts).
  775
  776option(boolean, _, Opt) -->
  777    opt(Opt).
  778option(_Type, [Meta], Opt) -->
  779    \+ { short_opt(Opt) },
  780    !,
  781    opt(Opt),
  782    [ '[='-[], ansi(var, '~w', [Meta]), ']'-[] ].
  783option(_Type, Meta, Opt) -->
  784    opt(Opt),
  785    (   { short_opt(Opt) }
  786    ->  [ ' '-[] ]
  787    ;   [ '='-[] ]
  788    ),
  789    [ ansi(var, '~w', [Meta]) ].
  790
  791%!  options_width(+Opt, -Width) is det.
  792%
  793%   Compute the width of the column we need for the options.
  794
  795options_width(opt(_Name, boolean, Short, Long, _Help, _Meta), W) =>
  796    length(Short, SCount),
  797    length(Long, LCount),
  798    maplist(atom_length, Long, LLens),
  799    sum_list(LLens, LLen),
  800    W is ((SCount+LCount)-1)*2 +               % ', ' seps
  801	 SCount*2 +
  802	 LCount*2 + LLen.
  803options_width(opt(_Name, _Type, Short, Long, _Help, Meta), W) =>
  804    length(Short, SCount),
  805    length(Long, LCount),
  806    (   Meta = [MName]
  807    ->  atom_length(MName, MLen0),
  808        MLen is MLen0+2
  809    ;   atom_length(Meta, MLen)
  810    ),
  811    maplist(atom_length, Long, LLens),
  812    sum_list(LLens, LLen),
  813    W is ((SCount+LCount)-1)*2 +               % ', ' seps
  814	 SCount*3 + SCount*MLen +
  815	 LCount*3 + LLen + LCount*MLen.
  816
  817%!  get_option(+Module, -Opt) is multi.
  818%
  819%   Get a description for a single option.  Opt is a term
  820%
  821%       opt(Name, Type, ShortFlags, Longflags, Help, Meta).
  822
  823get_option(M, opt(help, boolean, [h,?], [help],
  824		  Help, -)) :-
  825    \+ in(M:opt_type(_, help, boolean)),       % user defined help
  826    (   in(M:opt_help(help, Help))
  827    ->  true
  828    ;   Help = "Show this help message and exit"
  829    ).
  830get_option(M, opt(Name, TypeName, Short, Long, Help, Meta)) :-
  831    findall(Name, in(M:opt_type(_, Name, _)), Names),
  832    list_to_set(Names, UNames),
  833    member(Name, UNames),
  834    findall(Opt-Type,
  835	    in(M:opt_type(Opt, Name, Type)),
  836	    Pairs),
  837    option_type(Name, Pairs, TypeT),
  838    functor(TypeT, TypeName, _),
  839    pairs_keys(Pairs, Opts),
  840    partition(short_opt, Opts, Short, Long),
  841    (   in(M:opt_help(Name, Help))
  842    ->  true
  843    ;   Help = ''
  844    ),
  845    (   in(M:opt_meta(Name, Meta0))
  846    ->  true
  847    ;   upcase_atom(TypeName, Meta0)
  848    ),
  849    (   \+ type_bool(TypeT, _),
  850        type_optional_bool(TypeT, _)
  851    ->  Meta = [Meta0]
  852    ;   Meta = Meta0
  853    ).
  854
  855option_type(Name, Pairs, Type) :-
  856    pairs_values(Pairs, Types),
  857    sort(Types, [Type|UTypes]),
  858    (   UTypes = []
  859    ->  true
  860    ;   print_message(warning,
  861		      error(opt_error(multiple_types(Name, [Type|UTypes])),_))
  862    ).
  863
  864%!  in(:Goal)
  865%
  866%   As call/1, but  fails  silently  if   there  is  no  predicate  that
  867%   implements Goal.
  868
  869in(Goal) :-
  870    pi_head(PI, Goal),
  871    current_predicate(PI),
  872    call(Goal).
  873
  874short_opt(Opt) :-
  875    atom_length(Opt, 1).
  876
  877		 /*******************************
  878		 *      OPT ERROR HANDLING	*
  879		 *******************************/
  880
  881%!  opt_error(+Error)
  882%
  883%   @error opt_error(Term)
  884
  885opt_error(Error) :-
  886    throw(error(opt_error(Error), _)).
  887
  888:- multifile
  889    prolog:error_message//1.  890
  891prolog:error_message(opt_error(Error)) -->
  892    opt_error(Error).
  893
  894opt_error(unknown_option(M:Opt)) -->
  895    [ 'Unknown option: '-[] ],
  896    opt(Opt),
  897    hint_help(M).
  898opt_error(missing_value(Opt, Type)) -->
  899    [ 'Option '-[] ],
  900    opt(Opt),
  901    [ ' requires an argument (of type ~p)'-[Type] ].
  902opt_error(value_type(Opt, Type, Found)) -->
  903    [ 'Option '-[] ],
  904    opt(Opt), [' requires'],
  905    type(Type),
  906    [ ' (found '-[], ansi(code, '~w', [Found]), ')'-[] ].
  907opt_error(access_file(File, exist)) -->
  908    [ 'File '-[], ansi(code, '~w', [File]),
  909      ' does not exist'-[]
  910    ].
  911opt_error(access_file(File, Access)) -->
  912    { access_verb(Access, Verb) },
  913    [ 'Cannot access file '-[], ansi(code, '~w', [File]),
  914      ' for '-[], ansi(code, '~w', [Verb])
  915    ].
  916
  917access_verb(read,    reading).
  918access_verb(write,   writing).
  919access_verb(append,  writing).
  920access_verb(execute, executing).
  921
  922hint_help(M) -->
  923    { in(M:opt_type(Opt, help, boolean)) },
  924    !,
  925    [ ' (' ], opt(Opt), [' for help)'].
  926hint_help(_) -->
  927    [ ' (-h for help)'-[] ].
  928
  929opt(Opt) -->
  930    { short_opt(Opt) },
  931    !,
  932    [ ansi(bold, '-~w', [Opt]) ].
  933opt(Opt) -->
  934    [ ansi(bold, '--~w', [Opt]) ].
  935
  936type(A|B) -->
  937    type(A), [' or'],
  938    type(B).
  939type(oneof([One])) -->
  940    !,
  941    [ ' ' ],
  942    atom(One).
  943type(oneof(List)) -->
  944    !,
  945    [ ' one of '-[] ],
  946    sequence(atom, [', '], List).
  947type(between(Low, High)) -->
  948    !,
  949    [ ' a number '-[],
  950      ansi(code, '~w', [Low]), '..', ansi(code, '~w', [High])
  951    ].
  952type(nonneg) -->
  953    [ ' a non-negative integer'-[] ].
  954type(natural) -->
  955    [ ' a positive integer (>= 1)'-[] ].
  956type(file(Access)) -->
  957    [ ' a file with ~w access'-[Access] ].
  958type(Type) -->
  959    [ ' an argument of type '-[], ansi(code, '~w', [Type]) ].
  960
  961atom(A) -->
  962    [ ansi(code, '~w', [A]) ].
  963
  964
  965		 /*******************************
  966		 *         DEBUG SUPPORT	*
  967		 *******************************/
  968
  969%!	cli_parse_debug_options(+OptionsIn, -Options) is det.
  970%
  971%       Parse certain commandline options for  debugging and development
  972%       purposes. Options processed are  below.   Note  that  the option
  973%       argument is an atom such that these  options may be activated as
  974%       e.g., ``--debug='http(_)'``.
  975%
  976%         - debug(Topic)
  977%           Call debug(Topic).  See debug/1 and debug/3.
  978%         - spy(Predicate)
  979%           Place a spy-point on Predicate.
  980%         - gspy(Predicate)
  981%           As spy using the graphical debugger.  See tspy/1.
  982%         - interactive(true)
  983%           Start the Prolog toplevel after main/1 completes.
  984
  985cli_parse_debug_options([], []).
  986cli_parse_debug_options([H|T0], Opts) :-
  987    debug_option(H),
  988    !,
  989    cli_parse_debug_options(T0, Opts).
  990cli_parse_debug_options([H|T0], [H|T]) :-
  991    cli_parse_debug_options(T0, T).
  992
  993%!  cli_debug_opt_type(-Flag, -Option, -Type).
  994%!  cli_debug_opt_help(-Option, -Message).
  995%!  cli_debug_opt_meta(-Option, -Arg).
  996%
  997%   Implements  opt_type/3,  opt_help/2   and    opt_meta/2   for  debug
  998%   arguments. Applications that wish to  use   these  features can call
  999%   these predicates from their own hook.  Fot example:
 1000%
 1001%   ```
 1002%   opt_type(..., ..., ...).	% application types
 1003%   opt_type(Flag, Opt, Type) :-
 1004%       cli_debug_opt_type(Flag, Opt, Type).
 1005%   % similar for opt_help/2 and opt_meta/2
 1006%
 1007%   main(Argv) :-
 1008%       argv_options(Argv, Positional, Options0),
 1009%       cli_parse_debug_options(Options0, Options),
 1010%       ...
 1011%   ```
 1012
 1013cli_debug_opt_type(debug,       debug,       string).
 1014cli_debug_opt_type(spy,         spy,         string).
 1015cli_debug_opt_type(gspy,        gspy,        string).
 1016cli_debug_opt_type(interactive, interactive, boolean).
 1017
 1018cli_debug_opt_help(debug,
 1019                   "Call debug(Topic).  See debug/1 and debug/3. \c
 1020                    Multiple topics may be separated by : or ;").
 1021cli_debug_opt_help(spy,
 1022                   "Place a spy-point on Predicate. \c
 1023                    Multiple topics may be separated by : or ;").
 1024cli_debug_opt_help(gspy,
 1025                   "As --spy using the graphical debugger.  See tspy/1 \c
 1026                    Multiple topics may be separated by `;`").
 1027cli_debug_opt_help(interactive,
 1028                   "Start the Prolog toplevel after main/1 completes.").
 1029
 1030cli_debug_opt_meta(debug, 'TOPICS').
 1031cli_debug_opt_meta(spy,   'PREDICATES').
 1032cli_debug_opt_meta(gspy,  'PREDICATES').
 1033
 1034:- meta_predicate
 1035    spy_from_string(1, +). 1036
 1037debug_option(interactive(true)) :-
 1038    asserta(interactive).
 1039debug_option(debug(Spec)) :-
 1040    split_string(Spec, ";", "", Specs),
 1041    maplist(debug_from_string, Specs).
 1042debug_option(spy(Spec)) :-
 1043    split_string(Spec, ";", "", Specs),
 1044    maplist(spy_from_string(spy), Specs).
 1045debug_option(gspy(Spec)) :-
 1046    split_string(Spec, ";", "", Specs),
 1047    maplist(spy_from_string(cli_gspy), Specs).
 1048
 1049debug_from_string(TopicS) :-
 1050    term_string(Topic, TopicS),
 1051    debug(Topic).
 1052
 1053spy_from_string(Pred, Spec) :-
 1054    atom_pi(Spec, PI),
 1055    call(Pred, PI).
 1056
 1057cli_gspy(PI) :-
 1058    (   exists_source(library(threadutil))
 1059    ->  use_module(library(threadutil), [tspy/1]),
 1060	Goal = tspy(PI)
 1061    ;   exists_source(library(gui_tracer))
 1062    ->  use_module(library(gui_tracer), [gspy/1]),
 1063	Goal = gspy(PI)
 1064    ;   Goal = spy(PI)
 1065    ),
 1066    call(Goal).
 1067
 1068atom_pi(Atom, Module:PI) :-
 1069    split(Atom, :, Module, PiAtom),
 1070    !,
 1071    atom_pi(PiAtom, PI).
 1072atom_pi(Atom, Name//Arity) :-
 1073    split(Atom, //, Name, Arity),
 1074    !.
 1075atom_pi(Atom, Name/Arity) :-
 1076    split(Atom, /, Name, Arity),
 1077    !.
 1078atom_pi(Atom, _) :-
 1079    format(user_error, 'Invalid predicate indicator: "~w"~n', [Atom]),
 1080    halt(1).
 1081
 1082split(Atom, Sep, Before, After) :-
 1083    sub_atom(Atom, BL, _, AL, Sep),
 1084    !,
 1085    sub_atom(Atom, 0, BL, _, Before),
 1086    sub_atom(Atom, _, AL, 0, AfterAtom),
 1087    (   atom_number(AfterAtom, After)
 1088    ->  true
 1089    ;   After = AfterAtom
 1090    ).
 1091
 1092
 1093%!  cli_enable_development_system
 1094%
 1095%   Re-enable the development environment. Currently  re-enables xpce if
 1096%   this was loaded, but not  initialised   and  causes  the interactive
 1097%   toplevel to be re-enabled.
 1098%
 1099%   This predicate may  be  called  from   main/1  to  enter  the Prolog
 1100%   toplevel  rather  than  terminating  the  application  after  main/1
 1101%   completes.
 1102
 1103cli_enable_development_system :-
 1104    on_signal(int, _, debug),
 1105    set_prolog_flag(xpce_threaded, true),
 1106    set_prolog_flag(message_ide, true),
 1107    (   current_prolog_flag(xpce_version, _)
 1108    ->  use_module(library(pce_dispatch)),
 1109	memberchk(Goal, [pce_dispatch([])]),
 1110	call(Goal)
 1111    ;   true
 1112    ),
 1113    set_prolog_flag(toplevel_goal, prolog).
 1114
 1115
 1116		 /*******************************
 1117		 *          IDE SUPPORT		*
 1118		 *******************************/
 1119
 1120:- multifile
 1121    prolog:called_by/2. 1122
 1123prolog:called_by(main, [main(_)]).
 1124prolog:called_by(argv_options(_,_,_),
 1125		 [ opt_type(_,_,_),
 1126		   opt_help(_,_),
 1127		   opt_meta(_,_)
 1128		 ])