36
   37:- module(prolog_main,
   38	  [ main/0,
   39	    argv_options/3,                40	    argv_options/4,                41	    argv_usage/1,                  42	    cli_parse_debug_options/2,     43            cli_debug_opt_type/3,          44            cli_debug_opt_help/2,          45            cli_debug_opt_meta/2,          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),
   51            [append/3, max_list/2, sum_list/2, list_to_set/2, member/2]).   52:- autoload(library(pairs), [pairs_keys/2, pairs_values/2]).   53:- autoload(library(prolog_code), [pi_head/2]).   54:- autoload(library(prolog_debug), [spy/1]).   55:- autoload(library(dcg/high_order), [sequence//3, sequence//2]).   56:- autoload(library(option), [option/2, option/3]).   57:- if(exists_source(library(doc_markdown))).   58:- autoload(library(doc_markdown), [print_markdown/2]).   59:- endif.   60
   61:- meta_predicate
   62    argv_options(:, -, -),
   63    argv_options(:, -, -, +),
   64    argv_usage(:).   65
   66:- dynamic
   67    interactive/0.   68
   97
   98:- module_transparent
   99    main/0.  100
  115
  116main :-
  117    current_prolog_flag(break_level, _),
  118    !,
  119    current_prolog_flag(argv, Av),
  120    context_module(M),
  121    M:main(Av).
  122main :-
  123    context_module(M),
  124    set_signals,
  125    current_prolog_flag(argv, Av),
  126    catch_with_backtrace(M:main(Av), Error, throw(Error)),
  127    (   interactive
  128    ->  cli_enable_development_system
  129    ;   true
  130    ).
  131
  132set_signals :-
  133    on_signal(int, _, interrupt).
  134
  139
  140interrupt(_Sig) :-
  141    halt(1).
  142
  143		   146
  246
  247argv_options(M:Argv, Positional, Options) :-
  248    in(M:opt_type(_,_,_)),
  249    !,
  250    argv_options(M:Argv, Positional, Options, [on_error(halt(1))]).
  251argv_options(_:Argv, Positional, Options) :-
  252    argv_untyped_options(Argv, Positional, Options).
  253
  278
  279argv_options(Argv, Positional, Options, POptions) :-
  280    option(on_error(halt(Code)), POptions),
  281    !,
  282    E = error(_,_),
  283    catch(opt_parse(Argv, Positional, Options, POptions), E,
  284	  ( print_message(error, E),
  285	    halt(Code)
  286	  )).
  287argv_options(Argv, Positional, Options, POptions) :-
  288    opt_parse(Argv, Positional, Options, POptions).
  289
  297
  298argv_untyped_options([], Pos, Opts) =>
  299    Pos = [], Opts = [].
  300argv_untyped_options([--|R], Pos, Ops) =>
  301    Pos = R, Ops = [].
  302argv_untyped_options([H0|T0], R, Ops), sub_atom(H0, 0, _, _, --) =>
  303    Ops = [H|T],
  304    (   sub_atom(H0, B, _, A, =)
  305    ->  B2 is B-2,
  306	sub_atom(H0, 2, B2, _, Name),
  307	sub_string(H0, _, A,  0, Value0),
  308	convert_option(Name, Value0, Value)
  309    ;   sub_atom(H0, 2, _, 0, Name0),
  310	(   sub_atom(Name0, 0, _, _, 'no-')
  311	->  sub_atom(Name0, 3, _, 0, Name),
  312	    Value = false
  313	;   Name = Name0,
  314	    Value = true
  315	)
  316    ),
  317    canonical_name(Name, PlName),
  318    H =.. [PlName,Value],
  319    argv_untyped_options(T0, R, T).
  320argv_untyped_options([H|T0], Ops, T) =>
  321    Ops = [H|R],
  322    argv_untyped_options(T0, R, T).
  323
  324convert_option(password, String, String) :- !.
  325convert_option(_, String, Number) :-
  326    number_string(Number, String),
  327    !.
  328convert_option(_, String, Atom) :-
  329    atom_string(Atom, String).
  330
  331canonical_name(Name, PlName) :-
  332    split_string(Name, "-_", "", Parts),
  333    atomic_list_concat(Parts, '_', PlName).
  334
  344
  345opt_parse(M:Argv, _Positional, _Options, _POptions) :-
  346    opt_needs_help(M:Argv),
  347    !,
  348    argv_usage(M:debug),
  349    halt(0).
  350opt_parse(M:Argv, Positional, Options, POptions) :-
  351    opt_parse(Argv, Positional, Options, M, POptions).
  352
  353opt_needs_help(M:[Arg]) :-
  354    in(M:opt_type(_, help, boolean)),
  355    !,
  356    in(M:opt_type(Opt, help, boolean)),
  357    (   short_opt(Opt)
  358    ->  atom_concat(-, Opt, Arg)
  359    ;   atom_concat(--, Opt, Arg)
  360    ),
  361    !.
  362opt_needs_help(_:['-h']).
  363opt_needs_help(_:['-?']).
  364opt_needs_help(_:['--help']).
  365
  366opt_parse([], Positional, Options, _, _) =>
  367    Positional = [],
  368    Options = [].
  369opt_parse([--|T], Positional, Options, _, _) =>
  370    Positional = T,
  371    Options = [].
  372opt_parse([H|T], Positional, Options, M, POptions), atom_concat(--, Long, H) =>
  373    take_long(Long, T, Positional, Options, M, POptions).
  374opt_parse([H|T], Positional, Options, M, POptions),
  375    H \== '-',
  376    string_concat(-, Opts, H) =>
  377    string_chars(Opts, Shorts),
  378    take_shorts(Shorts, T, Positional, Options, M, POptions).
  379opt_parse(Argv, Positional, Options, _M, POptions),
  380    option(options_after_arguments(false), POptions) =>
  381    Positional = Argv,
  382    Options = [].
  383opt_parse([H|T], Positional, Options, M, POptions) =>
  384    Positional = [H|PT],
  385    opt_parse(T, PT, Options, M, POptions).
  386
  387
  389
  390take_long(Long, T, Positional, Options, M, POptions) :-   391    sub_atom(Long, B, _, A, =),
  392    !,
  393    sub_atom(Long, 0, B, _, LName0),
  394    sub_atom(Long, _, A, 0, VAtom),
  395    canonical_name(LName0, LName),
  396    (   in(M:opt_type(LName, Name, Type))
  397    ->  opt_value(Type, Long, VAtom, Value),
  398	Opt =.. [Name,Value],
  399	Options = [Opt|OptionsT],
  400	opt_parse(T, Positional, OptionsT, M, POptions)
  401    ;   option(unknown_option(pass), POptions, error)
  402    ->  atom_concat(--, Long, Opt),
  403        Positional = [Opt|PositionalT],
  404        opt_parse(T, PositionalT, Options, M, POptions)
  405    ;   opt_error(unknown_option(M:LName0))
  406    ).
  407take_long(LName0, T, Positional, Options, M, POptions) :-   408    canonical_name(LName0, LName),
  409    take_long_(LName, T, Positional, Options, M, POptions).
  410
  411take_long_(Long, T, Positional, Options, M, POptions) :-   412    opt_bool_type(Long, Name, Value, M),                   413    !,
  414    Opt =.. [Name,Value],
  415    Options = [Opt|OptionsT],
  416    opt_parse(T, Positional, OptionsT, M, POptions).
  417take_long_(Long, T, Positional, Options, M, POptions) :-   418    (   atom_concat('no_', LName, Long)
  419    ;   atom_concat('no', LName, Long)
  420    ),
  421    in(M:opt_type(LName, Name, Type)),
  422    type_optional_bool(Type, Value0),
  423    !,
  424    negate(Value0, Value),
  425    Opt =.. [Name,Value],
  426    Options = [Opt|OptionsT],
  427    opt_parse(T, Positional, OptionsT, M, POptions).
  428take_long_(Long, T, Positional, Options, M, POptions) :-   429    in(M:opt_type(Long, Name, Type)),
  430    type_optional_bool(Type, Value),
  431    !,
  432    Opt =.. [Name,Value],
  433    Options = [Opt|OptionsT],
  434    opt_parse(T, Positional, OptionsT, M, POptions).
  435take_long_(Long, T, Positional, Options, M, POptions) :-   436    in(M:opt_type(Long, Name, Type)),
  437    !,
  438    (   T = [VAtom|T1]
  439    ->  opt_value(Type, Long, VAtom, Value),
  440	Opt =.. [Name,Value],
  441	Options = [Opt|OptionsT],
  442	opt_parse(T1, Positional, OptionsT, M, POptions)
  443    ;   opt_error(missing_value(Long, Type))
  444    ).
  445take_long_(Long,  T, Positional, Options, M, POptions) :-
  446    option(unknown_option(pass), POptions, error),
  447    !,
  448    atom_concat(--, Long, Opt),
  449    Positional = [Opt|PositionalT],
  450    opt_parse(T, PositionalT, Options, M, POptions).
  451take_long_(Long, _, _, _, M, _) :-
  452    opt_error(unknown_option(M:Long)).
  453
  455
  456take_shorts(OptChars, Argv, Positional, Options, M, POptions) :-
  457    take_shorts_(OptChars, OptLeft, Argv, Positional0, Options, M, POptions),
  458    (   OptLeft == []
  459    ->  Positional = Positional0
  460    ;   atom_chars(Pass, [-|OptLeft]),
  461        Positional = [Pass|Positional0]
  462    ).
  463
  464take_shorts_([], [], T, Positional, Options, M, POptions) :-
  465    opt_parse(T, Positional, Options, M, POptions).
  466take_shorts_([H|T], Pass, Argv, Positional, Options, M, POptions) :-
  467    opt_bool_type(H, Name, Value, M),
  468    !,
  469    Opt =.. [Name,Value],
  470    Options = [Opt|OptionsT],
  471    take_shorts_(T, Pass, Argv, Positional, OptionsT, M, POptions).
  472take_shorts_([H|T], Pass, Argv, Positional, Options, M, POptions) :-
  473    in(M:opt_type(H, Name, Type)),
  474    !,
  475    (   T == []
  476    ->  (   Argv = [VAtom|ArgvT]
  477	->  opt_value(Type, H, VAtom, Value),
  478	    Opt =.. [Name,Value],
  479	    Options = [Opt|OptionsT],
  480	    take_shorts_(T, Pass, ArgvT, Positional, OptionsT, M, POptions)
  481	;   opt_error(missing_value(H, Type))
  482	)
  483    ;   atom_chars(VAtom, T),
  484	opt_value(Type, H, VAtom, Value),
  485	Opt =.. [Name,Value],
  486	Options = [Opt|OptionsT],
  487	take_shorts_([], Pass, Argv, Positional, OptionsT, M, POptions)
  488    ).
  489take_shorts_([H|T], [H|Pass], Argv, Positional, Options, M, POptions) :-
  490    option(unknown_option(pass), POptions, error), !,
  491    take_shorts_(T, Pass, Argv, Positional, Options, M, POptions).
  492take_shorts_([H|_], _, _, _, _, M, _) :-
  493    opt_error(unknown_option(M:H)).
  494
  495opt_bool_type(Opt, Name, Value, M) :-
  496    in(M:opt_type(Opt, Name, Type)),
  497    type_bool(Type, Value).
  498
  499type_bool(Type, Value) :-
  500    (   Type == boolean
  501    ->  Value = true
  502    ;   Type = boolean(Value)
  503    ).
  504
  505type_optional_bool((A|B), Value) =>
  506    (   type_optional_bool(A, Value)
  507    ->  true
  508    ;   type_optional_bool(B, Value)
  509    ).
  510type_optional_bool(Type, Value) =>
  511    type_bool(Type, Value).
  512
  513negate(true, false).
  514negate(false, true).
  515
  519
  520opt_value(Type, _Opt, VAtom, Value) :-
  521    opt_convert(Type, VAtom, Value),
  522    !.
  523opt_value(Type, Opt, VAtom, _) :-
  524    opt_error(value_type(Opt, Type, VAtom)).
  525
  527
  528opt_convert(A|B, Spec, Value) :-
  529    (   opt_convert(A, Spec, Value)
  530    ->  true
  531    ;   opt_convert(B, Spec, Value)
  532    ).
  533opt_convert(boolean, Spec, Value) :-
  534    to_bool(Spec, Value).
  535opt_convert(boolean(_), Spec, Value) :-
  536    to_bool(Spec, Value).
  537opt_convert(number, Spec, Value) :-
  538    atom_number(Spec, Value).
  539opt_convert(integer, Spec, Value) :-
  540    atom_number(Spec, Value),
  541    integer(Value).
  542opt_convert(float, Spec, Value) :-
  543    atom_number(Spec, Value0),
  544    Value is float(Value0).
  545opt_convert(nonneg, Spec, Value) :-
  546    atom_number(Spec, Value),
  547    integer(Value),
  548    Value >= 0.
  549opt_convert(natural, Spec, Value) :-
  550    atom_number(Spec, Value),
  551    integer(Value),
  552    Value >= 1.
  553opt_convert(between(Low, High), Spec, Value) :-
  554    atom_number(Spec, Value0),
  555    (   ( float(Low) ; float(High) )
  556    ->  Value is float(Value0)
  557    ;   integer(Value0),
  558	Value = Value0
  559    ),
  560    Value >= Low, Value =< High.
  561opt_convert(atom, Value, Value).
  562opt_convert(oneof(List), Value, Value) :-
  563    memberchk(Value, List).
  564opt_convert(string, Value0, Value) :-
  565    atom_string(Value0, Value).
  566opt_convert(file, Spec, Value) :-
  567    prolog_to_os_filename(Value, Spec).
  568opt_convert(file(Access), Spec, Value) :-
  569    (   Spec == '-'
  570    ->  Value = '-'
  571    ;   prolog_to_os_filename(Value, Spec),
  572	(   access_file(Value, Access)
  573	->  true
  574	;   opt_error(access_file(Spec, Access))
  575	)
  576    ).
  577opt_convert(directory, Spec, Value) :-
  578    prolog_to_os_filename(Value, Spec).
  579opt_convert(directory(Access), Spec, Value) :-
  580    prolog_to_os_filename(Value, Spec),
  581    access_directory(Value, Access).
  582opt_convert(term, Spec, Value) :-
  583    term_string(Value, Spec, []).
  584opt_convert(term(Options), Spec, Value) :-
  585    term_string(Term, Spec, Options),
  586    (   option(variable_names(Bindings), Options)
  587    ->  Value = Term-Bindings
  588    ;   Value = Term
  589    ).
  590
  591access_directory(Dir, read) =>
  592    exists_directory(Dir),
  593    access_file(Dir, read).
  594access_directory(Dir, write) =>
  595    exists_directory(Dir),
  596    access_file(Dir, write).
  597access_directory(Dir, create) =>
  598    (   exists_directory(Dir)
  599    ->  access_file(Dir, write)
  600    ;   \+ exists_file(Dir),
  601        file_directory_name(Dir, Parent),
  602        exists_directory(Parent),
  603        access_file(Parent, write)
  604    ).
  605
  606to_bool(true,    true).
  607to_bool('True',  true).
  608to_bool('TRUE',  true).
  609to_bool(on,      true).
  610to_bool('On',    true).
  611to_bool(yes,     true).
  612to_bool('Yes',   true).
  613to_bool('1',     true).
  614to_bool(false,   false).
  615to_bool('False', false).
  616to_bool('FALSE', false).
  617to_bool(off,     false).
  618to_bool('Off',   false).
  619to_bool(no,      false).
  620to_bool('No',    false).
  621to_bool('0',     false).
  622
  649
  650argv_usage(M:Level) :-
  651    print_message(Level, opt_usage(M)).
  652
  653:- multifile
  654    prolog:message//1.  655
  656prolog:message(opt_usage(M)) -->
  657    usage(M).
  658
  659usage(M) -->
  660    usage_text(M:header),
  661    usage_line(M),
  662    usage_text(M:description),
  663    usage_options(M),
  664    usage_text(M:footer).
  665
  670
  671usage_text(M:Which) -->
  672    { in(M:opt_help(help(Which), Help))
  673    },
  674    !,
  675    (   {Which == header ; Which == description}
  676    ->  user_text(M:Help), [nl, nl]
  677    ;   [nl, nl], user_text(M:Help)
  678    ).
  679usage_text(_) -->
  680    [].
  681
  682user_text(M:Entries) -->
  683    { is_list(Entries) },
  684    !,
  685    sequence(help_elem(M), Entries).
  686:- if(current_predicate(print_markdown/2)).  687user_text(_:md(Help)) -->
  688    !,
  689    { with_output_to(string(String),
  690                     ( current_output(S),
  691                       set_stream(S, tty(true)),
  692                       print_markdown(Help, []))) },
  693    [ '~s'-[String] ].
  694:- else.  695user_text(_:md(Help)) -->
  696    !,
  697    [ '~w'-[Help] ].
  698:- endif.  699user_text(_:Help) -->
  700    [ '~w'-[Help] ].
  701
  702help_elem(M, \Callable) -->
  703    { callable(Callable) },
  704    call(M:Callable),
  705    !.
  706help_elem(_M, Elem) -->
  707    [ Elem ].
  708
  709usage_line(M) -->
  710    { findall(Help, in(M:opt_help(help(usage), Help)), HelpLines)
  711    },
  712    [ ansi(comment, 'Usage: ', []) ],
  713    (   {HelpLines == []}
  714    ->  cmdline(M), [ ' [options]'-[] ]
  715    ;   sequence(usage_line(M), [nl], HelpLines)
  716    ),
  717    [ nl, nl ].
  718
  719usage_line(M, Help) -->
  720    [ '~t~8|'-[] ],
  721    cmdline(M),
  722    user_text(M:Help).
  723
  724cmdline(_M) -->
  725    { current_prolog_flag(app_name, App),
  726      !,
  727      current_prolog_flag(os_argv, [Argv0|_])
  728    },
  729    cmdarg(Argv0), [' '-[], ansi(bold, '~w', [App])].
  730cmdline(_M) -->
  731    { current_prolog_flag(associated_file, AbsFile),
  732      file_base_name(AbsFile, Base),
  733      current_prolog_flag(os_argv, Argv),
  734      append(Pre, [File|_], Argv),
  735      file_base_name(File, Base),
  736      append(Pre, [File], Cmd),
  737      !
  738    },
  739    sequence(cmdarg, [' '-[]], Cmd).
  740cmdline(_M) -->
  741    { current_prolog_flag(saved_program, true),
  742      current_prolog_flag(os_argv, OsArgv),
  743      append(_, ['-x', State|_], OsArgv),
  744      !
  745    },
  746    cmdarg(State).
  747cmdline(_M) -->
  748    { current_prolog_flag(os_argv, [Argv0|_])
  749    },
  750    cmdarg(Argv0).
  751
  752cmdarg(A) -->
  753    [ '~w'-[A] ].
  754
  760
  761usage_options(M) -->
  762    { findall(Opt, get_option(M, Opt), Opts),
  763      maplist(options_width, Opts, OptWidths),
  764      max_list(OptWidths, MaxOptWidth),
  765      tty_width(Width),
  766      OptColW is min(MaxOptWidth, 30),
  767      HelpColW is Width-4-OptColW
  768    },
  769    [ ansi(comment, 'Options:', []), nl ],
  770    sequence(opt_usage(OptColW, HelpColW), [nl], Opts).
  771
  774:- if(current_predicate(tty_size/2)).  775tty_width(Width) :-
  776     catch(tty_size(_, Width), _, Width = 80).
  777:- else.  778tty_width(80).
  779:- endif.  780
  781opt_usage(OptColW, HelpColW, opt(_Name, Type, Short, Long, Help, Meta)) -->
  782    options(Type, Short, Long, Meta),
  783    [ '~t~*:| '-[OptColW] ],
  784    help_text(Help, OptColW, HelpColW).
  785
  786help_text([First|Lines], Indent, _Width) -->
  787    !,
  788    [ '~w'-[First], nl ],
  789    sequence(rest_line(Indent), [nl], Lines).
  790help_text(Text, _Indent, Width) -->
  791    { string_length(Text, Len),
  792      Len =< Width
  793    },
  794    !,
  795    [ '~w'-[Text] ].
  796help_text(Text, Indent, Width) -->
  797    { wrap_text(Width, Text, [First|Lines])
  798    },
  799    [ '~w'-[First], nl ],
  800    sequence(rest_line(Indent), [nl], Lines).
  801
  802rest_line(Indent, Line) -->
  803    [ '~t~*| ~w'-[Indent, Line] ].
  804
  810
  811wrap_text(Width, Text, Wrapped) :-
  812    split_string(Text, " \t\n", " \t\n", Words),
  813    wrap_lines(Words, Width, Wrapped).
  814
  815wrap_lines([], _, []).
  816wrap_lines([H|T0], Width, [Line|Lines]) :-
  817    !,
  818    string_length(H, Len),
  819    take_line(T0, T1, Width, Len, LineWords),
  820    atomics_to_string([H|LineWords], " ", Line),
  821    wrap_lines(T1, Width, Lines).
  822
  823take_line([H|T0], T, Width, Here, [H|Line]) :-
  824    string_length(H, Len),
  825    NewHere is Here+Len+1,
  826    NewHere =< Width,
  827    !,
  828    take_line(T0, T, Width, NewHere, Line).
  829take_line(T, T, _, _, []).
  830
  834
  835options(Type, ShortOpt, LongOpts, Meta) -->
  836    { append(ShortOpt, LongOpts, Opts) },
  837    sequence(option(Type, Meta), [', '-[]], Opts).
  838
  839option(boolean, _, Opt) -->
  840    opt(Opt),
  841    !.
  842option(_Type, [Meta], Opt) -->
  843    \+ { short_opt(Opt) },
  844    !,
  845    opt(Opt),
  846    [ '[='-[], ansi(var, '~w', [Meta]), ']'-[] ].
  847option(_Type, Meta, Opt) -->
  848    opt(Opt),
  849    (   { short_opt(Opt) }
  850    ->  [ ' '-[] ]
  851    ;   [ '='-[] ]
  852    ),
  853    [ ansi(var, '~w', [Meta]) ].
  854
  858
  859options_width(opt(_Name, boolean, Short, Long, _Help, _Meta), W) =>
  860    length(Short, SCount),
  861    length(Long, LCount),
  862    maplist(atom_length, Long, LLens),
  863    sum_list(LLens, LLen),
  864    W is ((SCount+LCount)-1)*2 +                 865	 SCount*2 +
  866	 LCount*2 + LLen.
  867options_width(opt(_Name, _Type, Short, Long, _Help, Meta), W) =>
  868    length(Short, SCount),
  869    length(Long, LCount),
  870    (   Meta = [MName]
  871    ->  atom_length(MName, MLen0),
  872        MLen is MLen0+2
  873    ;   atom_length(Meta, MLen)
  874    ),
  875    maplist(atom_length, Long, LLens),
  876    sum_list(LLens, LLen),
  877    W is ((SCount+LCount)-1)*2 +                 878	 SCount*3 + SCount*MLen +
  879	 LCount*3 + LLen + LCount*MLen.
  880
  886
  887get_option(M, opt(help, boolean, [h,?], [help],
  888		  Help, -)) :-
  889    \+ in(M:opt_type(_, help, boolean)),         890    (   in(M:opt_help(help, Help))
  891    ->  true
  892    ;   Help = "Show this help message and exit"
  893    ).
  894get_option(M, opt(Name, TypeName, Short, Long, Help, Meta)) :-
  895    findall(Name, in(M:opt_type(_, Name, _)), Names),
  896    list_to_set(Names, UNames),
  897    member(Name, UNames),
  898    findall(Opt-Type,
  899	    in(M:opt_type(Opt, Name, Type)),
  900	    Pairs),
  901    option_type(Name, Pairs, TypeT),
  902    functor(TypeT, TypeName, _),
  903    pairs_keys(Pairs, Opts),
  904    partition(short_opt, Opts, Short, Long),
  905    (   in(M:opt_help(Name, Help))
  906    ->  true
  907    ;   Help = ''
  908    ),
  909    (   in(M:opt_meta(Name, Meta0))
  910    ->  true
  911    ;   type_name(TypeT, Meta0)
  912    ->  true
  913    ;   upcase_atom(TypeName, Meta0)
  914    ),
  915    (   \+ type_bool(TypeT, _),
  916        type_optional_bool(TypeT, _)
  917    ->  Meta = [Meta0]
  918    ;   Meta = Meta0
  919    ).
  920
  921type_name(oneof(Values), Name) :-
  922    atomics_to_string(Values, ",", S0),
  923    format(atom(Name), '{~w}', [S0]).
  924
  925option_type(Name, Pairs, Type) :-
  926    pairs_values(Pairs, Types),
  927    sort(Types, [Type|UTypes]),
  928    (   UTypes = []
  929    ->  true
  930    ;   print_message(warning,
  931		      error(opt_error(multiple_types(Name, [Type|UTypes])),_))
  932    ).
  933
  938
  939in(Goal) :-
  940    pi_head(PI, Goal),
  941    current_predicate(PI),
  942    call(Goal).
  943
  944short_opt(Opt) :-
  945    atom_length(Opt, 1).
  946
  947		   950
  954
  955opt_error(Error) :-
  956    throw(error(opt_error(Error), _)).
  957
  958:- multifile
  959    prolog:error_message//1.  960
  961prolog:error_message(opt_error(Error)) -->
  962    opt_error(Error).
  963
  964opt_error(unknown_option(M:Opt)) -->
  965    [ 'Unknown option: '-[] ],
  966    opt(Opt),
  967    hint_help(M).
  968opt_error(missing_value(Opt, Type)) -->
  969    [ 'Option '-[] ],
  970    opt(Opt),
  971    [ ' requires an argument (of type ~p)'-[Type] ].
  972opt_error(value_type(Opt, Type, Found)) -->
  973    [ 'Option '-[] ],
  974    opt(Opt), [' requires'],
  975    type(Type),
  976    [ ' (found '-[], ansi(code, '~w', [Found]), ')'-[] ].
  977opt_error(access_file(File, exist)) -->
  978    [ 'File '-[], ansi(code, '~w', [File]),
  979      ' does not exist'-[]
  980    ].
  981opt_error(access_file(File, Access)) -->
  982    { access_verb(Access, Verb) },
  983    [ 'Cannot access file '-[], ansi(code, '~w', [File]),
  984      ' for '-[], ansi(code, '~w', [Verb])
  985    ].
  986
  987access_verb(read,    reading).
  988access_verb(write,   writing).
  989access_verb(append,  writing).
  990access_verb(execute, executing).
  991
  992hint_help(M) -->
  993    { in(M:opt_type(Opt, help, boolean)) },
  994    !,
  995    [ ' (' ], opt(Opt), [' for help)'].
  996hint_help(_) -->
  997    [ ' (-h for help)'-[] ].
  998
  999opt(Opt) -->
 1000    { short_opt(Opt) },
 1001    !,
 1002    [ ansi(bold, '-~w', [Opt]) ].
 1003opt(Opt) -->
 1004    [ ansi(bold, '--~w', [Opt]) ].
 1005
 1006type(A|B) -->
 1007    type(A), [' or'],
 1008    type(B).
 1009type(oneof([One])) -->
 1010    !,
 1011    [ ' ' ],
 1012    atom(One).
 1013type(oneof(List)) -->
 1014    !,
 1015    [ ' one of '-[] ],
 1016    sequence(atom, [', '], List).
 1017type(between(Low, High)) -->
 1018    !,
 1019    [ ' a number '-[],
 1020      ansi(code, '~w', [Low]), '..', ansi(code, '~w', [High])
 1021    ].
 1022type(nonneg) -->
 1023    [ ' a non-negative integer'-[] ].
 1024type(natural) -->
 1025    [ ' a positive integer (>= 1)'-[] ].
 1026type(file(Access)) -->
 1027    [ ' a file with ~w access'-[Access] ].
 1028type(Type) -->
 1029    [ ' an argument of type '-[], ansi(code, '~w', [Type]) ].
 1030
 1031atom(A) -->
 1032    [ ansi(code, '~w', [A]) ].
 1033
 1034
 1035		  1038
 1054
 1055cli_parse_debug_options([], []).
 1056cli_parse_debug_options([H|T0], Opts) :-
 1057    debug_option(H),
 1058    !,
 1059    cli_parse_debug_options(T0, Opts).
 1060cli_parse_debug_options([H|T0], [H|T]) :-
 1061    cli_parse_debug_options(T0, T).
 1062
 1082
 1083cli_debug_opt_type(debug,       debug,       string).
 1084cli_debug_opt_type(spy,         spy,         string).
 1085cli_debug_opt_type(gspy,        gspy,        string).
 1086cli_debug_opt_type(interactive, interactive, boolean).
 1087
 1088cli_debug_opt_help(debug,
 1089                   "Call debug(Topic).  See debug/1 and debug/3. \c
 1090                    Multiple topics may be separated by : or ;").
 1091cli_debug_opt_help(spy,
 1092                   "Place a spy-point on Predicate. \c
 1093                    Multiple topics may be separated by : or ;").
 1094cli_debug_opt_help(gspy,
 1095                   "As --spy using the graphical debugger.  See tspy/1 \c
 1096                    Multiple topics may be separated by `;`").
 1097cli_debug_opt_help(interactive,
 1098                   "Start the Prolog toplevel after main/1 completes.").
 1099
 1100cli_debug_opt_meta(debug, 'TOPICS').
 1101cli_debug_opt_meta(spy,   'PREDICATES').
 1102cli_debug_opt_meta(gspy,  'PREDICATES').
 1103
 1104:- meta_predicate
 1105    spy_from_string(1, +). 1106
 1107debug_option(interactive(true)) :-
 1108    asserta(interactive).
 1109debug_option(debug(Spec)) :-
 1110    split_string(Spec, ";", "", Specs),
 1111    maplist(debug_from_string, Specs).
 1112debug_option(spy(Spec)) :-
 1113    split_string(Spec, ";", "", Specs),
 1114    maplist(spy_from_string(spy), Specs).
 1115debug_option(gspy(Spec)) :-
 1116    split_string(Spec, ";", "", Specs),
 1117    maplist(spy_from_string(cli_gspy), Specs).
 1118
 1119debug_from_string(TopicS) :-
 1120    term_string(Topic, TopicS),
 1121    debug(Topic).
 1122
 1123spy_from_string(Pred, Spec) :-
 1124    atom_pi(Spec, PI),
 1125    call(Pred, PI).
 1126
 1127cli_gspy(PI) :-
 1128    (   exists_source(library(threadutil))
 1129    ->  use_module(library(threadutil), [tspy/1]),
 1130	Goal = tspy(PI)
 1131    ;   exists_source(library(gui_tracer))
 1132    ->  use_module(library(gui_tracer), [gspy/1]),
 1133	Goal = gspy(PI)
 1134    ;   Goal = spy(PI)
 1135    ),
 1136    call(Goal).
 1137
 1138atom_pi(Atom, Module:PI) :-
 1139    split(Atom, :, Module, PiAtom),
 1140    !,
 1141    atom_pi(PiAtom, PI).
 1142atom_pi(Atom, Name//Arity) :-
 1143    split(Atom, //, Name, Arity),
 1144    !.
 1145atom_pi(Atom, Name/Arity) :-
 1146    split(Atom, /, Name, Arity),
 1147    !.
 1148atom_pi(Atom, _) :-
 1149    format(user_error, 'Invalid predicate indicator: "~w"~n', [Atom]),
 1150    halt(1).
 1151
 1152split(Atom, Sep, Before, After) :-
 1153    sub_atom(Atom, BL, _, AL, Sep),
 1154    !,
 1155    sub_atom(Atom, 0, BL, _, Before),
 1156    sub_atom(Atom, _, AL, 0, AfterAtom),
 1157    (   atom_number(AfterAtom, After)
 1158    ->  true
 1159    ;   After = AfterAtom
 1160    ).
 1161
 1162
 1172
 1173cli_enable_development_system :-
 1174    on_signal(int, _, debug),
 1175    set_prolog_flag(xpce_threaded, true),
 1176    set_prolog_flag(message_ide, true),
 1177    (   current_prolog_flag(xpce_version, _)
 1178    ->  use_module(library(pce_dispatch)),
 1179	memberchk(Goal, [pce_dispatch([])]),
 1180	call(Goal)
 1181    ;   true
 1182    ),
 1183    set_prolog_flag(toplevel_goal, prolog).
 1184
 1185
 1186		  1189
 1190:- multifile
 1191    prolog:called_by/2. 1192
 1193prolog:called_by(main, [main(_)]).
 1194prolog:called_by(argv_options(_,_,_),
 1195		 [ opt_type(_,_,_),
 1196		   opt_help(_,_),
 1197		   opt_meta(_,_)
 1198		 ]).
 1199prolog:called_by(argv_options(_,_,_,_), Called) :-
 1200    prolog:called_by(argv_options(_,_,_), Called)