1/* <module> xlisting_web
    2% Provides /logicmoo runtime preds browsing
    3%
    4%
    5% Logicmoo Project PrologMUD: A MUD server written in Prolog
    6% Maintainer: Douglas Miles
    7% Dec 13, 2035
    8%
    9*/
   10% :-module(xlisting_web,[ensure_sigma/0,search4term/0]).
   11%:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). 
   12:- module(xlisting_web,
   13          [ action_menu_applied/3,
   14            %action_menu_item/2,
   15            add_form_script/0,
   16            register_logicmoo_browser/0,
   17            as_ftVars/1,
   18            call_for_terms/1,
   19            classify_alpha_tail/1,
   20            classify_name/2,
   21            classify_other_tail/1,
   22            current_form_var/1,
   23            current_line_position/1,
   24            current_line_position/2,
   25            cvt_param_to_term/2,
   26            cvt_param_to_term/3,
   27            do_guitracer/0,
   28            edit1term/0,
   29            output_telnet_console/1,
   30            edit1term/1,
   31            ensure_sigma/1,
   32            ensure_sigma/0,
   33            find_cl_ref/2,
   34            find_ref/2,
   35            fmtimg/2,
   36            'functor spec'/4,
   37            functor_to_color/2,
   38            functor_to_color/4,
   39            
   40            get_http_current_request/1,
   41            get_http_session/1,
   42            get_nv_session/3,
   43            get_param_req/2,
   44            get_param_sess/2,
   45            get_param_sess/3,
   46            get_request_vars/1,
   47            handler_logicmoo_cyclone/1,
   48            head_functor_sort/3,
   49            must_run/1,
   50            human_language/1,
   51            i2tml_hbr/3,
   52            if_html/2,
   53            output_html/1,
   54            write_html/1,
   55            show_map_legend/0,
   56            indent_nbsp/1,
   57            indent_nbsp/2,
   58            indent_nl/0,
   59            is_cgi_stream/0,
   60            is_context/2,
   61            is_goog_bot/0,
   62            'list clauses'/4,
   63            'list magic'/2,
   64            'list magic'/3,
   65            'list magic'/4,
   66            logic_lang_name/2,
   67            make_page_pretext_obj/1,
   68            make_quotable/2,
   69            make_session/1,
   70            maybe_paren/5,
   71            maybe_space/2,
   72            member_open/2,
   73            merge_key_vals/3,
   74            name_the_var/5,
   75            nl_same_pos/0,
   76            numberlist_at/2,
   77            object_sub_page/4,
   78            %param_default_value/2,
   79            param_matches/2,
   80            parameter_names/2,
   81            %partOfSpeech/2,
   82            portable_display/1,
   83            portable_listing/0,
   84            portable_listing/1,
   85            portable_print/1,
   86            portable_write/1,
   87            portable_writeq/1,
   88            pp_i2tml/1,
   89            pp_i2tml_now/1,
   90            pp_i2tml_save_seen/1,
   91            pp_i2tml_saved_done/1,
   92            pp_i2tml_v/1,
   93            pp_item_html/2,
   94            pp_item_html_if_in_range/2,
   95            pp_item_html_now/2,
   96            pp_now/0,
   97            print_request/1,
   98            prover_name/2,
   99            
  100            reply_object_sub_page/1,
  101            reset_assertion_display/0,
  102            return_to_pos/1,
  103            rok_portray_clause/1,
  104            save_in_session/1,
  105            save_in_session/2,
  106            save_in_session/3,
  107            save_request_in_session/1,
  108            search4term/0,
  109            search_filter_name_comment/3,
  110            section_close/1,
  111            section_open/1,
  112            sensical_nonvar/1,
  113            session_checkbox/3,
  114            session_checked/1,
  115            set_line_pos/1,
  116            set_line_pos/2,
  117            show_clause_ref/1,
  118            show_clause_ref_now/1,
  119            show_edit_term/3,
  120               show_http_session/0,
  121            show_iframe/1,
  122            show_iframe/3,
  123            show_pcall_footer/0,
  124            show_search_filters/1,
  125            show_search_filtersTop/1,
  126            term_to_pretty_string/2,
  127            this_listing/1,
  128            test_tmw/0,
  129            tovl/3,
  130            url_decode/2,
  131            url_decode_term/2,
  132            url_encode/2,
  133            url_encode_term/3,
  134            with_search_filters/1,
  135            with_search_filters0/1,
  136            write_VAR/4,
  137            write_args/5,
  138            write_as_url_encoded/2,
  139            write_atom/4,
  140            write_atom_link/1,
  141            write_atom_link/2,
  142            write_atom_link/3,
  143            write_begin_html/3,
  144            write_end_html/0,
  145            write_oper/5,
  146            write_out/5,
  147            write_oout/7,
  148            write_tail/2,
  149            write_term_to_atom_one/2,
  150            write_variable/1,
  151          
  152          xlisting_web_file/0
  153            /*
  154            http:location/3,
  155            http_dispatch:handler/4,
  156            http_log:log_stream/2,
  157            http_session:session_data/2,
  158            http_session:urandom_handle/1,
  159            system:'$init_goal'/3,
  160            user:file_search_path/2
  161            */
  162          ]).  163
  164
  165:- set_module(class(library)).  166:- use_module(library(attvar_serializer)).  167:- use_module(library(each_call_cleanup)).  168:- use_module(library(no_repeats)).  169
  170
  171:- dynamic user:library_directory/1.  172:- multifile user:library_directory/1.  173hide_xpce_library_directory:- 
  174  user:library_directory(X),
  175  atom(X),
  176  atom_concat(_,'xpce/prolog/lib/',X),!,
  177  retract((user:library_directory(X))),
  178  assert((user:library_directory(X):- \+ current_prolog_flag(hide_xpce_library_directory,true))).
  179hide_xpce_library_directory.
  180
  181:- hide_xpce_library_directory.  182:- set_prolog_flag(hide_xpce_library_directory,true).  183
  184%:- ensure_loaded(library(logicmoo_swilib)).
  185:- use_module(library(http/thread_httpd)).  186:- use_module(thread_httpd:library(http/http_dispatch)).  187:- use_module(swi(library/http/html_write)).  188:- use_module(swi(library/http/html_head)).  189:- use_module(library(http/http_dispatch)).  190:- use_module(library(http/http_path)).  191:- use_module(library(http/http_log)).  192:- use_module(library(http/http_client)).  193:- use_module(library(http/http_server_files)).  194:- use_module(library(http/http_parameters)).  195:- use_module(library(with_no_x)).  196
  197:- use_module(library(with_thread_local)).  198:- use_module(library(predicate_streams)).  199:- use_module(library(butterfly)).  200
  201
  202:- thread_local(t_l:no_cycstrings/0).  203:- asserta(t_l:no_cycstrings).  204
  205/*
  206:- include(library('pfc2.0'/'mpred_header.pi')).
  207:-
  208 op(1199,fx,('==>')), 
  209 op(1190,xfx,('::::')),
  210 op(1180,xfx,('==>')),
  211 op(1170,xfx,'<==>'),  
  212 op(1160,xfx,('<-')),
  213 op(1150,xfx,'=>'),
  214 op(1140,xfx,'<='),
  215 op(1130,xfx,'<=>'), 
  216 op(600,yfx,'&'), 
  217 op(600,yfx,'v'),
  218 op(350,xfx,'xor'),
  219 op(300,fx,'~'),
  220 op(300,fx,'-').
  221
  222:- 
  223 user:((
  224 op(1199,fx,('==>')), 
  225 op(1190,xfx,('::::')),
  226 op(1180,xfx,('==>')),
  227 op(1170,xfx,'<==>'),  
  228 op(1160,xfx,('<-')),
  229 op(1150,xfx,'=>'),
  230 op(1140,xfx,'<='),
  231 op(1130,xfx,'<=>'), 
  232 op(600,yfx,'&'), 
  233 op(600,yfx,'v'),
  234 op(350,xfx,'xor'),
  235 op(300,fx,'~'),
  236 op(300,fx,'-'))).
  237*/
  238%:- endif.
  239
  240:- thread_local(t_l:print_mode/1).  241
  242:- if(exists_source(cliopatria('applications/help/load'))).  243:- use_module(cliopatria('applications/help/load')).  244% Load ClioPatria itself.  Better keep this line.
  245:- use_module(cliopatria(cliopatria)).  246:- else.  247cp_menu:cp_menu(X,X).
  248cp_menu:cp_menu.
  249:- endif.  250
  251:- kb_global(baseKB:param_default_value/2).  252:- kb_global(baseKB:mtExact/1).  253
  254:- meta_predicate 
  255        edit1term(*),
  256        handler_logicmoo_cyclone(+),
  257        must_run(*),
  258        output_html(//),
  259        if_html(?, 0),
  260        return_to_pos(0),
  261        show_edit_term(0, ?, ?),
  262        show_edit_term0(0, ?, ?),
  263        show_edit_term1(0, ?, ?),
  264        with_search_filters(0),
  265        with_search_filters0(0).  266:- (multifile http:location/3, http_dispatch:handler/4, http_log:log_stream/2, http_session:session_data/2, http_session:urandom_handle/1, baseKB:shared_hide_data/1, system:'$init_goal'/3, user:file_search_path/2).  267:- (module_transparent edit1term/1, must_run/1, if_html/2, return_to_pos/1, show_edit_term/3, show_edit_term0/3, show_edit_term1/3, with_search_filters/1).  268:- (volatile http_log:log_stream/2, http_session:session_data/2, http_session:urandom_handle/1).  269:- export((current_form_var0/1, get_http_session0/1,  is_context0/1, make_quotable_0/2, pp_i2tml_0/1, pp_i2tml_1/1, sanity_test_000/0, show_edit_term0/3, show_edit_term1/3, show_select1/2, show_select2/3)).  270:- multifile((lmcache:last_item_offered/1, http:location/3, http_dispatch:handler/4, http_session:session_data/2, http_session:urandom_handle/1,
  271   foobar/1, lmcache:last_http_request/1, lmcache:last_item_offered/1, system:'$init_goal'/3, user:file_search_path/2)).  272
  273
  274:- thread_initialization(nb_setval(pldoc_options,[ prefer(manual) ])).  275
  276:- meta_predicate must_run(0).  277:- meta_predicate must_run(0).  278:- meta_predicate with_search_filters(0).  279:- meta_predicate return_to_pos(0).  280:- meta_predicate show_edit_term1(0,*,*).  281:- meta_predicate show_edit_term0(0,*,*).  282:- meta_predicate show_edit_term(0,*,*).  283:- meta_predicate edit1term(0).  284
  285:- meta_predicate www_main_error_to_out(0).  286
  287www_main_error_to_out(G):- with_main_error_to_output(G).
 ensure_sigma(?ARG1) is det
Ensure Webserver.
  293ensure_sigma(Port) :- format(atom(A),'httpd@~w_1',[Port]),thread_property(_,alias(A)),!.
  294ensure_sigma(Port) :- on_x_debug(catch((http_server(http_dispatch,[ port(Port), workers(16) ])),E,wdmsg(E))).
 ensure_sigma is det
Ensure Webserver.
  302ensure_sigma:- ensure_sigma(3020).
  303
  304:- multifile(http_session:session_data/2).  305:- volatile(http_session:session_data/2).  306
  307:- multifile(system:'$loading_file'/3).  308:- volatile(system:'$loading_file'/3).  309
  310:- multifile(http_session:urandom_handle/1).  311:- volatile(http_session:urandom_handle/1).  312
  313:- multifile(http_log:log_stream/2).  314:- volatile(http_log:log_stream/2).  315
  316
  317
  318:- if( \+ exists_source(library(logicmoo_utils))).  319:- dynamic user:file_search_path/2.  320:- multifile user:file_search_path/2.  321:- prolog_load_context(directory,Dir),
  322   DirFor = mpred_online,
  323   (( \+ user:file_search_path(DirFor,Dir)) ->asserta(user:file_search_path(DirFor,Dir));true),
  324   absolute_file_name('../../',Y,[relative_to(Dir),file_type(directory)]),
  325   (( \+ user:file_search_path(pack,Y)) ->asserta(user:file_search_path(pack,Y));true).  326:- initialization(attach_packs,now).  327% [Required] Load the Logicmoo Library Utils
  328:- endif.  329 
  330
  331
  332
  333
  334% :- portray_text(false).  % or Enable portray of strings
  335
  336
  337:- thread_local(t_l:omit_full_stop).  338
  339% :- thread_property(_,alias('http@3020'))->true; http_server(http_dispatch, [port(3020)]).
  340
  341register_logicmoo_browser:- 
  342  http_handler('/logicmoo/', handler_logicmoo_cyclone, [prefix]), % chunked
  343  http_handler('/logicmoo_nc/', handler_logicmoo_cyclone, [prefix,chunked]),
  344  http_handler('/swish/logicmoo/', handler_logicmoo_cyclone, [prefix]), % chunked
  345  http_handler('/swish/logicmoo_nc/', handler_logicmoo_cyclone, [prefix,chunked]),
  346  doc_collect(true).
 location(?ARG1, ?ARG2, ?ARG3) is det
Hook To [http:location/3] For Module Mpred_www. Location.
  354:- assert_if_new(http:location(pixmapx, root(pixmapx), [])).
 user:file_search_path(?ARG1, ?ARG2) is det
Hook To [file_search_path/2] For Module Mpred_www. File Search Path.
  363:- prolog_load_context(directory,Here),atom_concat(Here,'/pixmapx',NewDir),asserta((user:file_search_path(pixmapx,NewDir))).  364% user:file_search_path(pixmapx, logicmoo('mpred_online/pixmapx')).
  365
  366:- during_boot(http_handler(pixmapx(.), http_server_files:serve_files_in_directory(pixmapx), [prefix])).  367
  368:- meta_predicate
  369	handler_logicmoo_cyclone(+).  370
  371:- must(prolog_load_context(module,xlisting_web)).  372in_xlisting_web1.
  373:- must( \+ pfc_lib:is_pfc_file0).  374:- ensure_loaded('xlisting_web.pfc').  375:- must( \+ is_pfc_file).  376
  377in_xlisting_web2.
  378:- xlisting_web:listing(in_xlisting_web2).
 print_request(:TermARG1) is det
Print Request.
  384print_request([]).
  385print_request([H|T]) :-
  386        H =.. [Name, Value],
  387        bformat(user_error,'<tr><td>~w<td>~w~n', [Name, Value]),
  388        print_request(T).
  389
  390
  391:- xlisting_web:listing(print_request/1).
 make_quotable_0(?ARG1, ?ARG2) is det
make quotable Primary Helper.
  400make_quotable_0(SUnq0,SObj):-
  401  any_to_string(SUnq0,SUnq),
  402  atom_subst(SUnq,'\\','\\\\',SObj0),atom_subst(SObj0,'\n','\\n',SObj1),atom_subst(SObj1,'"','\\\"',SObj).
 make_quotable(?ARG1, ?ARG2) is det
Make Quotable.
  410make_quotable(String,SObj):-string(String),format(string(SUnq),'~s',[String]),make_quotable_0(SUnq,SObj),!.
  411make_quotable(String,SObj):-atomic(String),format(string(SUnq),'~w',[String]),make_quotable_0(SUnq,SObj),!.
  412make_quotable(String,SObj):-format(string(SUnq),'~q',[String]),make_quotable_0(SUnq,SObj),!.
  413
  414% 
  415% <link rel="SHORTCUT ICON" href="/pixmapx/mini-logo.gif"><meta name="ROBOTS" content="NOINDEX, NOFOLLOW">
  416
  417% :- set_yes_debug.
  418
  419:- export(save_in_session/1).
 save_in_session(:TermARG1) is det
Save In Session.
  427save_in_session(NV):- \+ compound(NV),!.
  428save_in_session(NV):-is_list(NV),!,must_maplist(save_in_session,NV),!.
  429save_in_session(search([X=Y|R])):-nonvar(Y),is_list([X=Y|R]),once(save_in_session([X=Y|R])),!.
  430save_in_session(NV):-NV=..[N,V],!,must_run(save_in_session(N,V)),!.
  431save_in_session(N=V):- must_run(save_in_session(N,V)),!.
  432save_in_session(NV):- dmsg(not_save_in_session(NV)),!.
  433
  434:- export(save_in_session/2).
 save_in_session(?ARG1, ?ARG2) is det
Save In Session.
  442save_in_session(Unsaved,_):- member(Unsaved,[session_data,request_uri,search,pool,path,input,session]),!.
  443save_in_session(_,V):- sub_term(Sub,V),nonvar(Sub),is_stream(Sub),!.
  444save_in_session(N,V):- get_http_session(S), save_in_session(S, N,V),!.
  445
  446% save_in_session(S,N,V):- \+ param_default_value(N,_),!.
 save_in_session(?ARG1, ?ARG2, ?ARG3) is det
Save In Session.
  454save_in_session(S,N,V):- atom(N), NV=..[N,V],functor(NVR,N,1),
  455   retractall(http_session:session_data(S,NVR)),
  456   asserta(http_session:session_data(S,NV)),!.
  457save_in_session(S,N,V):- dmsg(not_save_in_session(S,N,V)),!.
 show_http_session is det
Show Http Session.
  467show_http_session:-must_run(get_http_session(S)),listing(http_session:session_data(S,_NV)).
 make_session(?ARG1) is det
Make Session.
  477make_session(S):- catch((is_cgi_stream->http_session:http_open_session(S,[renew(false)]);true),_,true).
  478
  479
  480
  481:- export(get_http_session/1).
 get_http_session(?ARG1) is det
Get Http Session.
  486get_http_session(S):- catch(get_http_session0(S),_,fail),nonvar(S),!, make_session(S).
  487get_http_session(main).
  488
  489% on_x_log_fail(G):- catch(G,E,(dmsg(E:G),fail)).
  490
  491
  492:- export(get_http_session0/1).
 get_http_session0(?ARG1) is det
Get Http Session Primary Helper.
  497get_http_session0(S):- on_x_log_fail((http_session:http_in_session(S))),!.
  498get_http_session0(S):- on_x_log_fail((get_http_current_request(R),member(session(S),R))),!.
  499get_http_session0(S):- on_x_log_fail((get_http_current_request(R),member(cookie([swipl_session=S]),R))),!.
  500get_http_session0(S):- is_cgi_stream,catch(((http_session:http_open_session(S,[renew(false)]))),_,true),!.
 is_cgi_stream is det
If Is A Cgi Stream.
  509is_cgi_stream:-current_output(X),http_stream:is_cgi_stream(X).
 reset_assertion_display is det
Reset Assertion Display.
  518reset_assertion_display:-
  519   flag(matched_assertions,_,0),
  520   flag(show_asserions_offered,_,0),
  521   retractall(shown_subtype(_)),
  522   retractall(xlw:shown_clause(_)).
 get_param_sess(?ARG1, ?ARG2) is det
Get Param Sess.
  531get_param_sess(N,V):- must_run(param_default_value(N,D);D=''),!,get_param_sess(N,V,D),!.
  532
  533:- dynamic(lmcache:last_http_request/1).  534:- volatile(lmcache:last_http_request/1).  535:- dynamic(lmcache:last_item_offered/1).  536:- volatile(lmcache:last_item_offered/1).
 lmcache:last_item_offered(?ARG1) is det
Last Item Offered.
  542:- asserta(lmcache:last_item_offered(unknown)).
 get_http_current_request(?ARG1) is det
Get Http Current Request.
  552get_http_current_request(B):- httpd_wrapper:http_current_request(B), !,ignore((retractall(lmcache:last_http_request(_)),asserta(lmcache:last_http_request(B)))).
  553get_http_current_request(B):- lmcache:last_http_request(B),!.
  554get_http_current_request([]).
 get_param_sess(?ARG1, ?ARG2, ?ARG3) is det
Get Param Sess.
  563get_param_sess(N,V,D):- nonvar(V),!,get_param_sess(N,VV,D),!,param_matches(V,VV).
  564get_param_sess(L,V,D):-get_nv_session(L,V,D).
 get_param_req(?ARG1, ?ARG2) is det
Get Param Req.
  573get_param_req(L,V):- (is_list(L)-> member(N,L) ; N=L),
  574     CALL2 =.. [N,V,[optional(true),default(Foo)]],
  575  get_http_current_request(B),
  576   http_parameters:http_parameters(B,[CALL2])->
  577       V \== Foo,!.
  578
  579% get_param_sess(L,V,V):- (is_list(L)-> member(N,L) ; N=L), save_in_session(N=V),!.
 get_nv_session(?ARG1, ?ARG2, ?ARG3) is det
Get Nv Session.
  588get_nv_session(L,V,_):- (is_list(L)-> member(N,L) ; N=L),
  589     CALL2 =.. [N,V], (get_http_session(F),http_session:session_data(F, CALL2)),!.
  590get_nv_session(_,V,V):-!.
 save_request_in_session(?ARG1) is det
Save Request In Session.
  600save_request_in_session(Request):- 
  601        (member(method(post), Request) -> (http_read_data(Request, Data, []),save_in_session(Data));true),
  602        save_in_session(Request).
  603        % http_session:http_session_id(F),forall(http_session:session_data(F,D),wdmsg(D)).
  604
  605
  606
  607:- dynamic(lmcache:current_ioet/4).  608:- volatile(lmcache:current_ioet/4).  609
  610:- create_prolog_flag(retry_undefined,default,[type(term),keep(true)]).
 handler_logicmoo_cyclone(+Request) is det
Handler Logicmoo Cyclone.
  616handler_logicmoo_cyclone(_):- quietly(is_goog_bot),!,
  617  quietly((format('Content-type: text/html~n~n',[]),
  618  bformat('<!DOCTYPE html><html><head></head><body><pre></pre></body></html>~n~n',[]),
  619  flush_output_safe)),!.
  620handler_logicmoo_cyclone(Request):- quietly(is_goog_bot),!,
  621  quietly((format('Content-type: text/html~n~n',[]),
  622  bformat('<!DOCTYPE html><html><head></head><body><pre>~q</pre></body></html>~n~n',[Request]),
  623  flush_output_safe)),!.
  624
  625handler_logicmoo_cyclone(Request):-
  626 wdmsg(handler_logicmoo_cyclone(Request)),
  627 ignore((
  628 %nodebugx
  629 ((
  630  ignore(get_http_session(_)), 
  631  locally(set_prolog_flag(retry_undefined, none),
  632    % with_no_x
  633    (( 
  634     must_run((
  635      current_input(In),current_output(Out),
  636       (stream_property(Err,file_no(2));current_error_stream(Err)),
  637   thread_self(ID),!,
  638   asserta(lmcache:current_ioet(In,Out,Err,ID)),
  639%    format('Content-type: text/html~n~n',[]),
  640   html_write:html_current_option(content_type(D)),
  641   format('Content-type: ~w~n~n', [D]),
  642   bformat('<!DOCTYPE html>',[]),flush_output_safe,
  643    must_run(save_request_in_session(Request)),
  644    % member(request_uri(URI),Request),
  645     member(path(PATH),Request),
  646    directory_file_path(_,FCALL,PATH),
  647   once(get_param_req(webproc,Call);(current_predicate(FCALL/0),Call=FCALL);get_param_sess(webproc,Call,edit1term)),
  648   must_run(Call)))))))))),!.
  649   
  650
  651
  652:- asserta(cp_menu:menu_item(500=places/handler_logicmoo_cyclone,	'LogicMOO')).  653:- asserta(cp_menu:menu_item(500=swish/handler_logicmoo_cyclone,	'LogicMOO')).
 write_begin_html(?ARG1, ?ARG2, ?ARG3) is det
Write Begin HTML.
  660write_begin_html(B,BASE,URI):-  
  661  must_run((
  662      % sformat(BASE,'~w~@',[B,get_request_vars('_n_~w_v0_~w_vZ')]),
  663      BASE = B,
  664      bformat('<html><head><style type="text/css">
  665   element.style {
  666    position: relative;
  667    min-height: 100%;
  668    top: 0px;
  669}
  670html, body {
  671    font-family: Verdana,sans-serif;
  672    font-size: 10px;
  673    line-height: 1.5;
  674}
  675body {
  676    margin: 1;
  677}
  678        input[type="checkbox"] {width:10px; height:10px; }</style>',
  679        []),            
  680      must_run((get_http_current_request(Request))),
  681      must_run(member(request_uri(URI),Request)->true;URI=''),
  682      % ((URI\==''->bformat('<meta http-equiv="refresh" content="300;~w">',[URI]);true)),
  683      % must_run((BASE\='' -> bformat('<base href="~w" target="_parent"/>',[BASE]);true)),
  684      ignore(URI=''),
  685      ignore(BASE=''),
  686     bformat('<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.7.1/jquery.min.js"></script>',[]),
  687     html_head:output_html(html_requires(plain)),     
  688     bformat('<title>~w for ~w</title>
  689      <meta http-equiv="X-Frame-Options" content="ALLOWAll">
  690      <link rel="stylesheet" type="text/css" href="/css/cliopatria.css">
  691      <link rel="stylesheet" type="text/css" href="/css/menu.css">
  692      <script type="text/javascript" src="/js/jquery-2.1.3.min.js"></script>
  693      <script type="text/javascript" src="/js/cliopatria.js"></script>
  694      <link rel="stylesheet" type="text/css" href="/www/yui/2.7.0/build/autocomplete/assets/skins/sam/autocomplete.css">
  695      <script type="text/javascript" src="/www/yui/2.7.0/build/utilities/utilities.js"></script>
  696      <script type="text/javascript" src="/www/yui/2.7.0/build/datasource/datasource.js"></script>
  697      <script type="text/javascript" src="/www/yui/2.7.0/build/autocomplete/autocomplete.js"></script></head>',
  698   [BASE,URI]),
  699     bformat('<body class="yui-skin-sam">',[]),flush_output_safe)),!,
  700  with_output_to(string(SMenu),output_html(cp_menu:cp_menu)),
  701  output_html(div([id('cp-menu'), class(menu)], SMenu)).     
  702
  703   
  704test_rok:- test_rok(test_rok).
  705
  706/*
  707dasm:print_clause_plain(Term) :-
  708        current_prolog_flag(color_term, Prolog_flag_Ret),
  709        make_pretty(Term, Make_pretty_Ret),
  710        setup_call_cleanup(set_prolog_flag(color_term, false),
  711                           ( nl,
  712                             lcolormsg1(Make_pretty_Ret)
  713                           ),
  714                           set_prolog_flag(color_term, Prolog_flag_Ret)).
  715*/
  716
  717test_rok(W) :- handler_logicmoo_cyclone([path_info(search4term), protocol(http), peer(ip(127, 0, 0, 1)), 
  718  In = user_input,
  719  Out = user_put,
  720  format(atom(S4T),'/logicmoo/search4term?find=~w',[W]),
  721  pool(client('httpd@3020', http_dispatch, In, Out)),
  722    input(In), method(get), request_uri(S4T),
  723     path('/logicmoo/search4term'), search([find=W]), 
  724     http_version(1-1), host('127.0.0.1'), port(3020), cache_control('max-age=0'), 
  725     upgrade_insecure_requests('1'), user_agent('Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/67.0.3393.4 Safari/537.36'),
  726     accept([media(text/html, [], 1.0, []), media(application/'xhtml+xml', [], 1.0, []), 
  727     media(image/webp, [], 1.0, []), media(image/apng, [], 1.0, []), media(application/xml, [], 0.9, []), 
  728     media(_9672/_9674, [], 0.8, [])]), accept_encoding('gzip, deflate'), accept_language('en-US,en;q=0.9'), 
  729     cookie(['PHPSESSID'=u265i7e611jval7odhrs316n07, '_ga'='GA1.2.854971883.1519291037', 
  730     session='eyJjc3JmX3Rva2VuIjoiMGU3MzE1ZWUxMjVkZTNlZDNlZDg3ZDgyNWQ5ZmZiNjMxNjE4ODdjZiJ9.DYDY5A.so4fbyaXlbCXtzExefb_aYRjJ6g', 
  731     io='DjFUY0jh0SbK64uLAAAM', lo_session_in='1', '_jsuid'='984133034', 
  732     '__lotl'='http%3A%2F%2Flogicmoo.org%2Fdocs%2FA%2520Fuzzy%2520Belief-Desire-Intention%2520Model%2520for%2520Agent-Based%2520Image%2520Analysis%2520_%2520IntechOpen.html', 
  733     euCookie='1', swipl_session='cc4e-bdf6-b3ff-9ffc.gitlab']), x_forwarded_for('10.0.0.122'), x_forwarded_host('logicmoo.org'),
  734      x_forwarded_server('127.0.1.1'), connection('Keep-Alive')]),!.
 write_end_html is det
Write End HTML.
  741write_end_html:- flush_output_safe,bformat('</body></html>~n~n',[]),flush_output_safe,!.
  742
  743% logicmoo_html_needs_debug.
 add_form_script is det
Add Form Script.
  752add_form_script:-
  753format("<script type=\"text/javascript\">
  754$('form').submit(function() {
  755  $(this).find('input[type=checkbox]').each(function (i, el) {
  756    if(!el.checked) {
  757      var hidden_el = $(el).clone();
  758      hidden_el[0].checked = true;
  759      hidden_el[0].value = '0';
  760      hidden_el[0].type = 'hidden'
;
  761      hidden_el.insertAfter($(el));
  762    }    
  763  })
  764 // alert($(this));
  765});
  766
  767var handled = false;
  768
  769function callback(e) {
  770    var e = window.e || e;
  771
  772    var targ = e.target;
  773    if (targ.tagName !== 'A')
  774        return;
  775    if(!handled) {     
  776      handled = true;
  777     // alert('hi ' +  targ.target);
  778      if (targ.target !== '') {
  779       return;
  780      }
  781      e.preventDefault();
  782      e.stopPropagation();
  783      $('form').action = targ.href;
  784      document.getElementById('find').value = targ.innerText;
  785     // alert('hi ' +  targ.innerText);
  786      $('form').submit();
  787    } else {
  788      handled = false;           
  789    }
  790}
  791
  792if (document.addEventListener)
  793    document.addEventListener('click', callback, false);
  794else
  795    document.attachEvent('onclick', callback);
  796</script>"
  797).
 show_pcall_footer is det
Show Pcall Footer.
  807show_pcall_footer:- bformat('<hr><a href="http://prologmoo.com">LogicMOO/PrologMUD</a>',[]),!.
 sensical_nonvar(?ARG1) is det
Sensical Nonvar.
  816sensical_nonvar(O):-nonvar(O), O \= (_ - _).
 cvt_param_to_term(?ARG1, ?ARG2, ?ARG3) is det
Cvt Param Converted To Term.
  825cvt_param_to_term(In,Obj,Vs):-atom(In),on_x_fail(atom_to_term(In,Obj,Vs)),sensical_nonvar(Obj),!.
  826cvt_param_to_term(In,Obj,Vs):-string(In),on_x_fail(atom_to_term(In,Obj,Vs)),sensical_nonvar(Obj),!.
 cvt_param_to_term(?ARG1, ?ARG2) is det
Cvt Param Converted To Term.
  834cvt_param_to_term('~w',""):-!.
  835cvt_param_to_term(In,Obj):-cvt_param_to_term(In,Obj,_Vs),!.
  836cvt_param_to_term(Obj,Obj).
  837
  838
  839
  840% :- (thread_property(ID,status(running)),ID=reloader30) -> true; thread_create(((repeat,sleep(30),mmake,fail)),_,[alias(reloader30),detached(true)]).
  841% ===================================================
  842% Pretty Print Formula
  843% ===================================================
 write_atom_link(?ARG1) is det
Write Atom Link.
  850:- export(write_atom_link/1).  851write_atom_link(A):-must_run(write_atom_link(A,A)).
 write_atom_link(?ARG1, ?ARG2) is det
Write Atom Link.
  859:- export(write_atom_link/2).  860write_atom_link(L,N):-must_run((write_atom_link(atom(W),L,N),bformat('~w',[W]))),!.
  861
  862% pred_href(Name/Arity, Module, HREF) :-
 write_atom_link(?ARG1, ?ARG2, ?ARG3) is det
Write Atom Link.
  870:- export(write_atom_link/3).  871write_atom_link(W,A/_,N):-atom(A),!,write_atom_link(W,A,N).
  872write_atom_link(W,C,N):-compound(C),get_functor(C,F,A),!,write_atom_link(W,F/A,N).
  873%write_atom_link(W,_,N):- thread_self_main,!,write_term_to_atom_one(W,N),!.
  874write_atom_link(W,_,N):- must_run(nonvar(W)),\+ is_html_mode,write_term_to_atom_one(W,N),!.
  875write_atom_link(W,A,N):- sanity(nonvar(W)),
  876 catch((format(atom(AQ),'~q',[A]),url_encode(AQ,URL),
  877   format(W,'<a href="?find=~w">~w</a>',[URL,N])),_,write_term_to_atom_one(W,N)).
 write_term_to_atom_one(:TermARG1, ?ARG2) is det
Write Term Converted To Atom One.
  886write_term_to_atom_one(atom(A),Term):-format(atom(A),'~q',[Term]).
  887
  888/*
  889
  890
  891%   File   : WRITE.PL
  892%   Author : Richard A. O'Keefe.
  893%   Updated: 22 October 1984
  894%   Purpose: Portable definition of write/1 and friends.
  895
  896:- public
  897	portable_display/1,
  898	portable_listing/0,
  899	portable_listing/1,
  900	portable_print/1,
  901	portable_write/1,
  902	portable_writeq/1,
  903	rok_portray_clause/1.
  904
  905:- meta_predicate
  906	classify_name(+, -),
  907	classify_alpha_tail(+),
  908	classify_other_tail(+),
  909	'functor spec'(+, -, -, -),
  910	'list clauses'(+, +, +, +),
  911	'list magic'(+, +),
  912	'list magic'(+, +, +),
  913	'list magic'(+, +, +, +),
  914	maybe_paren(+, +, +, +, -),
  915	maybe_space(+, +),
  916	rok_portray_clause(+),
  917	put_string(+),
  918	put_string(+, +),
  919	write_args(+, +, +, +, +),
  920	write_atom(+, +, +, -),
  921	write_oper(+, +, +, +, -),
  922	write_out(+, +, +, +, -),
  923	write_out(+, +, +, +, +, +, -),
  924	write_tail(+, +),
  925	write_VAR(+, +, +, -),
  926	write_variable(?).
  927*/
  928     
  929
  930/*  WARNING!
  931    This file was written to assist portability and to help people
  932    get a decent set of output routines off the ground fast.  It is
  933    not particularly efficient.  Information about atom names and
  934    properties should be precomputed and fetched as directly as
  935    possible, and strings should not be created as lists!
  936
  937    The four output routines differ in the following respects:
  938    [a] display doesn't use operator information or handle {X} or
  939	[H|T] specially.  The others do.
  940    [b] print calls portray/1 to give the user a chance to do
  941	something different.  The others don't.
  942    [c] writeq puts quotes around atoms that can't be read back.
  943	The others don't.
  944    Since they have such a lot in common, we just pass around a
  945    single Style argument to say what to do.
  946
  947    In a Prolog which supports strings;
  948	write(<string>) should just write the text of the string, this so
  949	that write("Beware bandersnatch") can be used.  The other output
  950	commands should quote the string.
  951
  952    listing(Preds) is supposed to write the predicates out so that they
  953    can be read back in exactly as they are now, provided the operator
  954    declarations haven't changed.  So it has to use writeq.  $VAR(X)
  955    will write the atom X without quotes, this so that you can write
  956    out a clause in a readable way by binding each input variable to
  957    its name.
  958*/
 portable_display(?ARG1) is det
Portable Display.
  968portable_display(Term) :-
  969	write_out(Term, display, 1200, punct, _).
 portable_print(?ARG1) is det
Portable Print.
  979portable_print(Term) :-
  980	write_out(Term, print, 1200, punct, _).
 portable_write(?ARG1) is det
Portable Write.
  990portable_write(Term) :-
  991	write_out(Term, write, 1200, punct, _).
 portable_writeq(?ARG1) is det
Portable Writeq.
 1001portable_writeq(Term) :-
 1002       write_out(Term, writeq, 1200, punct, _).
 1003
 1004
 1005
 1006%   maybe_paren(P, Prio, Char, Ci, Co)
 1007%   writes a parenthesis if the context demands it.
 maybe_paren(?ARG1, ?ARG2, ?ARG3, ?ARG4, ?ARG5) is det
Maybe Paren.
 1016maybe_paren(P, Prio, Char, _, punct) :-
 1017	P > Prio,
 1018	!,
 1019	put(Char).
 1020maybe_paren(_, _, _, C, C).
 1021
 1022
 1023
 1024%   maybe_space(LeftContext, TypeOfToken)
 1025%   generates spaces as needed to ensure that two successive
 1026%   tokens won't run into each other.
 maybe_space(?ARG1, ?ARG2) is det
Maybe Space.
 1035maybe_space(punct, _) :- !.
 1036maybe_space(X, X) :- !,
 1037	put(32).
 1038maybe_space(quote, alpha) :- !,
 1039	put(32).
 1040maybe_space(_, _).
 1041
 1042
 1043
 1044
 1045%   write_variable(V)
 1046%   is system dependent.  This just uses whatever Prolog supplies.
 write_variable(?ARG1) is det
Write Variable.
 1055write_variable(V) :-
 1056	write(V).
 1057
 1058
 1059
 1060
 1061portray_or_print(Term):- catch(user:portray(Term),_,fail),!.
 1062portray_or_print(Term):- catch(print(Term),_,fail),!.
 write_out(Term, Style, Priority, Ci, Co)
writes out a Term in a given Style (display,write,writeq,print) in a context of priority Priority (that is, operators with greater priority have to be quoted), where the last token to be written was of type Ci, and reports that the last token it wrote was of type Co.
 1072write_out(Term, Style, Prio, Ci, Co):-
 1073 write_oout(Term, Style, Prio, Ci, Co).
 write_oout(Term, Style, Prio, Ci, Co) is det
Write Out.
 1079write_oout(Term, _, _, Ci, alpha) :-
 1080	var(Term),
 1081	!,
 1082	maybe_space(Ci, alpha),
 1083	write_variable(Term).
 1084write_oout('$VAR'(N), Style, _, Ci, Co) :- !,
 1085	write_VAR(N, Style, Ci, Co).
 1086write_oout(N, _, _, Ci, alpha) :-
 1087	integer(N),
 1088	(   N < 0, maybe_space(Ci, other)
 1089	;   maybe_space(Ci, alpha)
 1090	),  !,
 1091	name(N, String),
 1092	put_string(String).
 1093write_oout(TermS, Style, Prio, Ci, Co) :- string(TermS),
 1094        term_to_atom(TermS,Term),!,write_oout(Term, Style, Prio, Ci, Co).
 1095write_oout(Term, print, _,  _, alpha) :-
 1096	% DMILES HSOULD BE portray/1
 1097        loop_check(portray_or_print(Term),writeq(Term)),
 1098        % print(Term),
 1099	!.
 1100write_oout(Atom, Style, Prio, _, punct) :-
 1101	atom(Atom),
 1102	current_op(P, _, Atom),
 1103	P > Prio,
 1104	!,
 1105	put(40),
 1106	(   Style = writeq, write_atom(Atom, Style, punct, _)
 1107	;   (name(Atom, String), put_string(String))
 1108	),  !,
 1109	put(41).
 1110write_oout(Atom, Style, _, Ci, Co) :-
 1111	atom(Atom),
 1112	!,
 1113	write_atom(Atom, Style, Ci, Co).
 1114write_oout(Term, display, _, Ci, punct) :- !,
 1115	functor(Term, Fsymbol, Arity),
 1116	write_atom(Fsymbol, display, Ci, _),
 1117	write_args(0, Arity, Term, 40, display).
 1118write_oout({Term}, Style, _, _, punct) :- !,
 1119	put(123),
 1120	write_oout(Term, Style, 1200, punct, _),
 1121	put(125).
 1122write_oout([Head|Tail], Style, _, _, punct) :- !,
 1123	put(91),
 1124	write_oout(Head, Style, 999, punct, _),
 1125	write_tail(Tail, Style).
 1126write_oout((A,B), Style, Prio, Ci, Co) :- !,
 1127	%  This clause stops writeq quoting commas.
 1128	maybe_paren(1000, Prio, 40, Ci, C1),
 1129	write_oout(A, Style, 999, C1, _),
 1130	put(44),
 1131	write_oout(B, Style, 1000, punct, C2),
 1132	maybe_paren(1000, Prio, 41, C2, Co).
 1133write_oout(Term, Style, Prio, Ci, Co) :-
 1134	functor(Term, F, N),
 1135	write_oout(N, F, Term, Style, Prio, Ci, Co).
 write_oout(?ARG1, ?ARG2, ?ARG3, ?ARG4, ?ARG5, ?ARG6, ?ARG7) is det
Write Out.
 1143write_oout(1, F, Term, Style, Prio, Ci, Co) :-
 1144	(   current_op(O, fx, F), P is O-1
 1145	;   current_op(O, fy, F), P = O
 1146	),  !,
 1147	maybe_paren(O, Prio, 40, Ci, C1),
 1148	write_atom(F, Style, C1, C2),
 1149	arg(1, Term, A),
 1150	write_oout(A, Style, P, C2, C3),
 1151	maybe_paren(O, Prio, 41, C3, Co).
 1152write_oout(1, F, Term, Style, Prio, Ci, Co) :-
 1153	(   current_op(O, xf, F), P is O-1
 1154	;   current_op(O, yf, F), P = O
 1155	),  !,
 1156	maybe_paren(O, Prio, 40, Ci, C1),
 1157	arg(1, Term, A),
 1158	write_oout(A, Style, P, C1, C2),
 1159	write_atom(F, Style, C2, C3),
 1160	maybe_paren(O, Prio, 41, C3, Co).
 1161write_oout(2, F, Term, Style, Prio, Ci, Co) :-
 1162	(   current_op(O, xfy, F), P is O-1, Q = O
 1163	;   current_op(O, xfx, F), P is O-1, Q = P
 1164	;   current_op(O, yfx, F), Q is O-1, P = O
 1165	),  !,
 1166	maybe_paren(O, Prio, 40, Ci, C1),
 1167	arg(1, Term, A),
 1168	write_oout(A, Style, P, C1, C2),
 1169	write_oper(F, O, Style, C2, C3),
 1170	arg(2, Term, B),
 1171	write_oout(B, Style, Q, C3, C4),
 1172	maybe_paren(O, Prio, 41, C4, Co).
 1173write_oout(N, F, Term, Style, _Prio, Ci, punct) :-
 1174	write_atom(F, Style, Ci, _),
 1175	write_args(0, N, Term, 40, Style).
 write_oper(?ARG1, ?ARG2, ?ARG3, ?ARG4, ?ARG5) is det
Write Oper.
 1185write_oper(Op, Prio, Style, Ci, Co) :-
 1186	Prio < 700, !,
 1187	write_atom(Op, Style, Ci, Co).
 1188write_oper(Op, _, Style, _Ci, punct) :-
 1189	put(32),
 1190	write_atom(Op, Style, punct, _),
 1191	put(32).
 write_VAR(?ARG1, ?ARG2, ?ARG3, ?ARG4) is det
Write Var.
 1200write_VAR(A, _Style, _Ci, _Co) :- atom(A), !,write(A).
 1201write_VAR(N, writeq, _Ci, alpha):- writeq('$VAR'(N)),!.
 1202write_VAR(X, Style, Ci, punct) :-
 1203	write_atom('$VAR', Style, Ci, _),
 1204	write_args(0, 1, '$VAR'(X), 40, Style).
 write_atom(?ARG1, ?ARG2, ?ARG3, ?ARG4) is det
Write Atom.
 1214write_atom(('!'), _, _, punct) :- !,
 1215	put(33).
 1216write_atom((';'), _, _, punct) :- !,
 1217	put(59).
 1218write_atom([], _, _, punct) :- !,
 1219	put(91), put(93).
 1220write_atom({}, _, _, punct) :- !,
 1221	put(123), put(125).
 1222write_atom(A, write, _Ci, _Co):- !,write(A),!.
 1223write_atom(A, _Style, _Ci, _Co):- write_atom_link(A,A),!.
 1224write_atom(Atom, Style, Ci, Co) :-
 1225	name(Atom, String),
 1226	(   classify_name(String, Co),
 1227	    maybe_space(Ci, Co),
 1228	    put_string(String)
 1229	;   Style = writeq, Co = quote,
 1230	    maybe_space(Ci, Co),
 1231	    (put(39), put_string(String, 39),put(39))
 1232	;   Co = alpha,
 1233	    put_string(String)
 1234	),  !.
 1235
 1236
 1237
 1238%txt_to_codes(Text,Codes):- text_to_string(Text,Str),name(Str,Codes).
 put_string(?ARG1) is det
writes a list of character codes.
 1244put_string(B):- txt_to_codes(B,C),put_string0(C).
 put_string0(:TermARG1) is det
Put String Primary Helper.
 1252put_string0([]).
 1253put_string0([H|T]) :-
 1254	put(H),
 1255	put_string0(T).
 put_string(S, Q)
writes a quoted list of character codes, where the first quote has already been written. Instances of Q in S are doubled.
 1261put_string(A,B):- is_html_mode,!,
 1262  with_output_to(atom(S),put_string2(A,B)),
 1263  url_iri(URL,S),bformat('<a href="?find=~w">~w</a>',[URL,S]).
 1264put_string(A,B):- put_string2(A,B).
 1265
 1266
 1267put_string2(A,B):- txt_to_codes(A,C),to_ascii_code(B,BC),put_string0(C,BC).
 1268to_ascii_code(B,BC):- (number(B)->BC=B;name(B,[BC|_])).
 1269
 1270% :-rtrace.
 put_string0(:TermARG1, ?ARG2) is det
Put String Primary Helper.
 1278put_string0([], _) :- !. % put(Q).
 1279put_string0([Q|T], Q) :- !,
 1280	put(Q), put(Q),
 1281	put_string0(T, Q).
 1282put_string0([H|T], Q) :-
 1283	put(H),
 1284	put_string0(T, Q).
 classify_name(String, Co)
says whether a String is an alphabetic identifier starting with a lower case letter (Co=alpha) or a string of symbol characters like ++/=? (Co=other). If it is neither of these, it fails. That means that the name needs quoting. The special atoms ! ; [] {} are handled directly in write_atom. In a basic Prolog system with no way of changing the character classes this information can be calculated when an atom is created, andf just looked up. This has to be as fast as you can make it.
 1296classify_name([H|T], alpha) :-
 1297	H >= 97, H =< 122,
 1298	!,
 1299	classify_alpha_tail(T).
 1300classify_name([H|T], other) :-
 1301	memberchk(H, "#$&=-~^\`@+*:<>./?"),
 1302	classify_other_tail(T).
 classify_alpha_tail(:TermARG1) is det
Classify Alpha Tail.
 1311classify_alpha_tail([]).
 1312classify_alpha_tail([H|T]) :-
 1313	(  H >= 97, H =< 122
 1314	;  H >= 65, H =< 90
 1315	;  H >= 48, H =< 57
 1316	;  H =:= 95
 1317	), !,
 1318	classify_alpha_tail(T).
 classify_other_tail(:TermARG1) is det
Classify Other Tail.
 1327classify_other_tail([]).
 1328classify_other_tail([H|T]) :-
 1329	memberchk(H, "#$&=-~^\`@+*:<>./?"),
 1330	classify_other_tail(T).
 1331
 1332
 1333
 1334%   write_args(DoneSoFar, Arity, Term, Separator, Style)
 1335%   writes the remaining arguments of a Term with Arity arguments
 1336%   all told in Style, given that DoneSoFar have already been written.
 1337%   Separator is 0'( initially and later 0', .
 write_args(?ARG1, ?ARG2, ?ARG3, ?ARG4, ?ARG5) is det
Write Arguments.
 1346write_args(N, N, _, _, _) :- !,
 1347	put(41).
 1348write_args(I, N, Term, C, Style) :-
 1349	put(C),
 1350	J is I+1,
 1351	arg(J, Term, A),
 1352	write_oout(A, Style, 999, punct, _),
 1353	write_args(J, N, Term, 44, Style).
 1354
 1355
 1356
 1357%   write_tail(Tail, Style)
 1358%   writes the tail of a list of a given style.
 write_tail(:TermARG1, ?ARG2) is det
Write Tail.
 1367write_tail(Var, _) :-			%  |var]
 1368	var(Var),
 1369	!,
 1370	put(124),
 1371	write_variable(Var),
 1372	put(93).
 1373write_tail([], _) :- !,			%  ]
 1374	put(93).
 1375write_tail([Head|Tail], Style) :- !,	%  ,Head tail
 1376	put(44),
 1377	write_oout(Head, Style, 999, punct, _),
 1378        
 1379	write_tail(Tail, Style).
 1380write_tail(Other, Style) :-		%  |junk]
 1381	put(124),
 1382	write_oout(Other, Style, 999, punct, _),
 1383	put(93).
 1384
 1385
 1386/*  The listing/0 and listing/1 commands are based on the Dec-10
 1387    commands, but the bformat they generate is based on the "pp" command.
 1388    The idea of rok_portray_clause/1 came from PDP-11 Prolog.
 1389
 1390    BUG: the arguments of goals are not separated by comma-space but by
 1391    just comma.  This should be fixed, but I haven't the time right not.
 1392    Run the output through COMMA.EM if you really care.
 1393
 1394    An irritating fact is that we can't guess reliably which clauses
 1395    were grammar rules, so we can't print them out in grammar rule form.
 1396
 1397    We need a proper pretty-printer that takes the line width into
 1398    acount, but it really isn't all that feasible in Dec-10 Prolog.
 1399    Perhaps we could use some ideas from NIL?
 1400*/
 portable_listing is det
Portable Listing.
 1409portable_listing :-
 1410	current_predicate(_, M:Pred),
 1411        \+ predicate_property(M:Pred,imported_from(_)),
 1412        predicate_property(M:Pred,number_of_clauses(_)),        
 1413	nl,
 1414	forall(clause(M:Pred, Body),rok_portray_clause((M:Pred:-Body))),
 1415        fail.
 1416portable_listing.
 1417
 1418
 1419%   listing(PredSpecs)
 1420
 1421%   Takes a predicate specifier F/N, a partial specifier F, or a
 1422%   list of such things, and lists each current_predicate Pred
 1423%   matching one of these specifications.
 portable_listing(:TermARG1) is det
Portable Listing.
 1432portable_listing(V) :-
 1433	var(V), !.       % ignore variables
 1434portable_listing([]) :- !.
 1435portable_listing([X|Rest]) :- !,
 1436	portable_listing(X),
 1437	portable_listing(Rest).
 1438portable_listing(X) :-
 1439	'functor spec'(X, Name, Low, High),
 1440	current_predicate(Name, Pred),
 1441	functor(Pred, _, N),
 1442	N >= Low, N =< High,
 1443	nl, 
 1444	clause(Pred, Body),
 1445	rok_portray_clause((Pred:-Body)),
 1446	fail.
 1447portable_listing(_).
Functor Spec.
 1456'functor spec'(Name/Low-High, Name, Low, High) :- !.
 1457'functor spec'(Name/Arity, Name, Arity, Arity) :- !.
 1458'functor spec'(Name, Name, 0, 255).
 rok_portray_clause(:TermARG1) is det
Rok Portray Clause.
 1468rok_portray_clause(Var):- var(Var),writeq(Var).
 1469
 1470rok_portray_clause(I):- catch(make_pretty(I,O),_,I=O),block_format(rok_portray_clause1(O)).
 1471
 1472rok_portray_clause1( :-(Command)) :- 
 1473	(   Command = public(Body), Key = (public)
 1474	;   Command = mode(Body),   Key = (mode)
 1475	;   Command = type(Body),   Key = (type)
 1476	;   Command = pred(Body),   Key = (pred)
 1477	;   Command = Body,	    Key = ''
 1478	),  !,
 1479	nl,
 1480	% nu mbervars(Body, 0, _),
 1481	\+ \+ 'list clauses'(Body, Key, 2, 8),!.
 1482rok_portray_clause1(M:(Pred:-Body)) :- !,
 1483     must_run((
 1484	% nu mbervars(Pred+Body, 0, _),
 1485	\+ \+ portable_writeq(M:Pred),
 1486	\+ \+ 'list clauses'(Body, 0, 2, 8))), !.
 1487rok_portray_clause1((Pred:-Body)) :- !,
 1488     must_run((
 1489	% nu mbervars(Pred+Body, 0, _),
 1490	\+ \+ portable_writeq(Pred),
 1491	\+ \+ 'list clauses'(Body, 0, 2, 8))), !.
 1492rok_portray_clause1(M:(Pred)) :- 
 1493	call(call,rok_portray_clause1((M:Pred:-true))).
 1494rok_portray_clause1((Pred)) :- !,
 1495	call(call,rok_portray_clause1((Pred:-true))).
List Clauses.
 1502'list clauses'((A,B), L, R, D) :- !,
 1503	'list clauses'(A, L, 1, D), !,
 1504	'list clauses'(B, 1, R, D).
 1505'list clauses'(true, _L, 2, _D) :- !,
 1506	put(0'.
 1507        ), nl.
 1508        
 1509'list clauses'((A;B), L, R, D) :- !,
 1510	'list magic'(fail, L, D),
 1511	'list magic'((A;B), 0, 2, D),
 1512	'list magic'(R, '.
 1513'
 1514).
 1515
 1516'list clauses'((A->B), L, R, D) :- !,
 1517	'list clauses'(A, L, 5, D), !,
 1518	'list clauses'(B, 5, R, D).
 1519'list clauses'(Goal, L, R, D) :-
 1520	'list magic'(Goal, L, D),
 1521	portable_writeq(Goal),
 1522	'list magic'(R, '.
 1523'
 1524).
List Magic.
 1533'list magic'(!,    0, _D) :- !,
 1534	write(' :- ').
 1535'list magic'(!,    1, _D) :- !,
 1536	write(',  ').
 1537'list magic'(_Goal, 0, D) :- !,
 1538	write(' :- '),
 1539	nl, tab(D).
 1540'list magic'(_Goal, 1, D) :- !,
 1541	put(0',
 1542        ),
 1543	nl, tab(D).
 1544'list magic'(_Goal, 3, _D) :- !,
 1545	write('(   ').
 1546'list magic'(_Goal, 4, _D) :- !,
 1547	write(';   ').
 1548'list magic'(_Goal, 5, D) :- !,
 1549	write(' ->'),
 1550	nl, tab(D).
 1551'list magic'(_Goal, Key, D) :-
 1552	atom(Key),
 1553	write(':- '), write(Key),
 1554	nl, tab(D).
List Magic.
 1564'list magic'(2, C) :- !, write(C).
 1565'list magic'(_, _).
List Magic.
 1575'list magic'((A;B), L, R, D) :- !,
 1576	'list magic'(A, L, 1, D), !,
 1577	'list magic'(B, 1, R, D).
 1578'list magic'(Conj,  L, R, D) :-
 1579	E is D+8,
 1580	M is L+3,
 1581	'list clauses'(Conj, M, 1, E),
 1582	nl, tab(D),
 1583	'list magic'(R, ')').
 1584
 1585
 1586/*	Test code for rok_portray_clause.
 1587	If it works, test_portray_clause(File) should write out the
 1588	contents of File in a more or less readable fashion.
 1589
 1590test_portray_clause(File) :-
 1591	see(File),
 1592	repeat,
 1593	    read(Clause, Vars),
 1594	    (   Clause = end_of_file
 1595	    ;   test_bind(Vars), rok_portray_clause(Clause), fail
 1596	    ),
 1597	!,
 1598	seen.
 1599
 1600test_bind([]) :- !.
 1601test_bind([X='$VAR'(X)|L]) :-
 1602	test_bind(L).
 1603:- public test_portray_clause/1.
 1604*/
 1605
 1606
 1607
 1608
 1609
 1610
 1611
 1612
 1613
 1614% '$messages':baseKB:my_portray(X):-fail,loop_check(baseKB:my_portray(X)).
 1615% user:portray(X):-loop_check(baseKB:my_portray(X)).
 1616/*
 1617:- dynamic user:portray/1.
 1618:- multifile user:portray/1.
 1619:- discontiguous my_portray/1. 
 1620:- export(baseKB:my_portray/1).
 1621baseKB:my_portray(A) :- var(A),!,fail,writeq(A).
 1622baseKB:my_portray(A) :-
 1623        atom(A),
 1624        sub_atom(A, 0, _, _, 'http://'), !,
 1625        (   style(B)
 1626        ->  true
 1627        ;   B=prefix:id
 1628        ),
 1629        portray_url(B, A).
 1630baseKB:my_portray(A) :-
 1631        atom(A),
 1632        atom_concat('__file://', B, A),
 1633        sub_atom(B, D, _, C, #),
 1634        sub_atom(B, _, C, 0, G),
 1635        sub_atom(B, 0, D, _, E),
 1636        file_base_name(E, F),
 1637        bformat('__~w#~w', [F, G]).
 1638baseKB:my_portray(A) :- atom(A),!,baseKB:write_atom_link(A,A).
 1639baseKB:my_portray(A) :- \+compound(A),fail.
 1640%baseKB:my_portray(P):- must_run((return_to_pos(rok_portray_clause(P)),!)).
 1641*/
 1642
 1643
 1644
 1645
 1646is_html_mode:- \+ get_print_mode(text).
 sanity_test_000 is det
Optional Sanity Checking test Primary Helper Primary Helper Primary Helper.
 1653sanity_test_000:- find_and_call((rok_portray_clause((
 1654pkif :-
 1655
 1656        [ implies,
 1657
 1658          [ isa(F, tPred),
 1659            isa(A, ftInt),
 1660            poss(KB, pos([arity(F, A)])),
 1661            poss(KB, arity(F, A))
 1662          ],
 1663          =>,
 1664
 1665          [ all([F]),
 1666
 1667            [ implies,
 1668              [isa(F, tPred), ex([A]), isa(A, ftInt), poss(KB, arity(F, A))],
 1669              =>,
 1670              [ex([A]), [isa(A, ftInt), arity(F, A)]]
 1671            ]
 1672          ]
 1673        ])))),nl,nl,nl.
 1674
 1675
 1676
 1677x123:- locally_tl(print_mode(html),xlisting_inner(i2tml_hbr,end_of_file,[])).
 param_matches(?ARG1, ?ARG2) is det
Param Matches.
 1684param_matches(A,B):-A=B,!.
 1685param_matches(VV,V):-atomic(VV),atomic(V),string_to_atom(VV,VVA),string_to_atom(V,VA),downcase_atom(VVA,VD),downcase_atom(VA,VD).
 1686param_matches(A,B):-A=B,!.
 show_select2(?ARG1, ?ARG2, ?ARG3) is det
Show Select Extended Helper.
 1695show_select2(Name,Pred,Options):- block_format(show_select22(Name,Pred,Options)).
 1696show_select22(Name,Pred,Options):-  
 1697    Call=..[Pred,ID,Value],
 1698    must_run(param_default_value(Name,D); param_default_value(Pred,D)),!,
 1699    get_param_sess(Name,UValue,D),
 1700    format('<select name="~w">',[Name]),
 1701    forall(no_repeats(Call),
 1702       (((member(atom_subst(Item,ItemName),Options) -> (any_to_string(Value,ValueS),atom_subst(ValueS,Item,ItemName,NValue)); NValue=Value),
 1703        (((param_matches(UValue,ID);param_matches(UValue,NValue)) -> format('<option value="~w" selected="yes">~w</option>',[ID,NValue]);
 1704                   format('<option value="~w">~w</option>',[ID,Value])))))),
 1705    format('</select>',[]),!.
 show_select1(?ARG1, ?ARG2) is det
Show Select Secondary Helper.
 1713show_select1(Name,Pred):- block_format(show_select11(Name,Pred)).
 1714show_select11(Name,Pred):-
 1715 Call=..[Pred,Value],
 1716 ( param_default_value(Name,D); param_default_value(Pred,D)),!,
 1717 format('<select name="~w">',[Name]),
 1718 forall(Call,
 1719    (get_param_sess(Name,Value,D)->format('<option value="~w" selected="yes">~w</option>',[Value,Value]);
 1720                format('<option value="~w">~w</option>',[Value,Value]))),
 1721 format('</select>',[]),!.
 as_ftVars(:TermARG1) is det
Converted To Format Type Variables.
 1731as_ftVars(N='$VAR'(N)):-atomic(N),!.
 1732as_ftVars(_N=_V).
 1733as_ftVars(_).
 1734
 1735% :- ensure_loaded(library(logicmoo/util/logicmoo_util_varnames)).
 1736
 1737% :- use_listing_vars.
 search4term is det
Search4term.
 1745search4term:- must_run((
 1746  maybe_scan_for_varnames,
 1747  get_param_sess(term,Term,"tHumanHead"),
 1748  get_param_sess(find,SObj,Term),
 1749  cvt_param_to_term(SObj,Obj),
 1750  call_for_terms(make_page_pretext_obj(Obj)))),!.
 edit1term is det
Edit1term.
 1760edit1term:- get_param_req(xref,'Overlap'),!,search4term.
 1761
 1762edit1term:-  
 1763  get_param_req('ASK','ASK'),!,
 1764  www_main_error_to_out(
 1765   must_run((
 1766   get_param_sess(term,String,""),
 1767   cvt_param_to_term(String,Term,VNs),
 1768   save_in_session(find,Term),
 1769   % call_for_terms
 1770   edit1term(forall(Term,pp_item_html('Answer',':-'(VNs,Term))))))),!.
 1771  
 1772edit1term:- 
 1773  get_param_req('TELL','TELL'),!,
 1774  www_main_error_to_out(
 1775   must_run((
 1776   get_param_sess(term,String,""),
 1777   cvt_param_to_term(String,Term,VNs),
 1778   save_in_session(find,Term),
 1779   maplist(as_ftVars,VNs),
 1780   call_for_terms(forall(ain(Term),pp_item_html('Assert',':-'(VNs,Term))))))),!.
 1781  
 1782edit1term:- 
 1783  get_param_req('RETRACT','RETRACT'),!,
 1784  www_main_error_to_out(
 1785   must_run((
 1786   get_param_sess(term,String,""),
 1787   cvt_param_to_term(String,Term,VNs),
 1788   save_in_session(find,Term),
 1789   maplist(as_ftVars,VNs),
 1790   call_for_terms(forall(mpred_withdraw(Term),pp_item_html('Retract',':-'(VNs,Term))))))),!.
 1791  
 1792edit1term:- 
 1793 must_run((
 1794             reset_assertion_display,
 1795             get_param_sess(term,String,""),get_param_sess(find,Word,""),term_to_pretty_string(Word,SWord),
 1796                save_in_session(find,Word),
 1797   show_edit_term(true,String,SWord))),!,
 1798 show_iframe(search4term,find,SWord).
 edit1term(:GoalARG1) is det
Edit1term.
 1807edit1term(Call):-
 1808 must_run((
 1809             reset_assertion_display,
 1810             get_param_sess(term,String,""),get_param_sess(find,Word,""),term_to_pretty_string(Word,SWord),save_in_session(find,Word),
 1811   show_edit_term(Call,String,SWord))),!.
 show_edit_term(:GoalARG1, ?ARG2, ?ARG3) is det
Show Edit Term.
 1821show_edit_term(Call,String,_SWord):- cvt_param_to_term(String,T),compound(T),T=(H:-_),!,show_edit_term0(Call,String,H).
 1822show_edit_term(Call,String,SWord):- show_edit_term0(Call,String,SWord),!.
 show_edit_term0(:GoalARG1, ?ARG2, ?ARG3) is det
Show Edit Term Primary Helper.
 1831show_edit_term0(Call,String,SWord):-atomic(SWord),cvt_param_to_term(SWord,T),nonvar(T),!,show_edit_term1(Call,String,T).
 1832show_edit_term0(Call,String,SWord):-show_edit_term1(Call,String,SWord).
 1833
 1834
 1835ensure_guitracer_x:-!.
 1836ensure_guitracer_x:- break,
 1837 absolute_file_name(swi(xpce/prolog/lib),X), assert_if_new(user:library_directory(X)), 
 1838 user:use_module(library(pce_prolog_xref)),
 1839 user:use_module(library(emacs_extend)),
 1840 user:use_module(library(trace/gui)),
 1841 user:use_module(library(pce)),
 1842 user:use_module(library(gui_tracer)),
 1843 reload_library_index.
 do_guitracer is det
Do Guitracer.
 1850do_guitracer:- ensure_guitracer_x, guitracer,dtrace.
 1851
 1852output_telnet_console(Port):- HttpPort is Port +100,
 1853  sformat(HTML,'<iframe id="port~w" src="http://logicmoo.org:~w/" height="600" width="100%">loading...</iframe>',[HttpPort,HttpPort]),
 1854  write_html(HTML).
 1855output_telnet_console2(Port):- HttpPort is Port +100,
 1856  sformat(HTML,'<iframe id="port~w" src="http://logicmoo.org:~w/" height="80%" width="100%">loading...</iframe>',[HttpPort,HttpPort]),
 1857  write_html(HTML).
 1858
 1859
 1860output_html(Var):- var(Var),!,term_to_atom(Var,Atom),output_html(pre([Atom])).
 1861%output_html(html(HTML)):- !,output_html(HTML). %output_html(HTML):- atomic(HTML),!,write_html(HTML). %output_html(HTML):- is_list(HTML),send_tokens(HTML).
 1862output_html(HTML):- phrase(html(HTML), Tokens,[]),!,send_tokens(Tokens).
 1863
 1864remove_if_last(Tokens,TokensRight,TokensLeft):-append(TokensLeft,TokensRight,Tokens),!.
 1865remove_if_last(TokensRightLeft,_,TokensRightLeft).
 1866
 1867send_tokens(['<',html,'>'|Tokens]):-!,remove_if_last(Tokens,['</',html,'>'],TokensLeft),send_tokens_1(TokensLeft).
 1868send_tokens(Tokens):- send_tokens_1(Tokens).
 1869send_tokens_1([nl(1)|Tokens]):-!,remove_if_last(Tokens,[nl(1)],TokensLeft),send_tokens(TokensLeft).
 1870send_tokens_1(Tokens):- with_output_to(string(HTMLString), html_write:print_html(Tokens)),write_html(HTMLString).
 1871
 1872%write_html(HTMLString):- ((pengines:pengine_self(_) -> pengines:pengine_output(HTMLString) ;write(HTMLString))),!.
 1873write_html(HTMLString):- (nb_current('$in_swish',t) -> pengines:pengine_output(HTMLString) ; bformat(HTMLString)).
 1874
 1875%write_html(HTML):- phrase(html(HTML), Tokens), html_write:print_html(Out, Tokens))).
 1876% output_html(html([div([id('cp-menu'), class(menu)], cp_skin: cp_logo_and_menu)]))
 1877show_map_legend :- write_html(
 1878'<table border=0 cellpadding=5 bgcolor="#000000"><tr><td>
 1879<pre><div style="background-color:#000000;float:left"><code><font size=2 face="Courier New, FixedSys, Lucida Console, Courier New, Courier"><font color="#0">
 1880</font><font color="#C0C0C0">The map key is:
 1881
 1882        </font><font color="#FF00FF">#</font><font color="#C0C0C0">  - You                         --- - North/south wall
 1883        </font><font color="#FF0000">*</font><font color="#C0C0C0">  - Other players                |  - East/west wall
 1884        </font><font color="#FFFF00">!</font><font color="#C0C0C0">  - Mobiles                      +  - Door (closed)
 1885        </font><font color="#00FFFF">!</font><font color="#C0C0C0">  - Pet/other charmed mob        </font><font color="#0000FF">+</font><font color="#C0C0C0">  - Door (locked)
 1886        </font><font color="#FF0000">!</font><font color="#C0C0C0">  - Angry mob (with Sense        &gt;  - Up exit
 1887             Anger cast)                  </font><font color="#808000">&gt;</font><font color="#C0C0C0">  - Up exit (closed)
 1888        </font><font color="#00FF00">!</font><font color="#C0C0C0">  - Unkillable Mob               &lt;  - Down exit
 1889        </font><font color="#00FF00">$</font><font color="#C0C0C0">  - Shopkeeper                   </font><font color="#808000">&lt;</font><font color="#C0C0C0">  - Down exit (closed)
 1890       </font><font color="#00FFFF">[</font><font color="#FFFFFF">?</font><font color="#00FFFF">]</font><font color="#C0C0C0"> - Area exit                    </font><font color="#800000">#</font><font color="#C0C0C0">  - PK-flagged room             
 1891       </font><font color="#00FF00">[</font><font color="#FFFFFF">?</font><font color="#00FF00">]</font><font color="#C0C0C0"> - Clan public hall exit        </font><font color="#FF0000">D</font><font color="#C0C0C0">  - Donation room
 1892
 1893Other characters on the map represent the terrain of the local area. Some 
 1894of the major terrains are:
 1895
 1896        [</font><font color="#FF00FF"> </font><font color="#C0C0C0">]   Inside             .</font><font color="#FF00FF"> </font><font color="#C0C0C0">.   City
 1897        </font><font color="#008000">,</font><font color="#FF00FF"> </font><font color="#008000">`</font><font color="#C0C0C0">   Field              </font><font color="#00FF00">;</font><font color="#FF00FF"> </font><font color="#00FF00">;</font><font color="#C0C0C0">   Hills
 1898        </font><font color="#808000">/</font><font color="#FF00FF"> </font><font color="#808000">\\</font><font color="#C0C0C0">   Mountain           </font><font color="#0000FF">~</font><font color="#FF00FF"> </font><font color="#0000FF">~</font><font color="#C0C0C0">   Water
 1899        </font><font color="#0000FF">~</font><font color="#FF00FF"> </font><font color="#0000FF">~</font><font color="#C0C0C0">   Waternoswim        </font><font color="#008080">.</font><font color="#FF00FF"> </font><font color="#008080">.</font><font color="#C0C0C0">   Air
 1900        </font><font color="#808000">~</font><font color="#FF00FF"> </font><font color="#808000">~</font><font color="#C0C0C0">   Desert             </font><font color="#FFFF00">%</font><font color="#FF00FF"> </font><font color="#FFFF00">%</font><font color="#C0C0C0">   Quicksand
 1901        </font><font color="#000080">~</font><font color="#FF00FF"> </font><font color="#000080">~</font><font color="#C0C0C0">   Underwater         </font><font color="#00FFFF">~</font><font color="#FF00FF"> </font><font color="#00FFFF">~</font><font color="#C0C0C0">   Ice
 1902        </font><font color="#0000FF">.</font><font color="#FF00FF"> </font><font color="#0000FF">.</font><font color="#C0C0C0">   Underground        -</font><font color="#FF00FF"> </font><font color="#C0C0C0">-   East/West road
 1903        . .   North/South road   </font><font color="#00FFFF">~ ~</font><font color="#C0C0C0">   River
 1904        </font><font color="#FF0000">/</font><font color="#FF00FF"> </font><font color="#FF0000">\\</font><font color="#C0C0C0">   Volcano            </font><font color="#000080">%</font><font color="#FF00FF"> </font><font color="#000080">%</font><font color="#C0C0C0">   Cave
 1905        # #   Dungeon            </font><font color="#008000">( *</font><font color="#C0C0C0">   Forest
 1906
 1907Other terrain types not listed here are for aesthetic purposes only, such
 1908as </font><font color="#008080">[ ]</font><font color="#C0C0C0"> for temples, </font><font color="#FFFF00">* *</font><font color="#C0C0C0"> for shops, etc.
 1909</font></font></code></div></pre></td></tr></table>'),!.
 show_edit_term1(:GoalARG1, ?ARG2, ?ARG3) is det
Show Edit Term Secondary Helper.
 1916show_edit_term1(Call,String,'=>'(P,Q)):-!,show_edit_term1(Call,String,(P;Q;'=>'(P,Q))),!.
 1917show_edit_term1(Call,String,SWord):- 
 1918 write_begin_html('edit1term',_BASE,URL),
!,
 1919   bformat('<br/><p>
 1920<table width="1111" cellspacing="0" cellpadding="0" height="121" id="table4">
 1921 <!-- MSTableType="nolayout" -->
 1922	<form action="edit1term">
 1923      <!-- MSTableType="nolayout" -->
 1924		<tr>
 1925          <td align="left" valign="top" width="36" rowspan="2"><img src="/pixmapx/sigmaSymbol-gray.gif"></td>
 1926          <td></td>
 1927          <td align="left" valign="top" width="711" rowspan="2">
 1928          <img src="/pixmapx/logoText-gray.gif">&nbsp;&nbsp;Prover:&nbsp; ~@
 1929                   <table cellspacing="0" cellpadding="0" id="table5" width="658" height="97">
 1930      <!-- MSTableType="nolayout" -->
 1931	<tr>
 1932          <td align="right"><b>Fml:</b></td>
 1933          <td align="left" valign="top" colspan="2">
 1934              <textarea style="white-space: pre; overflow: auto; font-size: 7pt; font-weight: bold; font-family: Verdana, Arial, Helvetica, sans-serif;border: 1px solid black;"
 1935               wrap="off" rows="10" cols="70" name="term">~w</textarea>
 1936          </td>
 1937          <td align="left" valign="top" height="68">~@
 1938             <br><b>Microthory</b><br>~@<br/><input type="submit" value="ASK" name="ASK"><input type="submit" value="TELL" name="TELL"><input type="submit" value="RETRACT" name="RETRACT">
 1939             <br><b>Formal Language</b><br>~@</td>
 1940      </tr>
 1941        <tr><td><img src="/pixmapx/1pixel.gif" height="3"></td>
 1942      		<td></td>
 1943			<td></td>
 1944			<td height="3"></td>
 1945            </tr>
 1946            <tr>
 1947                  <td align="right" width="99"><b>Search:&nbsp;</b></td>
 1948                  <td align="left" valign="top" width="276"><input type="text" size="27" name="find" value="~w">&nbsp;<input type="submit" value="Overlap" name="xref">&nbsp;</td>
 1949                  <td align="left" valign="top" width="144">~@&nbsp;<input type="submit" value="NatLg" name="ShowEnglish"></td>
 1950                  <td align="left" valign="top" height="26" width="139">~@</td>
 1951             </tr>
 1952            </table>
 1953          </td>
 1954          <td valign="bottom" width="9" rowspan="2"></td>
 1955          <td height="121" rowspan="2" width="163">
 1956          <span class="navlinks">
 1957          <b>[&nbsp;<a href="/">Home</a>&nbsp;|&nbsp;              
 1958          <a href="~w&Graph=true">Grap2h</a>]</b></span><p>
 1959          <b>Response&nbsp;Language&nbsp;<br></b>~@<p>
 1960                        <input type="checkbox" name="sExprs" value="1" checked>S-Exprs&nbsp;
 1961                        <input type="checkbox" name="webDebug" value="1" checked>Debugging
 1962                        </td>
 1963          <td height="121" rowspan="2" width="188"></td>
 1964      </tr>
 1965		<tr>
 1966			<td width="4">&nbsp;</td>
 1967		</tr>
 1968  </form></table><hr>'
 1969  ,[show_select2(prover,prover_name,[]),
 1970    String,
 1971    action_menu_applied('action_above',"Item",""),
 1972    show_select2('context',is_context,[]),
 1973    show_select2(flang,logic_lang_name,[]),
 1974    SWord,
 1975    %show_select2('POS',partOfSpeech,[]),
 1976    show_select1('humanLang',human_language),
 1977    URL,
 1978    show_select2(olang,logic_lang_name,[])]),!,   
 1979    bformat('<pre>',[]),
 1980    on_x_debug(Call),!,
 1981    bformat('</pre>',[]),
 1982   write_end_html,!.
 show_iframe(?ARG1, ?ARG2, ?ARG3) is det
Show Iframe.
 1991show_iframe(URL,Name,Value):- bformat('<iframe width="100%" height="800" frameborder="0" scrolling="yes" marginheight="0" marginwidth="0" allowtransparency=true id="main" name="main" style="width:100%;height:800" src="~w?~w= ~w"></iframe>',[URL,Name,Value]).
 show_iframe(?ARG1) is det
Show Iframe.
 1999show_iframe(URL):- bformat('<iframe width="100%" height="800" frameborder="0" scrolling="yes" marginheight="0" marginwidth="0" allowtransparency=true id="main" name="main" style="width:100%;height:800" src="search4term?find= ~w"></iframe>',[URL]).
 show_search_filtersTop(?ARG1) is det
Show Search Filters Top.
 2008show_search_filtersTop(BR):- write(BR).
 show_search_filters(?ARG1) is det
Show Search Filters.
 2017show_search_filters(BR):- 
 2018   forall(no_repeats(N=C,search_filter_name_comment(N,C,_)),session_checkbox(N,C,BR)).
 parameter_names(?ARG1, ?ARG2) is det
Parameter Names.
 2027parameter_names(List,N):-is_list(List),!,member(E,List),parameter_names(E,N).
 2028parameter_names(V,_):- var(V),!,fail.
 2029parameter_names(N=_,N):-!,atom(N).
 2030parameter_names(C,N):-compound(C),functor(C,N,1).
 current_form_var(?ARG1) is det
Current Form Variable.
 2039current_form_var(N):-no_repeats((current_form_var0(N))),atom(N),\+ arg(_,v(peer,idle,ip,session),N).
 current_form_var0(?ARG1) is det
Current Form Variable Primary Helper.
 2047current_form_var0(N):- param_default_value(N,_).
 2048%current_form_var0(N):- get_http_current_request(B),member(search(Parameters),B),parameter_names(Parameters,N).
 2049%current_form_var0(N):- http_current_session(_, Parameters),parameter_names(Parameters,N).
 is_goog_bot is det
If Is A Goog Bot.
 2058is_goog_bot:- get_http_current_request(B),member(user_agent(UA),B),!,atom_contains(UA,'Googlebot').
 pp_now is det
Pretty Print Now.
 2065pp_now.
 this_listing(:TermARG1) is det
This Listing.
 2074this_listing(M:F/A):-functor(H,F,A),predicate_property(M:H,number_of_causes(_)),!, forall(clause(M:H,Body),pp_i2tml((M:H :- Body))).
 2075this_listing(M:F/A):-functor(H,F,A),predicate_property(H,number_of_causes(_)),!, forall(clause(H,Body),pp_i2tml((M:H :- Body))).
 2076this_listing(M:F/A):-listing(M:F/A),!.
 2077this_listing(MFA):-listing(MFA).
 2078
 2079:- thread_local(sortme_buffer/2). 2080
 2081
 2082% i2tml_save(Obj,H):- \+ is_list(H),cyc:pterm_to_sterm(H,S),H\=@=S,!,i2tml_save(Obj,S).
 pp_i2tml_saved_done(?ARG1) is det
Pretty Print I2tml Saved Done.
 2091pp_i2tml_saved_done(_Obj):-pp_now,!,flush_output_safe.
 2092pp_i2tml_saved_done(Obj):-
 2093  findall(H,retract(sortme_buffer(Obj,H)),List),predsort(head_functor_sort,List,Set),
 2094  forall(member(S,Set),pp_i2tml(S)),!.
 find_cl_ref(:TermARG1, ?ARG2) is det
Find Clause Ref.
 2103find_cl_ref(_,none):- t_l:tl_hide_data(hideClauseInfo),!.
 2104find_cl_ref(clause(_,_,Ref),Ref):-!.
 2105find_cl_ref(clause(H,B),Ref):- clause(H,B,Ref),!.
 2106find_cl_ref((H:-B),Ref):-!, clause(H,B,Ref),clause(HH,BB,Ref),H=@=HH,B=@=BB,!.
 2107find_cl_ref(H,Ref):- clause(H,true,Ref),clause(HH,true,Ref),H=@=HH,!.
 find_ref(:TermARG1, ?ARG2) is det
Find Ref.
 2116find_ref(_,none):- t_l:tl_hide_data(hideClauseInfo),!.
 2117find_ref(H,Ref):- find_cl_ref(H,Ref),!.
 2118find_ref(This,Ref):- call(call,'$si$':'$was_imported_kb_content$'(A,CALL)),
 2119   arg(1,CALL,This),clause('$si$':'$was_imported_kb_content$'(A,CALL),true,Ref),!.
 2120find_ref(M:This,Ref):- atom(M),!,find_ref(This,Ref).
 head_functor_sort(?ARG1, ?ARG2, ?ARG3) is det
Head Functor Sort.
 2129head_functor_sort(Result,H1,H2):- (var(H1);var(H2)),compare(Result,H1,H2),!.
 2130head_functor_sort(Result,H1,H2):- once((get_functor(H1,F1,A1),get_functor(H2,F2,A2))),F1==F2,A1>0,A2>0,arg(1,H1,E1),arg(1,H2,E2),compare(Result,E1,E2),Result \== (=),!.
 2131head_functor_sort(Result,H1,H2):- once((get_functor(H1,F1,_),get_functor(H2,F2,_))),F1\==F2,compare(Result,F1,F2),Result \== (=),!.
 2132head_functor_sort(Result,H1,H2):-compare(Result,H1,H2),!.
 i2tml_hbr(?ARG1, ?ARG2, ?ARG3) is det
I2tml Hbr.
 2141i2tml_hbr(H,B,Ref):- nonvar(Ref),!,pp_i2tml_save_seen(clause(H,B,Ref)).
 2142i2tml_hbr(H,B,_):- B==true,!, pp_i2tml_save_seen(H).
 2143i2tml_hbr(H,B,_):- pp_i2tml_save_seen((H:-B)).
 pp_i2tml_save_seen(?ARG1) is det
Pretty Print I2tml Save Seen.
 2152pp_i2tml_save_seen(HB):- pp_now, !,must_run(pp_i2tml(HB)),!.
 2153pp_i2tml_save_seen(HB):- assertz_if_new(sortme_buffer(_Obj,HB)),!.
 2154
 2155
 2156:- thread_local(t_l:pp_i2tml_hook/1). 2157
 2158:- thread_local(t_l:tl_hide_data/1). 2159   
 2160:- thread_local(shown_subtype/1). 2161:- thread_local(xlw:shown_clause/1). 2162:- meta_predicate if_html(*,0).
 section_open(?ARG1) is det
Section Open.
 2173section_open(Type):-  once(shown_subtype(Type)->true;((is_html_mode->bformat('~n</pre><hr>~w<hr><pre>~n<font face="verdana,arial,sans-serif">',[Type]);(draw_line,format('% ~w~n~n',[Type]))),asserta(shown_subtype(Type)))),!.
 section_close(?ARG1) is det
Section Close.
 2181section_close(Type):- shown_subtype(Type)->(retractall(shown_subtype(Type)),(is_html_mode->bformat('</font>\n</pre><hr/><pre>',[]);draw_line));true.
 2182
 2183:- export((action_menu_applied/3,
 2184            %xaction_menu_item/2,
 2185            add_form_script/0,
 2186            register_logicmoo_browser/0,
 2187            as_ftVars/1,
 2188            call_for_terms/1,
 2189            classify_alpha_tail/1,
 2190            classify_name/2,
 2191            classify_other_tail/1,
 2192            current_form_var/1,
 2193            current_line_position/1,
 2194            current_line_position/2,
 2195            cvt_param_to_term/2,
 2196            cvt_param_to_term/3,
 2197            do_guitracer/0,
 2198            edit1term/0,
 2199            edit1term/1,
 2200            ensure_sigma/1,
 2201            %get_print_mode/1,               
 2202            ensure_sigma/0,
 2203            find_cl_ref/2,
 2204            find_ref/2,
 2205            fmtimg/2,
 2206            'functor spec'/4,
 2207            functor_to_color/2,
 2208            functor_to_color/4,
 2209            
 2210            get_http_current_request/1,
 2211            get_http_session/1,
 2212            get_nv_session/3,
 2213            get_param_req/2,
 2214            get_param_sess/2,
 2215            get_param_sess/3,
 2216            get_request_vars/1,
 2217            handler_logicmoo_cyclone/1,
 2218            head_functor_sort/3,
 2219            must_run/1,
 2220            human_language/1,
 2221            i2tml_hbr/3,
 2222            if_html/2,
 2223            indent_nbsp/1,
 2224            indent_nbsp/2,
 2225            indent_nl/0,
 2226            is_cgi_stream/0,
 2227            is_context/2,
 2228            is_goog_bot/0,
 2229            'list clauses'/4,
 2230            'list magic'/2,
 2231            'list magic'/3,
 2232            'list magic'/4,
 2233            logic_lang_name/2,
 2234            make_page_pretext_obj/1,
 2235            make_quotable/2,
 2236            make_session/1,
 2237            maybe_paren/5,
 2238            maybe_space/2,
 2239            member_open/2,
 2240            merge_key_vals/3,
 2241            name_the_var/5,
 2242            nl_same_pos/0,
 2243            numberlist_at/2,
 2244            object_sub_page/4,
 2245            % param_default_value/2,
 2246            param_matches/2,
 2247            parameter_names/2,
 2248            %partOfSpeech/2,
 2249            portable_display/1,
 2250            portable_listing/0,
 2251            portable_listing/1,
 2252            portable_print/1,
 2253            portable_write/1,
 2254            portable_writeq/1,
 2255            pp_i2tml/1,
 2256            pp_i2tml_now/1,
 2257            pp_i2tml_save_seen/1,
 2258            pp_i2tml_saved_done/1,
 2259            pp_i2tml_v/1,
 2260            pp_item_html/2,
 2261            pp_item_html_if_in_range/2,
 2262            pp_item_html_now/2,
 2263            pp_now/0,
 2264            print_request/1,
 2265            prover_name/2,
 2266            put_string/1,
 2267            put_string/2,
 2268            reply_object_sub_page/1,
 2269            reset_assertion_display/0,
 2270            return_to_pos/1,
 2271            rok_portray_clause/1,
 2272            save_in_session/1,
 2273            save_in_session/2,
 2274            save_in_session/3,
 2275            save_request_in_session/1,
 2276            search4term/0,
 2277            search_filter_name_comment/3,
 2278            section_close/1,
 2279            section_open/1,
 2280            sensical_nonvar/1,
 2281            session_checkbox/3,
 2282            session_checked/1,
 2283            set_line_pos/1,
 2284            set_line_pos/2,
 2285            show_clause_ref/1,
 2286            show_clause_ref_now/1,
 2287            show_edit_term/3,
 2288               show_http_session/0,
 2289            show_iframe/1,
 2290            show_iframe/3,
 2291            show_pcall_footer/0,
 2292            show_search_filters/1,
 2293            show_search_filtersTop/1,
 2294            term_to_pretty_string/2,
 2295            this_listing/1,
 2296            test_tmw/0,
 2297            tovl/3,
 2298            url_decode/2,
 2299            url_decode_term/2,
 2300            url_encode/2,
 2301            url_encode_term/3,
 2302            with_search_filters/1,
 2303            with_search_filters0/1,
 2304            write_VAR/4,
 2305            write_args/5,
 2306            write_as_url_encoded/2,
 2307            write_atom/4,
 2308            write_atom_link/1,
 2309            write_atom_link/2,
 2310            write_atom_link/3,
 2311            write_begin_html/3,
 2312            write_end_html/0,
 2313            write_oper/5,
 2314            write_out/5,
 2315            write_oout/7,
 2316            write_tail/2,
 2317            write_term_to_atom_one/2,
 2318            write_variable/1,
 2319          
 2320          xlisting_web_file/0)).
 pp_item_html(?ARG1, ?ARG2) is det
Pretty Print Item HTML.
 2327pp_item_html(_Type,H):-var(H),!.
 2328pp_item_html(Type,done):-!,section_close(Type),!.
 2329pp_item_html(_,H):- xlw:shown_clause(H),!.
 2330pp_item_html(_,P):- is_hidden_pred(P),!.
 2331pp_item_html(Type,H):- \+ is_html_mode, pp_item_html_now(Type,H),!.
 2332pp_item_html(Type,H):- ignore((flag(matched_assertions,X,X),between(0,5000,X),pp_item_html_now(Type,H))).
 2333
 2334is_hidden_pred(M:P):-!, (is_listing_hidden(M); is_hidden_pred(P)).
 2335is_hidden_pred(P):- (is_listing_hidden(P); (compound(P),functor(P,F,A),(is_listing_hidden((F/A));is_listing_hidden((F))))),!.
 pp_item_html_now(?ARG1, ?ARG2) is det
Pretty Print Item HTML Now.
 2345pp_item_html_now(Type,H):-    
 2346   flag(matched_assertions,X,X+1),!,
 2347   pp_item_html_if_in_range(Type,H),!,
 2348   assert(xlw:shown_clause(H)),!.
 pp_item_html_if_in_range(?ARG1, ?ARG2) is det
Pretty Print Item HTML If In Range.
 2358pp_item_html_if_in_range(Type,H):- section_open(Type),!,pp_i2tml(H),!.
 2359
 2360:- thread_local(t_l:last_show_clause_ref/1). 2361:- thread_local(t_l:current_clause_ref/1).
 show_clause_ref(?ARG1) is det
Show Clause Ref.
 2371show_clause_ref(Ref):- Ref == none,!.
 2372show_clause_ref(Ref):- t_l:last_show_clause_ref(Ref),!.
 2373show_clause_ref(Ref):- retractall(t_l:last_show_clause_ref(_)),asserta(t_l:last_show_clause_ref(Ref)),on_x_debug(show_clause_ref_now(Ref)),!.
 show_clause_ref_now(:GoalARG1) is det
Show Clause Ref Now.
 2382show_clause_ref_now(_Ref):- is_listing_hidden(hideClauseRef),!.
 2383show_clause_ref_now(V):-var(V),!.
 2384show_clause_ref_now(0):-!.
 2385show_clause_ref_now(none):-!.
 2386show_clause_ref_now(Ref):- is_listing_hidden(showFilenames), \+ clause_property(Ref,predicate(_)),format('~N~p~N',[clref(Ref)]),!.
 2387% write_html(div(class(src_formats),a(href(EditLink), edit)])).
 2388show_clause_ref_now(Ref):- is_listing_hidden(showFilenames),clause_property(Ref,file(File)),ignore(clause_property(Ref,line_count(Line))),
 2389  ignore(clause_property(Ref,module(Module))),
 2390    bformat('<a href="/swish/filesystem/~w#L~w">@file:~w:~w</a>(~w)~N',[File,Line,File,Line,Module]),
 2391    fail. 
 2392show_clause_ref_now(Ref):- clause_property(Ref,erased),
 2393  ignore(clause_property(Ref,module(Module))),
 2394    bformat('erased(~w) (~w)~N',[Ref,Module]),!.
 pp_i2tml(:TermARG1) is det
Pretty Print I2tml.
 2403pp_i2tml(Done):-Done==done,!.
 2404pp_i2tml(T):-var(T),!,format('~w~n',[T]),!.
 2405pp_i2tml(T):-string(T),!,format('"~w"~n',[T]).
 2406pp_i2tml(clause(H,B,Ref)):- !, locally_tl(current_clause_ref(Ref),pp_i2tml_v((H:-B))).
 2407pp_i2tml(HB):- find_ref(HB,Ref),!, must_run(locally_tl(current_clause_ref(Ref),pp_i2tml_v((HB)))).
 2408pp_i2tml(HB):- locally_tl(current_clause_ref(none),must_run(pp_i2tml_v((HB)))).
 numberlist_at(?ARG1, :TermARG2) is det
Numberlist When.
 2417numberlist_at(_,[]).
 2418numberlist_at(_,[N|More]):- number(N),!,N2 is N+1,numberlist_at(N2,More),!.
 2419numberlist_at(Was,[N|More]):-var(N),  N is Was+1, N2 is N+1,  numberlist_at(N2,More),!.
 2420numberlist_at(Was,[_|More]):- N2 is Was+2, numberlist_at(N2,More),!.
 2421
 2422
 2423
 2424
 2425%get_clause_vars_for_print_here(HB,HB2):- catch(get_clause_vars_for_print(HB,HB2),_,fail),!.
 2426get_clause_vars_for_print_here(HB,HB2):- make_pretty(HB,HB2),!.
 pp_i2tml_v(?ARG1) is det
Pretty Print I2tml V.
 2432pp_i2tml_v(HB):- ignore(catch(( \+ \+ ((get_clause_vars_for_print_here(HB,HB2),pp_i2tml_0(HB2)))),_,true)),!.
 pp_i2tml_0(:TermARG1) is det
Pretty Print i2tml Primary Helper.
 2441pp_i2tml_0(Var):-var(Var),!.
 2442pp_i2tml_0(USER:HB):-USER==user,!,pp_i2tml_0(HB),!.
 2443pp_i2tml_0((H :- B)):-B==true,!,pp_i2tml_0((H)),!.
 2444pp_i2tml_0(((USER:H) :- B)):-USER==user,!,pp_i2tml_0((H:-B)),!.
 2445pp_i2tml_0((H:-B)):-B==true, !, pp_i2tml_0(H).
 2446
 2447pp_i2tml_0(P):- is_listing_hidden(P),!.
 2448pp_i2tml_0(was_chain_rule(H)):- pp_i2tml_0(H).
 2449pp_i2tml_0(M:(H)):-M==user, pp_i2tml_0(H).
 2450pp_i2tml_0(is_edited_clause(H,B,A)):- pp_i2tml_0(proplst([(clause)=H,before=B,after=A])).
 2451pp_i2tml_0(is_disabled_clause(H)):- pp_i2tml_0((disabled)=H).
 2452
 2453
 2454% pp_i2tml_0(FET):-fully_expand(change(assert,html_gen),FET,NEWFET),FET\=@=NEWFET,!,pp_i2tml_0(NEWFET).
 2455
 2456pp_i2tml_0(spft(P,F,T,W)):-!,
 2457   locally_tl(current_why_source(W),pp_i2tml_0(spft(P,F,T))).
 2458
 2459pp_i2tml_0(spft(P,U,U)):- nonvar(U),!, pp_i2tml_1(P:-asserted_by(U)).
 2460pp_i2tml_0(spft(P,F,T)):- atom(F),atom(T),!, pp_i2tml_1(P:-asserted_in(F:T)).
 2461pp_i2tml_0(spft(P,F,T)):- atom(T),!,  pp_i2tml_1(((P):-  T:'t-deduced',F)). 
 2462pp_i2tml_0(spft(P,F,T)):- atom(F),!,  pp_i2tml_1(((P):-  F:'f-deduced',T)). 
 2463pp_i2tml_0(spft(P,F,T)):- !, pp_i2tml_1((P:- ( 'deduced-from'=F,  (rule_why = T)))).
 2464pp_i2tml_0(nt(_,Trigger,Test,Body)) :- !, pp_i2tml_1(proplst(['n-trigger'=Trigger , bformat=Test  ,  (body = (Body))])).
 2465pp_i2tml_0(pt(_,Trigger,Body)):-      pp_i2tml_1(proplst(['p-trigger'=Trigger , ( body = Body)])).
 2466pp_i2tml_0(bt(_,Trigger,Body)):-      pp_i2tml_1(proplst(['b-trigger'=Trigger ,  ( body = Body)])).
 2467
 2468pp_i2tml_0(proplst([N=V|Val])):- is_list(Val),!, pp_i2tml_1(N:-([clause=V|Val])).
 2469pp_i2tml_0(proplst(Val)):-!, pp_i2tml_1(:-(proplst(Val))).
 2470
 2471
 2472pp_i2tml_0(M:H):- M==user,!,pp_i2tml_1(H).
 2473pp_i2tml_0((M:H:-B)):- M==user,!,pp_i2tml_1((H:-B)).
 2474pp_i2tml_0(HB):-pp_i2tml_1(HB).
 if_html(?ARG1, :GoalARG2) is det
If HTML.
 2483if_html(F,A):-is_html_mode,!,bformat(F,[A]).
 2484if_html(_,A):-A.
 pp_i2tml_1(?ARG1) is det
Pretty Print i2tml Secondary Helper.
 2492pp_i2tml_1(H):- 
 2493 once(((lmcache:last_item_offered(Was);Was=foobar),get_functor(Was,F1,_A1),get_functor(H,F2,_A2),
 2494   retractall(lmcache:last_item_offered(Was)),asserta(lmcache:last_item_offered(H)),
 2495    ((F1 \== F2 -> if_html('~N~@<hr/>',true);true)))),flush_output_safe,fail.
 2496
 2497pp_i2tml_1(_H):- t_l:current_clause_ref(Ref),
 2498    if_html('<font size="1">~@</font>',show_clause_ref(Ref)),fail.
 2499
 2500pp_i2tml_1(H):- is_html_mode, 
 2501  term_to_pretty_string(H,ALT)->
 2502    term_to_pretty_string(ALT,URL)->
 2503   functor_to_color(H,FC)->fmtimg(FC,ALT)->
 2504    bformat('<input type="checkbox" name="assertion[]" value="~w">',[URL]),fail.
 2505
 2506pp_i2tml_1(H):- \+ \+ must_run(pp_i2tml_now(H)).
 pp_i2tml_now(?ARG1) is det
Pretty Print I2tml Now.
 2515pp_i2tml_now(C):- t_l:pp_i2tml_hook(C),!.
 2516pp_i2tml_now(C):- if_html('<font size="3">~@</font>~N',if_defined(rok_portray_clause(C),portray_clause(C))).
 functor_to_color(?ARG1, ?ARG2) is det
Functor Converted To Color.
 2524functor_to_color(wid(_,_,G),C):-!,functor_to_color(G,C).
 2525functor_to_color(G,C):-compound(G),functor(G,F,A),functor_to_color(G,F,A,C).
 2526functor_to_color(_G,green):-!.
 functor_to_color(?ARG1, ?ARG2, ?ARG3, ?ARG4) is det
Functor Converted To Color.
 2536functor_to_color(_G,isa,_,bug_btn_s).
 2537
 2538functor_to_color(_G,genls,1,'plus-green').
 2539functor_to_color(_G,arity,_,'white').
 2540functor_to_color(_G,argIsa,_,'white').
 2541functor_to_color(_G,argGenls,_,'white').
 2542
 2543functor_to_color(_,_,1,yellow).
 2544
 2545functor_to_color(G:-_,_,_,C):-nonvar(G),!,functor_to_color(G,C).
 2546
 2547
 2548
 2549functor_to_color(_,(<==>),_,'plus-purple').
 2550functor_to_color(_,(<-),_,purple).
 2551functor_to_color(_,(<=),_,'cyc-right-triangle-violet').
 2552functor_to_color(_,(==>),_,'cyc-right-triangle-violet').
 2553functor_to_color(_,(:-),_,red_diam).
 2554
 2555
 2556functor_to_color(_,-,_,red).
 2557functor_to_color(_,not,_,red).
 2558functor_to_color(_,~,_,red).
 2559functor_to_color(_,~,_,red).
 2560
 2561functor_to_color(_,(if),_,cy_menu).
 2562functor_to_color(_,(iff),_,cyan).
 2563functor_to_color(_,(all),_,cyan).
 2564functor_to_color(_,(exists),_,blue).
 2565
 2566functor_to_color(_,(mudEquals),_,pink).
 2567functor_to_color(_,(skolem),_,pink).
 2568functor_to_color(_,(wid),_,green_yellow).
 2569
 2570functor_to_color(G,_,_,'lightgrey'):-predicate_property(G,foreign).
 2571functor_to_color(G,_,_,'cyc-logo-3-t'):-predicate_property(G,built_in).
 session_checked(?ARG1) is det
Session Checked.
 2581session_checked(Name):- get_param_sess(Name,V),V\=='0',V\==0,V\=="0".
 session_checkbox(?ARG1, ?ARG2, ?ARG3) is det
Session Checkbox.
 2590session_checkbox(Name,Caption,BR):-
 2591 (session_checked(Name)-> CHECKED='CHECKED';CHECKED=''),
 2592 bformat('<font size="-3"><input type="checkbox" name="~w" value="1" ~w />~w</font>~w',[Name,CHECKED,Caption,BR]).
 2593 % bformat('<font size="-3"><label><input type="checkbox" name="~w" value="1" ~w/>~w</label></font>~w',[Name,CHECKED,Caption,BR]).
 action_menu_applied(?ARG1, ?ARG2, ?ARG3) is det
Action Menu Applied.
 2602action_menu_applied(MenuName,ItemName,Where):-
 2603  block_format(( bformat('<label>',[]),show_select2(MenuName,xaction_menu_item,[atom_subst('$item',ItemName)]),
 2604      bformat('&nbsp;~w&nbsp;&nbsp;<input type="submit" value="Now" name="Apply">',[Where]),
 2605      bformat('</label>',[]))).
 is_context(?ARG1, ?ARG2) is det
If Is A Context.
 2611is_context(MT,MT):-no_repeats(is_context0(MT)).
 is_context0(?ARG1) is det
If Is A Context Primary Helper.
 2619is_context0(MT):- if_defined(exactlyAssertedEL_first(isa, MT, 'tMicrotheory',_,_),fail).
 2620is_context0(MT):- if_defined(isa(MT,'tMicrotheory'),fail).
 2621is_context0('BaseKB').                           
 get_request_vars(?ARG1) is det
Get Request Variables.
 2632get_request_vars(Format):- ignore(Exclude=[term,find,session_data,webproc,user_agent,referer,session,request_uri,accept]),
 2633   findall(N=V,(current_form_var(N),\+ member(N,Exclude),once(get_param_sess(N,V))),NVs),
 2634   forall(member(N=V,NVs),format(Format,[N,V])).
 must_run(:GoalARG1) is det
Hmust (list Version).
 2641must_run(List):-  is_list(List),!,must_maplist(must_run,List),!.
 2642must_run((G1,G2)):- !,must_run(G1),!,must_run(G2),!.
 2643must_run([G1|G2]):- !,must_run(G1),!,must_run(G2),!.
 2644must_run(Goal):- flush_output_safe,
 2645   (Goal
 2646    -> flush_output_safe ; wdmsg(assertion_failed(fail, Goal))).
 call_for_terms(?ARG1) is det
Call For Terms.
 2655call_for_terms(Call):- 
 2656   must_run((
 2657      get_param_sess(term,Term,"tHumanHead"),
 2658      get_param_sess(find,SObj,Term),
 2659      cvt_param_to_term(SObj,Obj),
 2660        write_begin_html('search4term',Base,_),
 2661        show_search_form(Obj,Base),
 2662        bformat('<pre>',[]),        
 2663        locally_tl(print_mode(html),with_search_filters(catch(ignore(Call),E,dmsg(E)))),
 2664        bformat('</pre>',[]),
 2665        show_pcall_footer,
 2666        write_end_html)),!.
 2667
 2668:- thread_local(t_l:tl_hide_data/1). 2669
 2670show_search_form(Obj,Base):-
 2671   block_format((
 2672        format('<form action="search4term" target="_self"><font size="-3">Apply: ~@',[action_menu_applied('action_below','Checked or Clicked',"&nbsp;below&nbsp;")]),
 2673        format('&nbsp;&nbsp;&nbsp;find: <input id="find" type="text" name="find" value="~q"> Base = ~w</font> <a href="edit1term" target="_top">edit1term</a><br/>~@ <hr/></form>~n~@',
 2674            [Obj,Base,show_search_filters('&nbsp;&nbsp;'),add_form_script]))),  !.
 with_search_filters(:GoalARG1) is det
Using Search Filters.
 2683with_search_filters(C):-
 2684  retractall(t_l:tl_hide_data(_)),
 2685  with_search_filters0(C),!.
 2686
 2687with_search_filters0(C):-
 2688   search_filter_name_comment(FILTER,_,_),
 2689   session_checked(FILTER), 
 2690   \+ t_l:tl_hide_data(FILTER),!,
 2691    locally_tl(tl_hide_data(FILTER),with_search_filters0(C)).
 2692with_search_filters0(C):-call(C).
 make_page_pretext_obj(?ARG1) is det
Make Page Pretext Obj.
 2703% make_page_pretext_obj(Obj):- atom(Obj),atom_to_term(Obj,Term,Bindings),nonvar(Term),Term\=@=Obj,!,must_run(make_page_pretext_obj(Term)).
 2704
 2705make_page_pretext_obj(Obj):- 
 2706 must_run((
 2707  % catch(mmake,_,true),
 2708  % forall(no_repeats(M:F/A,(f_to_mfa(Pred/A,M,F,A))),ignore(logOnFailure((this_listing(M:F/A),flush_output_safe)))),
 2709  % forall(no_repeats(M:F/A,(f_to_mfa(Pred/A,M,F,A))),ignore(logOnFailure((reply_object_sub_page(M:F/A),flush_output_safe)))),
 2710  % ignore((fail,catch(mpred_listing(Pred),_,true))),
 2711  quietly(call_with_time_limit(300,ignore(catch(xlisting_inner(i2tml_hbr,Obj,[]),E,wdmsg(E))))),
 2712  pp_i2tml_saved_done(Obj))),!.
 2713
 2714make_page_pretext_obj(Obj):- writeq(make_page_pretext_obj(Obj)),!.
 2715
 2716
 2717
 2718% :- prolog_xref:assert_default_options(register_called(all)).
 reply_object_sub_page(?ARG1) is det
Reply Object Sub Page.
 2727reply_object_sub_page(Obj) :- phrase(object_sub_page(Obj, []), HTML), html_write:print_html(HTML),!.
 object_sub_page(+Obj, +Options)// is det
-->.
 2734object_sub_page(Obj, Options) -->
 2735	{ pldoc_process:doc_comment(Obj, File:_Line, _Summary, _Comment)
 2736	}, !,
 2737	(   { \+ ( pldoc_process:doc_comment(Obj, File2:_, _, _),
 2738		   File2 \== File )
 2739	    }
 2740	->  html([ \object_synopsis(Obj, []),
 2741		   \objects([Obj], Options)
 2742		 ])
 2743	;   html([
 2744		   \objects([Obj], [synopsis(true)|Options])
 2745		 ])
 2746	).
 return_to_pos(:GoalARG1) is det
Return Converted To Pos.
 2764return_to_pos(Call):- current_line_position(LP),Call,!, must_run(set_line_pos(LP)).
 nl_same_pos is det
Nl Same Pos.
 2772nl_same_pos:-return_to_pos(nl).
 set_line_pos(?ARG1) is det
Set Line Pos.
 2783set_line_pos(LP):-current_output(Out),set_line_pos(Out,LP).
 set_line_pos(?ARG1, ?ARG2) is det
Set Line Pos.
 2791set_line_pos(_,_):-!.
 2792set_line_pos(Out,LP):- 
 2793  current_line_position(Out,CLP), 
 2794  (CLP==LP->! ;((CLP>LP->nl(Out);put_code(Out,32)),!,set_line_pos(Out,LP))).
 current_line_position(?ARG1) is det
Current Line Position.
 2803current_line_position(LP):-current_output(Out),current_line_position(Out,LP).
 2804
 2805:- kb_shared(baseKB:wid/3).
 current_line_position(?ARG1, ?ARG2) is det
Current Line Position.
 2812current_line_position(Out,LP):-stream_property(Out,position( Y)),stream_position_data(line_position,Y,LP),!.
 test_tmw is det
Tmw.
 2820test_tmw:- locally_tl(print_mode(html),
 2821 (rok_portray_clause(a(LP)),
 2822  rok_portray_clause((a(LP):-b([1,2,3,4]))),
 2823  nl,nl,call_u(wid(_,_,KIF)),
 2824  KIF='=>'(_,_),nl,nl,print(KIF),listing(print_request/1))),!.
 2825test_tmw2:- locally_tl(print_mode(html),(print((a(_LP):-b([1,2,3,4]))),nl,nl,wid(_,_,KIF),KIF='=>'(_,_),nl,nl,print(KIF),listing(print_request/1))),!.
 2826
 2827
 2828
 2829% II = 56+TTT, ((show_call(why,(url_encode(II,EE),var_property(TTT,name(NNN)),url_decode(EE,OO))))),writeq(OO).
 url_encode(?ARG1, ?ARG2) is det
Url Encode.
 2838url_encode(B,A):- \+ atom(B),!,term_variables(B,Vars),url_encode_term(B,Vars,O),O=A.
 2839url_encode(B,A):- atom_concat('\n',BT,B),!,url_encode(BT,A).
 2840url_encode(B,A):- atom_concat(BT,'\n',B),!,url_encode(BT,A).
 2841url_encode(B,A):- atom_concat(' ',BT,B),!,url_encode(BT,A).
 2842url_encode(B,A):- atom_concat(BT,' ',B),!,url_encode(BT,A).
 2843url_encode(B,A):- url_iri(A,B).
 url_encode_term(?ARG1, ?ARG2, ?ARG3) is det
Url Encode Term.
 2853url_encode_term(B,[],O):- !, term_to_atom('#$'(B:[]),BB),!,url_iri(O,BB).
 2854url_encode_term(InTerm,_VsIn,URL):- fail, with_output_to(atom(IRI),portray_clause('#$'((InTerm:_)))),
 2855  url_iri(URL,IRI),nb_linkval(URL,InTerm),!.
 2856
 2857url_encode_term(InTerm,VsIn,URL):-
 2858  get_varname_list(Prev),
 2859  name_the_var(40,Prev,VsIn,_NewVs,Added),
 2860  % (NewVs\==Prev ->  show_call(why,put_variable_names(NewVs)) ; true),
 2861  with_output_to(atom(IRI),write_term('#$'(InTerm:Added),[quoted(true),variable_names(Added),quoted,priority(9)])),
 2862  url_iri(URL,IRI),!.
 member_open(?ARG1, :TermARG2) is det
Member Open.
 2871member_open(C, [B|A]) :-  (nonvar(B),B=C) ; (nonvar(A),member_open(C, A)).
 name_the_var(?ARG1, ?ARG2, :TermARG3, :TermARG4, :TermARG5) is det
Name The Variable.
 2880name_the_var(_Num,Vs,[],Vs,[]).
 2881
 2882name_the_var(Num,Vs,[VIn|More],VsOut,[N=V|Added]):- member_open(N=V,Vs),VIn==V,!,name_the_var(Num,Vs,More,VsOut,Added).
 2883% name_the_var(Num,Vs,[VIn|More],VsOut,[N=VIn|Added]):- \+ is_list(Vs), append(Vs,[N=VIn],NewVs),!, name_the_var(Num,NewVs,More,VsOut,Added).
 2884name_the_var(Num,Vs,[VIn|More],[N=VIn|VsOut],[N=VIn|Added]):- Num2 is Num +1, NV = '$VAR'(Num),
 2885  with_output_to(atom(N),write_term(NV,[portrayed(true),quoted,priority(9)])),
 2886  name_the_var(Num2,Vs,More,VsOut,Added).
 2887
 2888
 2889
 2890%  II = 56+TTT, rtrace((url_encode(II,EE),url_decode(EE,OO))),writeq(OO),OO=II.
 2891
 2892
 2893
 2894% url_decode(B,A):- \+ atom(B),!,term_to_atom(B,BB),!,url_encode(BB,O),!,A=O.
 url_decode(?ARG1, ?ARG2) is det
Url Decode.
 2902url_decode(B,A):- \+ atom(B),A=B.
 2903url_decode(A,B):- atom_concat('#%24%28',_,A) , url_decode_term(A,T),!,T=B.
 2904url_decode(A,B):- url_iri(A,C),!,B=C.
 url_decode_term(?ARG1, ?ARG2) is det
Url Decode Term.
 2913url_decode_term(A,T):- nb_current(A,T),nb_delete(A),!.
 2914url_decode_term(A,T):- url_iri(A,B),
 2915    read_term_from_atom(B,'#$'(T:Vs2),[variable_names(Vs3)]),
 2916    ignore(Vs2=Vs3),!, ignore(Vs2=[]),!.
 2917
 2918url_decode_term(A,T):-
 2919    url_iri(A,B),
 2920    read_term_from_atom(B,'#$'(T:Vs2),[variable_names(Vs3)]),
 2921    ignore(Vs2=[]),ignore(Vs2=Vs3),
 2922    merge_key_vals(B,Vs2,Merge),
 2923    get_varname_list(Env),
 2924    merge_key_vals(Env,Merge,New),
 2925    put_variable_names(New),!.
 tovl(:TermARG1, :TermARG2, :TermARG3) is det
Tovl.
 2936tovl([],[],[]).
 2937tovl([K|KL],[V|VL],[K=V|KVL]) :- tovl(KL, VL, KVL).
 merge_key_vals(:TermARG1, ?ARG2, ?ARG3) is det
Merge Key Vals.
 2946merge_key_vals(Prev,Pairs,NewSave):-var(Prev),!,NewSave=Pairs.
 2947merge_key_vals([],Pairs,NewSave):-!,NewSave=Pairs.
 2948merge_key_vals([K=V1|Prev],Pairs,NewSave):-
 2949   member_open(K=V2,Pairs),
 2950   V1==V2, merge_key_vals(Prev,Pairs,NewSave).
 2951merge_key_vals([K1=V1|Prev],Pairs,NewSave):-
 2952   member_open(K2=V2,Pairs),
 2953   K1==K2, V1=V2, merge_key_vals(Prev,Pairs,NewSave).
 2954merge_key_vals([K1=V1|Prev],Pairs,NewSave):-
 2955   merge_key_vals(Prev,[K1=V1|Pairs],NewSave).
 2956
 2957
 2958
 2959
 2960
 2961% x(Z+B)
 2962
 2963%   b_setval(URL,InTerm).
 write_as_url_encoded(?ARG1, ?ARG2) is det
Write Converted To Url Encoded.
 2972write_as_url_encoded(_Arg, D):- url_encode(D,U),!,writeq(U).
 2973:- format_predicate('u',write_as_url_encoded(_Arg,_Time)).
 term_to_pretty_string(?ARG1, ?ARG2) is det
Term Converted To Pretty String.
 2982term_to_pretty_string(H,HS):- \+ compound(H),!,with_output_to(string(HS),writeq(H)).
 2983term_to_pretty_string(H,HS):-
 2984   % igno re(source_variables(X))->ignore(X=[])->
 2985   % numb ervars(HC,0,_)->
 2986  with_output_to(string(HS),portray_clause(H)).
 fmtimg(?ARG1, ?ARG2) is det
Fmtimg.
 2995fmtimg(N,Alt):- is_html_mode,!,
 2996 make_quotable(Alt,AltQ),
 2997 url_encode(Alt,AltS),
 2998 bformat('~N<a href="?webproc=edit1term&term=~w" target="_parent"><img src="/pixmapx/~w.gif" alt="~w" title="~w"><a>',[AltS,N,AltQ,AltQ]).
 2999fmtimg(_,_).
 indent_nbsp(?ARG1) is det
Indent Nbsp.
 3009indent_nbsp(X):-is_html_mode,forall(between(0,X,_),bformat('&nbsp;')),!.
 3010indent_nbsp(X):-forall(between(0,X,_),format('~t',[])),!.
 indent_nl is det
Indent Nl.
 3019indent_nl:- fresh_line, flag(indent,X,X), indent_nbsp(X).
 indent_nbsp(:PRED1ARG1, ?ARG2) is det
Indent Nbsp.
 3029indent_nbsp(0,''):-!.
 3030indent_nbsp(1,'\n         '):-!.
 3031indent_nbsp(X,Chars):-XX is X -1,!, indent_nbsp(XX,OutP),!,sformat(Chars,'~w   ',[OutP]),!.
 shared_hide_data(:PRED4ARG1) is det
Hook To [shared_hide_data/1] For Module Mpred_www. Shared Hide Data.
 3044:- xlisting_web:import(xlisting:is_listing_hidden/1). 3045
 3046shared_hide_data_sp(Var):- is_ftVar(Var),!,fail.
 3047shared_hide_data_sp(_:F/A):- !,shared_hide_data_sp(F/A).
 3048shared_hide_data_sp('$si$':'$was_imported_kb_content$'/2):- !,is_listing_hidden(hideMeta).
 3049shared_hide_data_sp(spft/3):- !,is_listing_hidden(hideTriggers).
 3050shared_hide_data_sp(nt/3):- !,is_listing_hidden(hideTriggers).
 3051shared_hide_data_sp(pt/2):- !, is_listing_hidden(hideTriggers).
 3052shared_hide_data_sp(bt/2):- !, is_listing_hidden(hideTriggers).
 3053shared_hide_data_sp((_:-
 3054 cwc,
 3055        second_order(_,G19865),
 3056        (   _G19865 = (G19867,!,G19871) ->
 3057                call(G19867),  !,
 3058                call(G19871)
 3059        ;   CALL
 3060        ))):- CALL=@=call(G19865).
 3061
 3062
 3063shared_hide_data_sp(saved_request/_):- !.
 3064shared_hide_data_sp(session_data/_):- !.
 3065shared_hide_data_sp(mpred_prop/3):- !,is_listing_hidden(hideMeta).
 3066shared_hide_data_sp(last_item_offered/1):- !,is_listing_hidden(hideMeta).
 3067shared_hide_data_sp(P0):- strip_module(P0,_,P), compound(P),functor(P,F,A),F\== (/) , !,shared_hide_data_sp(F/A).
 3068shared_hide_data_sp((Pred)) :-  fail, rok_portray_clause((Pred:-true)).
 3069
 3070
 3071:- multifile baseKB:shared_hide_data/1. 3072:- kb_global(baseKB:shared_hide_data/1). 3073baseKB:shared_hide_data(MFA):- cwc,nonvar(MFA), shared_hide_data_sp(MFA).
 3074
 3075%:- mpred_trace_exec.
 3076
 3077/*use_baseKB(M,I) :-
 3078  M:import(pfccore:pfcDefault/2),
 3079  I:import(pfccore:pfcDefault/2),
 3080 % pfc_umt:abox_pred_list(PREDS)-> must_maplist(kb_shared_local(M,I),PREDS),
 3081 forall(no_repeats(pfc_umt:pfcDatabaseTerm_DYN(F/A)),show_call(kb_shared_local(M,I,F/A))).
 3082:- use_baseKB(xlisting_web).
 3083*/
 3084
 3085
 3086%:- nb_setval(defaultAssertMt,xlisting_web).
 3087
 3088
 3089
 3090xlisting_web_file.
 3091
 3092          
 3093
 3094%:- mpred_notrace_exec.
 3095
 3096%:- nb_setval(defaultAssertMt,[]).
 3097
 3098% :- ensure_sigma(6767).
 3099
 3100:- fixup_exports. 3101
 3102%:- noguitracer.
 3103% WANT 
 3104
 3105:- set_prolog_flag(hide_xpce_library_directory,false). 3106:- retractall(t_l:no_cycstrings). 3107
 3108:- during_net_boot(register_logicmoo_browser).