1% $Id: util.pl,v 1.7 90/04/23 19:31:32 spa Exp $
    2
    3:- use_module(library(cgt/cge/swi_apeal)).    4:- set_prolog_flag(swi_apeal,true).    5
    6% =============================================================================
    7%
    8% choice(Prompt, ListOfItems, ChosenItem)
    9% choice(Prompt, ListOfItems, DefaultItem, ChosenItem)
   10%
   11% $Log:	util.pl,v $
   12%
   13
   14choice(Name, [],     Choice) :- choice(Name, [], 0, Choice).
   15choice(Name, [I|Is], Choice) :- choice(Name, [I|Is], I, Choice).
   16
   17choice(Name, Items, Default, Choice) :-
   18	( nth0(DefaultIndex, Items, Default) -> true ; DefaultIndex=0 ),
   19	get_choice_translations(Tr),
   20	shell widget choice_dialog(S, Items, DefaultIndex, Name, Tr, List),
   21	next_event(E),
   22	choice_action(E, List, Choice, Items, Goal),
   23	S wproc destroy, !,
   24	Goal.
   25
   26choice_action(cancel, _,    _,      _Items, fail) :- !.
   27choice_action(ok,     List, Choice, Items, Choice=Item) :-
   28	List wproc show_current(_:I),
   29	nth0(I, Items, Item).
   30
   31
   32shell widget choice_dialog(S, Items, Default, Label, Tr, List) :-
   33  choice: S=
   34  transientShell / [
   35    title('Modal Dialog'),
   36    geometry('+350+320')
   37  ] - [
   38    choice: box / [
   39      vSpace(2), hSpace(2)
   40    ] - [
   41      form: Form= form / [
   42        borderWidth(2)
   43      ] - [
   44	choose: LBL= label / [
   45	  bottom(top),
   46	  label(Label)
   47	],
   48
   49	box: BBox= cuTbl / [
   50	  right(left), bottom(top), fromVert(LBL),
   51	  formatString([ [c] ]), borderWidth(0)
   52	] - [
   53	  ok: cuCommand / [ callback(t(ok)), label('OK') ],
   54	  space(1, 8),
   55	  cancel: cuCommand / [ callback(t(cancel)), label('Cancel') ]
   56	],
   57
   58	vp: Port= viewport / [
   59	  allowVert(true), forceBars(true),
   60	  resizable(false),
   61	  height(100),
   62	  fromVert(LBL), fromHoriz(BBox)
   63	] - [
   64	  List= list / [
   65	    list(Items),
   66	    defaultColumns(1), forceColumns(true),
   67	    longest(200), borderWidth(0),
   68	    translations(Tr)
   69	  ] + [
   70	    List wproc highlight(Default)
   71	  ]
   72	]
   73      ]
   74    ]
   75  ].
   76
   77get_choice_translations(Tr) :- recorded('$_choice_translations', Tr, _), !.
   78get_choice_translations(Tr) :-
   79	xt_parse( [ btn(down):		'Set',
   80		    btn(1)/btn(motion):	'Set',
   81		    btn(2)/btn(motion):	'Set',
   82		    btn(3)/btn(motion):	'Set',
   83		    btn(up)*2:		term(t(ok)) ], Tr),
   84	recorda('$_choice_translations', Tr, _).
   85
   86
   87:- set_prolog_flag(swi_apeal,false).