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