1/*
    2% NomicMUD: A MUD server written in Prolog
    3% Maintainer: Douglas Miles
    4% Dec 13, 2035
    5%
    6% Bits and pieces:
    7%
    8% LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    9% 
   10% Copyright (C) 2004 Marty White under the GNU GPL 
   11% Sept 20,1999 - Douglas Miles
   12% July 10,1996 - John Eikenberry 
   13%
   14% Logicmoo Project changes:
   15%
   16% Main file.
   17%
   18*/
   19
   20:- dynamic(adv:cmd_help/2).   21                                                             
   22:- dynamic(adv:cmd_help/2).   23
   24:- use_module(library(help)). %,[online_manual_stream/1, pager_stream/1,  show_ranges/3, user_index/2, write_ranges_to_file/2, prolog:show_help_hook/2]).
   25
   26add_help(Cmd,HelpStr):-
   27 retractall(adv:cmd_help(Cmd,_)),
   28 assert(adv:cmd_help(Cmd,HelpStr)).
   29
   30add_help_cmd_borked(Cmd):-
   31 with_output_to(string(HelpStr),help(Cmd)),
   32 add_help(Cmd,HelpStr).
   33            
   34add_help_cmd(Cmd):-
   35 redirect_error_to_string(help(Cmd),HelpStr),
   36 add_help(Cmd,HelpStr).
   37
   38
   39give_help(A/B) :- !,
   40  online_help:predicate(A, B, _, C, D), !,
   41  show_help(A/B, [C-D]).
   42give_help(A) :-
   43  online_help:user_index(B, A), !,
   44  online_help:section(B, _, C, D),
   45  show_help(A, [C-D]).
   46give_help(A) :-
   47  atom(A),
   48  atom_concat('PL_', _, A),
   49  function(A, B, C), !,
   50  show_help(A, [B-C]).
   51give_help(A) :-
   52  findall(B-C,
   53    online_help:predicate(A, _, _, B, C),
   54    D),
   55  D\==[], !,
   56  show_help(A, D).
   57give_help(A) :-
   58  format('No help available for ~w~n', [A]).
   59
   60show_help(C, B) :-
   61 predicate_property(prolog:show_help_hook(_, _),
   62       number_of_clauses(A)),
   63  A>0,
   64  online_help:write_ranges_to_file(B, D),
   65  call(call,prolog:show_help_hook(C, D)).
   66
   67show_help(_, A) :-
   68  current_prolog_flag(pipe, true), !,
   69  online_help:online_manual_stream(B),
   70  online_help:pager_stream(C),
   71  catch(online_help:show_ranges(A, B, C), _, true),
   72  close(B),
   73  catch(close(C), _, true).
   74
   75show_help(_, A) :-
   76  online_help:online_manual_stream(B),
   77  online_help:show_ranges(A, B, user_output)