1/* COPYRIGHT ************************************************************
    2
    3Conceptual Graph Editor (CGE) - an X-Windows graphical interface to CGT
    4Copyright (C) 1990 Miguel Alexandre Wermelinger
    5
    6    This program is free software; you can redistribute it and/or modify
    7    it under the terms of the GNU General Public License as published by
    8    the Free Software Foundation; either version 2 of the License, or
    9    (at your option) any later version.
   10
   11    This program is distributed in the hope that it will be useful,
   12    but WITHOUT ANY WARRANTY; without even the implied warranty of
   13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14    GNU General Public License for more details.
   15
   16    You should have received a copy of the GNU General Public License
   17    along with this program; if not, write to the Free Software
   18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   19
   20************************************************************************/
   21:- use_module(library(cgt/cge/swi_apeal)).   22
   23/* AUTHOR(S) ************************************************************
   24
   25Michel Wermelinger
   26Dept. de Informatica, Univ. Nova de Lisboa, Quinta da Torre
   27P - 2825 Monte da Caparica, PORTUGAL
   28Phone: (+351) (1) 295 44 64 ext. 1360  Internet: mw@fct.unl.pt
   29
   30************************************************************************/
   31
   32xt_accelerators(Term, Acc) :-
   33	xt_translate(Term, String, []),
   34	xt_convert(string, to_C, String, A_String),
   35	xt_parse_accelerator_table(A_String, Acc).
   36
   37xt_flush :-
   38	xt_context(C, C), 
   39	repeat, xt_app_pending(C, Mask), 
   40		( Mask = 0, ! ; next_event(_), fail ).
   41
   42:- op(800, xfx, wgetl).   43
   44[] wgetl _ :- !.
   45_ wgetl [] :- !.
   46WIDs wgetl [Attr|AttrList] :-
   47	WIDs wgetl Attr, WIDs wgetl AttrList.
   48[WID] wgetl MultiAttr :-
   49	MultiAttr =.. [AttrName, [AttrVal]], 
   50	SimpleAttr =.. [AttrName, AttrVal], WID wget SimpleAttr.
   51[WID|WIDList] wgetl MultiAttr :-
   52	MultiAttr =.. [Name, [Val|RestVal]],
   53	SimpleAttr =.. [Name, Val], WID