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