1% 90/11/30 mw: corrected some bugs and simplified the code a little bit
    2
    3% -----------------------------------------------------------------------------
    4%
    5% confirm(PromptText): puts up a modal dialog with a label with the text
    6% specified as the argument and two command buttons: one saying 'OK' and
    7% the other saying 'Cancel'. Succeeds if the user clicks 'OK' and fails
    8% if the user clicks 'Cancel'.
    9%
   10
   11
   12acknowledge(Msg):- wdmsg(Msg).
   13acknowledge(Text) :-
   14        process_confirm_dialog(ack_dialog, Text, _).
   15
   16confirm(Text) :-
   17        process_confirm_dialog(confirm_dialog, Text, _).
   18
   19confirm(Text, Choice) :-
   20        process_confirm_dialog(choice_dialog, Text, Choice).
   21
   22ask(Question, Answer) :-
   23        ask(Question, Answer, '').
   24
   25ask(Question, Answer, Default) :-
   26        shell widget ask_dialog(Dialog, Question, Default),
   27        repeat, next_event(Dialog-Text),
   28        Text wproc [get_last_pos(LP), get(0, LP, Answer)],
   29        Dialog wproc destroy, !.
   30
   31% -----------------------------------------------------------------------------
   32
   33process_confirm_dialog(Kind, Message, Action) :-
   34        Widget =.. [Kind, Dialog, Message],
   35        shell widget Widget,
   36	repeat, next_event(Dialog-Action),
   37	confirm_action(Action, Goal),
   38	Dialog wproc destroy, !,
   39	Goal.
   40
   41        
   42% -----------------------------------------------------------------------------
   43
   44confirm_action(ok,     true).
   45confirm_action(yes,    true).
   46confirm_action(no,     true).
   47confirm_action(cancel, fail).
   48
   49
   50% -----------------------------------------------------------------------------
   51
   52display_confirm_text(WID, Text) :-
   53	WID wproc stream(OS),
   54	current_output(COS), set_output(OS),
   55	write_confirm_text(Text),
   56	set_output(COS), close(OS).
   57
   58
   59%------------------------------------------------------------------------------
   60
   61write_confirm_text([H]) :-
   62        write_confirm_text(H).
   63write_confirm_text([H|T]) :- 
   64        write_confirm_text(H),
   65	write_confirm_text(T).
   66
   67write_confirm_text(A) :- 
   68        atomic(A), write(A).
   69
   70write_confirm_text(G) :- call(G).
   71write_confirm_text(_).
   72
   73
   74% -----------------------------------------------------------------------------
   75:- use_module(library(cgt/cge/swi_apeal)).   76
   77shell widget ack_dialog(Dialog, Text) :-
   78  ack_dialog: Dialog= transientShell / [
   79    title('Modal Dialog'),
   80    geometry('+400+400'),
   81    allowShellResize(false)
   82  ] - [
   83    box / [
   84      hSpace(2), vSpace(2),
   85      background(white)
   86    ] - [
   87       cuTbl / [
   88	interWidth(4), interHeight(4),
   89	internalWidth(2), internalHeight(2),
   90	formatString([ [c, <, <], [@(c), c, @(c)] ]),
   91	borderWidth(2)
   92      ] - [
   93	confirm_text: Prompt= asciiText / [
   94	  textOptions([wordBreak, resizeHeight]),
   95	  width(200), height(30),
   96	  editType(edit), sensitive(false),
   97	  borderWidth(0), displayCaret(false)
   98	] + [
   99	  display_confirm_text(Prompt, Text)
  100	],
  101
  102	space(1, 1),
  103
  104	confirm_ok: cuCommand / [
  105	  label('OK'),
  106	  callback(t(Dialog-ok))
  107	],
  108
  109	space(1,1)
  110      ]
  111    ]
  112  ].
  113
  114shell widget confirm_dialog(Dialog, Text) :-
  115  confirm_dialog: Dialog= transientShell / [
  116    title('Modal Dialog'),
  117    geometry('+400+400')
  118  ] - [
  119    box / [
  120      hSpace(2), vSpace(2),
  121      background(white)
  122    ] - [
  123      cuTbl / [
  124	interWidth(4), interHeight(4),
  125	internalWidth(2), internalHeight(2),
  126	formatString([ [c, <, <], [c, @(c), c] ]),
  127	borderWidth(2)
  128      ] - [
  129	confirm_text: Prompt= asciiText / [
  130	  textOptions([wordBreak, resizeHeight]),
  131	  width(200), height(30),
  132	  editType(edit), sensitive(false),
  133	  borderWidth(0), displayCaret(false)
  134	] + [
  135	  display_confirm_text(Prompt, Text)
  136	],
  137
  138	confirm_ok: cuCommand / [
  139	  label('OK'),
  140	  callback(t(Dialog-ok))
  141	],
  142
  143	space(1, 1),
  144
  145	confirm_cancel: cuCommand / [
  146	  label('Cancel'),
  147	  callback(t(Dialog-cancel))
  148	]
  149      ]
  150    ]
  151  ].
  152
  153shell widget choice_dialog(Dialog, Text) :-
  154  choice_dialog: Dialog= transientShell / [
  155    title('Modal Dialog'),
  156    geometry('+400+400')
  157  ] - [
  158    box / [
  159      hSpace(2), vSpace(2),
  160      background(white)
  161    ] - [
  162      cuTbl / [
  163	interWidth(4), interHeight(4),
  164	internalWidth(4), internalHeight(4),
  165	formatString([ [c, <, <], [c, @(c), c, @(c), c] ]),
  166	borderWidth(2)
  167      ] - [
  168	confirm_text: Prompt= asciiText / [
  169	  textOptions([wordBreak, resizeHeight]),
  170	  width(200), height(30),
  171	  %font(courier-[size(pixel)=12, bold, slant=r]),
  172	  editType(edit), sensitive(false),
  173	  borderWidth(0), displayCaret(false)
  174	] + [
  175	  display_confirm_text(Prompt, Text)
  176	],
  177
  178	confirm_yes: cuCommand / [
  179	  label('Yes'),
  180	  callback(t(Dialog-yes))
  181	],
  182	
  183	space(1, 1),
  184
  185	confirm_no: cuCommand / [
  186	  label('No'),
  187	  callback(t(Dialog-no))
  188	],
  189
  190	space(1, 1),
  191
  192	confirm_cancel: cuCommand / [
  193	  label('Cancel'),
  194	  callback(t(Dialog-cancel))
  195	]
  196      ]
  197    ]
  198  ].
  199
  200shell