1:- module(swi_apeal,[% widget/2,
    2    assertin/1,gui_expansion/2,widget_decl/3,
    3   op(800, xfx, (widget)),
    4   op(1100, xfy, '<->'),
    5   op(1100, xfy, '<='),   
    6   op(600, xfy, (form)),
    7   op(600, fy, (unmanaged)),
    8   
    9   op(1000, xf, (cuTbl)),
   10   op(600, xfx, (wgetl)),op(600, xfx, (wget)),op(600, xfx, (wset)),op(600, xfx, (wproc)), 
   11   op(600, xfx, (wsproc))]).   12
   13:- dynamic(widget_decl/3).   14:- discontiguous(widget_decl/3).   15:- multifile(widget_decl/3).   16head_expansion((Type widget Head <-> Decl), (widget_decl(Type,Head,Decl))):- nonvar(Head),!.
   17head_expansion((Type widget (Head <-> Decl)), (widget_decl(Type,Head,Decl))):- nonvar(Head),!.
   18head_expansion(((Type widget Head) <-> Decl), (widget_decl(Type,Head,Decl))):- nonvar(Head),!.
   19head_expansion(('<->'(Head,Decl):- Type), widget_decl(Type,Head,Decl)):- ignore(nonvar(Type)),!.
   20head_expansion(('widget'(Type,Head):- Decl), widget_decl(Type,Head,Decl)):- nonvar(Head),!.
   21head_expansion('<->'(Head,Type), widget_decl(Type,Head,'<->')):- nonvar(Head),!.
   22head_expansion('widget'(Type,Head), widget_decl(Type,Head,widget)):- ignore(nonvar(Head)),!.
   23
   24gui_expansion(NC,_):- \+ compound(NC),!,fail.
   25gui_expansion(HeadIn,(:- assertin(Head))):- head_expansion(HeadIn,Head),!.
   26gui_expansion((HeadIn:-BodyIn),(Out)):- !, compound(HeadIn), head_expansion(HeadIn,Head),expand_term(Head:-BodyIn,Out).
   27
   28called_swi_apeal(P):- throw(called_swi_apeal(P)).
   29
   30assertin(G):- copy_term(G,C),clause(G,_),G=@=C.
   31assertin(G):- asserta(G),wdmsg(assertin(G)),!.
   32% assertin(G):- cgt:asserta(G).
   33
   34def_swi_appeal(F/A):- functor(P,F,A),def_swi_appeal(P,F,A).
   35def_swi_appeal(P,_,_):- predicate_property(P,_),!.
   36def_swi_appeal(P,F,A):- 
   37  export(swi_apeal:F/A),
   38  assert(((swi_apeal:P) :- called_swi_apeal(P))),
   39  compile_predicates([swi_apeal:P]).
   40
   41% widget(A,B):- wdmsg(call_widget(A,B)).
   42
   43:- maplist(def_swi_appeal,[
   44 next_event/1, 
   45% nth/3, 
   46 % replace_text/2, 
   47 wget/2, 
   48 wproc/2, 
   49 wset/2, 
   50 xt_app_pending/2, 
   51 xt_context/2, 
   52 xt_convert/4, 
   53 xt_parse/2, 
   54 xt_parse_accelerator_table/2, 
   55 xt_translate/3]).   56
   57% :- dynamic(swi_apeal:term_expansion/4).
   58
   59
   60
   61:- module_transparent(( assertin/1,gui_expansion/2,widget_decl/3, term_expansion/4)).   62:- multifile(( assertin/1,gui_expansion/2,widget_decl/3)).