1 /****^  ******************************************************
  2         *                                                    *
  3         * Copyright, (C) Honeywell Bull Inc., 1988           *
  4         *                                                    *
  5         * Copyright (c) 1986 by Massachusetts Institute of   *
  6         * Technology and Honeywell Information Systems, Inc. *
  7         *                                                    *
  8         * Copyright (c) 1972 by Massachusetts Institute of   *
  9         * Technology and Honeywell Information Systems, Inc. *
 10         *                                                    *
 11         ****************************************************** */
 12 
 13 
 14 /****^  HISTORY COMMENTS:
 15   1) change(85-12-23,LJAdams), approve(86-02-26,MCR7358),
 16      audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062):
 17      85-03-12 JG Backs: Changed the "Do you wish to continue? (y/n)" message
 18      to "Do you still wish to enter executive_mail?" for clarity when there
 19      are no messages in the incoming mailbox.  Took out constants YES and NO
 20      and literals of "yes" and "no".  Replaced by the include file
 21      xmail_responses.incl.pl1.
 22      85-04-17 JG Backs: Replaced all the Message Facility commands
 23      (accept_messages, defer_messages, print_messages) with calls to the new
 24      xmail_im_mgr_ module which uses the new Message Facility entrypoints for
 25      these functions.
 26      85-04-18 JG Backs: Added code to check new personalization option
 27      confirm_print_yn, set default to yes, and set the flag in xmail_data.
 28   2) change(85-12-23,LJAdams), approve(86-02-26,MCR7358),
 29      audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062):
 30      Added initialization of xmail_data.general_help switch.
 31   3) change(86-02-27,Blair), approve(86-02-27,MCR7358),
 32      audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062):
 33      Change the auto_xmail_data structure to refere to the value seg pathname
 34      rather than the value seg ptr.  This change is being made so that the
 35      structure is initiated each time it is used and we don't have to worry
 36      about having an invalid pointer.
 37   4) change(87-01-19,Blair), approve(87-02-05,MCR7618),
 38      audit(87-04-14,RBarstad), install(87-04-26,MR12.1-1025):
 39      Check the total_messages in mailbox, not just ordinary ones so we'll
 40      have the ability to treat interactive msgs as mail.
 41   5) change(88-06-28,Blair), approve(88-07-27,MCR7959),
 42      audit(88-08-25,RBarstad), install(88-09-02,MR12.2-1098):
 43      Initialize the fkey_data_ptr to null before we enable the cleanup handler
 44      to avoid out_of_bounds error if we go through the handler before the ptr
 45      is set.
 46      Add code to the cleanup procedure to check for whether the xmail.error
 47      segment is in the pdir.  If so, and if its' bit_count is greater than 0,
 48      then warn the user that it exists.  XServices error-list #153.
 49                                                    END HISTORY COMMENTS */
 50 
 51 
 52 xmail:
 53 executive_mail: proc ();
 54 
 55 /* BEGIN DESCRIPTION
 56 
 57 function: This is the main executive mail procedure.  It sets up the user's
 58           xmail directory, the video system, interactive message handling
 59           and all data structures that are shared among the various xmail
 60           routines. It then calls the first menu.
 61 
 62 comments: Throughout xmail, the calls to the Message Facility's commands
 63           (accept_messages, print_messages, etc) should be changed to calls
 64           to the new entrypoints as soon as it is practical.
 65 
 66 history:         Written by S. Krupp 12/14/81
 67 
 68    83-06-21  DJ Schimke: Modified to use new mail_system calls and version 2
 69    mailboxes. Added -nim/-im (undocumented) to disable/enable the interactive
 70    message handling. This option should eventually be available from the
 71    personalize menu as suggested by phx12801.
 72 
 73    83-09-14 DJ Schimke: Modified the error output from a bad control arg to
 74    print the arg as well as the help message. phx13258
 75 
 76    83-09-18 DJ Schimke: Modified xmail's cleanup handler to do a much better
 77    job and avoid the cleanup window that existed. phx15800 phx13944
 78    Also added ssu_$record_usage call so the new version's use can be
 79    monitored.
 80 
 81    83-10-05 DJ Schimke: Modified to call xmail_get_str_$yes_no rather than
 82    rolling its own question code. Since xmail_get_str_ uses command_query_,
 83    users who wish to enter xmail regardless of the fact that they have no
 84    incoming mail may use answer to bypass this question. phx 15963
 85 
 86    83-11-04 DJ Schimke: Added undocumented control arg "-escape_sequences"
 87    ("-esc" for short) to control the use of escape sequences when function
 88    keys are available (intended primarily for debugging purposes).
 89 
 90    83-12-07 DJ Schimke: Added cleanup for the ssu invocation and fixed the
 91    ssu_exit entry to do nothing.
 92 
 93    84-09-06 JG Backs: Modified  to check for personalization options and
 94    set flags after call to xmail_dir_manager_$open_dir and before control
 95    arguments are checked.  Added checks for new personalization options:
 96    Display Lists As Menus, Process Interactive Messages, Always Use Escape
 97    Keys, Multics Command Mode.
 98 
 99    84-09-18 JG Backs: Modified code to make internal procedure default_fkeys
100    into a separate xmail module which can be called from both xmail.pl1 and
101    xmail_Review_Defaults_.pl1.  This allows function key information to be
102    changed during processing.  Also modified cleanup to free ptr to function
103    key data.
104 
105    84-09-24 JG Backs: Added "-brief" control argument to print_messages
106    command so the message "You have no messages" would not print. This is to
107    make xmail compatible with the new message facility for mr11.
108 
109    84-10-09 JG Backs: Added a test to make sure the function_key_data_ptr
110    is not null before attempting to free it, in preparation for setting up
111    the default function keys.
112 
113    84-10-20 JG Backs: Modified processing of control arguments to include
114    messages to the user that indicate the control argument is obsolete, but
115    will be supported for MR11 release, and to please use the personalization
116    options.
117 
118    84-11-04 JG Backs: Added a trailing underscore to the name of external
119    procedure xmail_default_fkeys_ to coincide with the name change of that
120    module.  Audit change.
121 
122    84-11-13 JG Backs: Added a 1 bit input parameter "condition_signalled"
123    to internal CLEANUP proc, which is "1" if procedure is called during
124    cleanup condition and "0" all other times.  This bit is tested to prevent
125    any screen output during a true cleanup condition.  The call and
126    declaration of xmail_window_manager_$destroy_windows was also modified
127    to include an input parameter, to indicate if screen output should be
128    avoided.
129 
130    84-11-28 JG Backs: Added code in the CLEANUP internal procedure to
131    reset the user_io modes "more_mode=fold" if it had been previously set
132    by xmail to "more_mode=wrap" in the main procedure.  The code to set
133    wrap mode had been present for a long time, but did not cause any
134    problems until a change was made to xmail to let the user-specified
135    modes be allowed within xmail.  Also changed the initializing of the
136    old_modes variable from within the declaration to a statement.  TR18542.
137 
138 END DESCRIPTION
139 */
140 ^L
141 /* AUTOMATIC */
142 
143           dcl     answer_yn              char (3) var;      /* answer of yes or no */
144           dcl     arg_index              fixed bin;
145           dcl     arg_len                fixed bin (21);
146           dcl     arg_ptr                ptr;
147           dcl     bit_count              fixed bin (35);
148           dcl     code                   fixed bin (35);
149           dcl     interactive_msgs_yn    bit (1) aligned;
150           dcl     lifetime_first_invocation char (3) var;
151           dcl     messages_need_cleanup  bit (1) aligned;
152           dcl     multics_yn             bit (1) aligned;
153           dcl     no_of_args             fixed bin;
154           dcl     old_modes              char (256);
155           dcl     xmail_dir_opened       bit (1) aligned;
156           dcl     (total_message_count, ordinary_message_count ) fixed bin;
157           dcl     person                 char (32);
158           dcl     project                char (32);
159           dcl     prompt_string          char (160) var;
160           dcl     reason                 char (128);
161           dcl     sci_ptr                ptr;
162           dcl     use_default_fkeys      bit (1) aligned;
163           dcl     video_needs_cleanup    bit (1) aligned;
164           dcl     video_was_on           bit (1) aligned;
165           dcl     yes_sw                 bit (1) aligned;
166 
167           dcl     1 auto_xmail_data      like xmail_data;
168           dcl     1 ti                   like terminal_info;
169 
170 /* BASED */
171 
172           dcl     arg                    char (arg_len) based (arg_ptr);
173 
174 /* BUILTINS */
175 
176           dcl     (addr, bin, codeptr, index, null, rtrim) builtin;
177 
178 /* CONDITIONS */
179 
180           dcl     (cleanup, program_interrupt, quit) condition;
181 
182 /* ENTRIES */
183 
184           dcl     adjust_bit_count_      entry (char(168), char(32), bit(1) aligned, fixed bin(35), fixed bin(35));
185           dcl     com_err_               entry () options (variable);
186           dcl     cu_$arg_count          entry (fixed bin, fixed bin (35));
187           dcl     cu_$arg_ptr            entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
188           dcl     get_pdir_              entry() returns(char(168));
189           dcl     ioa_                   entry () options (variable);
190           dcl     ioa_$rsnnl             entry () options (variable);
191           dcl     iox_$control           entry (ptr, char (*), ptr, fixed bin (35));
192           dcl     iox_$modes             entry (ptr, char (*), char (*), fixed bin (35));
193           dcl     mail_system_$get_message_counts entry (char (*), char (*), bit (1) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35));
194           dcl     ssu_$destroy_invocation entry (ptr);
195           dcl     ssu_$record_usage      entry (ptr, ptr, fixed bin (35));
196           dcl     ssu_$standalone_invocation entry (ptr, char (*), char (*), ptr, entry, fixed bin (35));
197           dcl     timer_manager_$sleep   entry (fixed bin (71), bit (2));
198           dcl     ttt_info_$function_key_data entry (char (*), ptr, ptr, fixed bin (35));
199           dcl     user_info_$whoami      entry (char (*), char (*), char (*));
200           dcl     video_utils_$turn_off_login_channel entry (fixed bin (35));
201           dcl     video_utils_$turn_on_login_channel entry (fixed bin (35), char (*));
202           dcl     window_$clear_window   entry (ptr, fixed bin (35));
203           dcl     xmail$ssu_exit         entry ();
204           dcl     xmail_Executive_Mail_  entry ();
205           dcl     xmail_Getting_Started_ entry ();
206           dcl     xmail_default_fkeys_   entry () returns (ptr);
207           dcl     xmail_dir_manager_$close_dir entry options (variable);
208           dcl     xmail_dir_manager_$open_dir entry (fixed bin (35));
209           dcl     xmail_error_$no_print  entry () options (variable);
210           dcl     xmail_get_str_$yes_no  entry (char (*) var, bit (1) aligned);
211           dcl     xmail_im_mgr_$defer_messages entry ();
212           dcl     xmail_im_mgr_$init     entry ();
213           dcl     xmail_im_mgr_$print_messages entry ();
214           dcl     xmail_im_mgr_$restore_original entry ();
215           dcl     xmail_review_defers_   entry (char (*), char (*), fixed bin);
216           dcl     xmail_sw_$initialize   entry ();
217           dcl     xmail_value_$get_no_validate entry (char (*), char (*) var, fixed bin (35));
218           dcl     xmail_value_$get_with_default entry (char (*), char (*) var, char (*) var, fixed bin (35));
219           dcl     xmail_value_$set       entry (char (*), char (*) var, char (*) var, fixed bin (35));
220           dcl     xmail_window_manager_$create_windows entry (fixed bin (35));
221           dcl     xmail_window_manager_$destroy_windows entry (bit (1));
222 
223 /* EXTERNAL STATIC */
224 
225           dcl     error_table_$badopt    fixed bin (35) ext static;
226           dcl     error_table_$invalid_device fixed bin (35) ext static;
227           dcl     error_table_$no_table  fixed bin (35) ext static;
228           dcl     iox_$user_io           ptr ext static;
229           dcl     video_data_$terminal_iocb ptr ext static;
230           dcl     xmail_err_$exit_now    fixed bin (35) ext static;
231           dcl     xmail_err_$insuff_room_for_xmail fixed bin (35) ext static;
232 
233 /* CONSTANTS */
234 
235           dcl     ALWAYS_ESCAPE          char (21) init ("always_escape_keys_yn") int static options (constant);
236           dcl     CONFIRM_PRINT          char (16) init ("confirm_print_yn") int static options (constant);
237           dcl     ERROR_LOG_SEGMENT      char (11) init ("xmail.error") int static options (constant);
238           dcl     FOLD_MODE              char (14) init ("more_mode=fold") int static options (constant);
239           dcl     HELP_LINE              char (36) init ("If you need help, type ""help xmail"".") int static options (constant);
240           dcl     INT_ERR                char (38) init ("This is an internal programming error.") int static options (constant);
241           dcl     INTERACTIVE_MSGS       char (19) init ("interactive_msgs_yn") int static options (constant);
242           dcl     LISTS_AS_MENUS         char (17) init ("lists_as_menus_yn") int static options (constant);
243           dcl     MIN_LINES_NEEDED       fixed bin init (20) int static options (constant);
244           dcl     MSGS_AS_MAIL           char (15) init ("msgs_as_mail_yn") int static options (constant);
245           dcl     MULTICS_MODE           char (15) init ("multics_mode_yn") int static options (constant);
246           dcl     NAME                   char (14) init ("executive_mail") int static options (constant);
247           dcl     N_FKEYS_USED           fixed bin init (7) int static options (constant);
248           dcl     PERSONALIZE_STATEMENT  char (139) init ("^/  It will be supported in the MR11 release.^/  The Personalize Executive Mail menu can be used to set this function.^/Continuing setup...") int static options (constant);
249           dcl     REMOVE_MENUS           char (15) init ("remove_menus_yn") int static options (constant);
250           dcl     WRAP_MODE              char (14) init ("more_mode=wrap") int static options (constant);
251 ^L
252 /* INCLUDE FILES */
253 
254 %include function_key_data;
255 %page;
256 %include terminal_info;
257 %page;
258 %include query_info;
259 %page;
260 %include xmail_data;
261 %page;
262 %include xmail_responses;
263 %page;
264 %include xmail_windows;
265 %page;
266 ^L
267 /* BEGIN*/
268 
269 /* Make sure that xmail is not being recursively invoked. */
270 
271           if xmail_data_ptr ^= null
272           then do;
273                call com_err_ (0, NAME, "Previous invocation still active.");
274                goto EXIT;
275           end;
276 
277 /* Establish cleanup handler */
278 
279           xmail_data_ptr = null ();
280           sci_ptr = null ();
281           xmail_dir_opened = "0"b;
282           video_needs_cleanup = "0"b;
283           messages_need_cleanup = "0"b;
284           old_modes = "";
285           on condition (cleanup) call CLEANUP ("1"b);       /* signal condition */
286 
287 /* Log usage (ignoring any errors) */
288 
289           call ssu_$standalone_invocation (sci_ptr, NAME, (xmail_version), null (), xmail$ssu_exit, code);
290           call ssu_$record_usage (sci_ptr, codeptr (xmail), code);
291           call ssu_$destroy_invocation (sci_ptr);
292 
293 /***** Init common data structures. *****/
294 
295           auto_xmail_data.mail_dir = "";
296           auto_xmail_data.first_label = MAIN_MENU;
297           auto_xmail_data.quit_label = QUIT;
298           auto_xmail_data.value_seg_pathname = "";
299           auto_xmail_data.function_key_data_ptr = null;
300 
301 /* Get person name and project. */
302 
303           call user_info_$whoami (person, project, "");
304           auto_xmail_data.person = rtrim (person);
305           auto_xmail_data.project = rtrim (project);
306 
307           xmail_data_ptr = addr (auto_xmail_data);
308 
309 /* Set up xmail directory. */
310           auto_xmail_data.error_seg_in_pdir = "0"b;
311           call xmail_dir_manager_$open_dir (code);
312           if code = xmail_err_$exit_now then do;
313                call xmail_dir_manager_$close_dir ();
314                xmail_data_ptr = null;
315                goto EXIT;
316           end;
317           else if code ^= 0
318           then goto COMPLAIN;
319           xmail_dir_opened = "1"b;                          /* for cleanup */
320 
321 /* Check for personalization options first and set defaults & flags */
322 
323           call xmail_value_$get_no_validate (ALWAYS_ESCAPE, answer_yn, code);
324           if code = 0 & answer_yn = YES
325           then use_default_fkeys = "1"b;
326           else use_default_fkeys = "0"b;
327 
328           call xmail_value_$get_no_validate (MULTICS_MODE, answer_yn, code);
329           if code = 0 & answer_yn = YES
330           then multics_yn = "1"b;
331           else multics_yn = "0"b;
332 
333           call xmail_value_$get_no_validate (LISTS_AS_MENUS, answer_yn, code);
334           if code = 0 & answer_yn = YES
335           then auto_xmail_data.lists_as_menus = "1"b;
336           else auto_xmail_data.lists_as_menus = "0"b;
337 
338           call xmail_value_$get_no_validate (INTERACTIVE_MSGS, answer_yn, code);
339           if code = 0 & answer_yn = NO
340           then interactive_msgs_yn = "0"b;
341           else interactive_msgs_yn = "1"b;
342 
343           call xmail_value_$get_no_validate (REMOVE_MENUS, answer_yn, code);
344           if code = 0 & answer_yn = YES
345           then auto_xmail_data.remove_menus = "1"b;
346           else auto_xmail_data.remove_menus = "0"b;
347 
348           call xmail_value_$get_no_validate (CONFIRM_PRINT, answer_yn, code);
349           if code = 0 & answer_yn = NO
350           then auto_xmail_data.confirm_print = "0"b;
351           else auto_xmail_data.confirm_print = "1"b;
352 
353           call xmail_value_$get_no_validate (MSGS_AS_MAIL, answer_yn, code);
354           if code = 0 & answer_yn = YES
355           then auto_xmail_data.msgs_as_mail = "1"b;
356           else auto_xmail_data.msgs_as_mail = "0"b;
357 
358 /* Initialize general help switch and foreign mailbox switch                                                  */
359           auto_xmail_data.general_help, auto_xmail_data.foreign_mailbox = "0"b;
360 
361 /* Now check control arguments which can overide the settings for this
362    invocation of xmail.  Also print obsolete warning message. */
363 
364           call cu_$arg_count (no_of_args, code);
365           if code ^= 0
366           then goto COMPLAIN;
367 
368           if no_of_args > 0
369           then do arg_index = 1 to no_of_args;
370                     call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
371                     if code ^= 0
372                     then goto COMPLAIN;
373 
374                     if arg = "-mm" | arg = "-multics_mode"
375                     then do;
376                          multics_yn = "1"b;
377                          call ioa_ ("Control argument ""-multics_mode"" is now obsolete." || PERSONALIZE_STATEMENT);
378                          call timer_manager_$sleep (5, "11"b);
379                     end;
380 
381                     else if arg = "-nim" | arg = "-no_interactive_messages"
382                     then do;
383                          interactive_msgs_yn = "0"b;
384                          call ioa_ ("Control argument ""-no_interactive_messages"" is now obsolete." || PERSONALIZE_STATEMENT);
385                          call timer_manager_$sleep (5, "11"b);
386                     end;
387 
388                     else if arg = "-im" | arg = "-interactive_messages"
389                     then do;
390                          interactive_msgs_yn = "1"b;
391                          call ioa_ ("Control argument ""-interactive_messages"" is now obsolete." || PERSONALIZE_STATEMENT);
392                          call timer_manager_$sleep (5, "11"b);
393                     end;
394 
395                     else if arg = "-esc" | arg = "-escape_sequences"
396                     then do;
397                          use_default_fkeys = "1"b;
398                          call ioa_ ("Control argument ""-escape_sequences"" is now obsolete." || PERSONALIZE_STATEMENT);
399                          call timer_manager_$sleep (5, "11"b);
400                     end;
401                     else do;
402                          call com_err_ (error_table_$badopt, NAME, "^a^/^a", arg, HELP_LINE);
403                          xmail_data_ptr = null;
404                          goto EXIT;
405                     end;
406                end;
407 
408           auto_xmail_data.multics_mode = multics_yn;
409           auto_xmail_data.interactive_msgs = interactive_msgs_yn;
410 
411 /* Check number of messages to decide if continuing */
412 
413           call mail_system_$get_message_counts ((xmail_data.mail_dir), "incoming", "1"b, total_message_count, ordinary_message_count, (0), code); /* ignore code */
414           if total_message_count < 1
415           then do;
416                call ioa_$rsnnl ("^/You have no messages in the ""incoming"" mailbox.^/Do you still wish to enter executive_mail?", prompt_string, (0));
417                call xmail_get_str_$yes_no (prompt_string, yes_sw);
418                if ^yes_sw
419                then do;
420                     call xmail_dir_manager_$close_dir ();
421                     xmail_data_ptr = null;
422                     goto EXIT;
423                end;
424           end;
425 
426 
427 /* Get terminal data (function keys etc.). */
428 
429           auto_xmail_data.n_fkeys_used = N_FKEYS_USED + bin (auto_xmail_data.multics_mode, 1, 0);
430 
431           ti.version = terminal_info_version;
432           call iox_$control (iox_$user_io, "terminal_info", addr (ti), code);
433           if code ^= 0
434           then goto COMPLAIN;
435 
436           call ttt_info_$function_key_data (ti.term_type, null, function_key_data_ptr, code);
437           if code ^= 0
438           then use_default_fkeys = "1"b;
439           else if function_key_data.highest < auto_xmail_data.n_fkeys_used
440           then use_default_fkeys = "1"b;
441 
442           if use_default_fkeys
443           then do;
444                if function_key_data_ptr ^= null ()
445                then free function_key_data_ptr -> function_key_data;
446                auto_xmail_data.function_key_data_ptr = xmail_default_fkeys_ ();
447                auto_xmail_data.normal_usage = "(For help, press ESC, then ""?"")";
448           end;
449           else do;
450                auto_xmail_data.function_key_data_ptr = function_key_data_ptr;
451                auto_xmail_data.normal_usage = "(For help, press F1)";
452           end;
453 
454 
455 
456 /* Window info */
457 
458           xmail_windows.min_lines_needed = MIN_LINES_NEEDED;/* For now. */
459           xmail_windows.status.iocb,
460                xmail_windows.menu.iocb,
461                xmail_windows.bottom.iocb = null;
462 
463           xmail_windows.status.position,
464                xmail_windows.menu.position,
465                xmail_windows.bottom.position = 0;
466 
467           xmail_windows.initial_position = 0;
468 
469 /* Find out if the video system is already on. */
470 
471           if video_data_$terminal_iocb ^= null
472           then video_was_on = "1"b;
473           else video_was_on = "0"b;
474 
475 /***** Now really start setting things up. *****/
476 
477 /* Set up interactive message handling. */
478 
479           call xmail_im_mgr_$init;                          /* always init */
480 
481           if xmail_data.interactive_msgs then do;
482                messages_need_cleanup = "1"b;                /* for cleanup */
483                call xmail_im_mgr_$defer_messages;
484           end;
485 
486 /* Find out if xmail has ever been invoked by this user before. */
487 
488           call xmail_value_$get_with_default ("lifetime_first_invocation", (YES), lifetime_first_invocation, code);
489           if code ^= 0
490           then do;
491                call xmail_error_$no_print (code, NAME, "l", "^a", INT_ERR);
492                lifetime_first_invocation = YES;
493           end;
494 
495 /* Turn on the video system. */
496 
497           if ^video_was_on
498           then do;
499                call video_utils_$turn_on_login_channel (code, reason);
500                if code ^= 0
501                then do;
502                     if code = error_table_$no_table
503                     then call com_err_ (error_table_$invalid_device, NAME, "This command cannot operate with your current terminal type.");
504                     else call com_err_ (code, NAME, "^a", reason);
505                     goto ERROR_EXIT;
506                end;
507           end;
508 
509 /* Set up needed windows. */
510 
511           call xmail_window_manager_$create_windows (code);
512           if code = xmail_err_$insuff_room_for_xmail
513           then do;
514                call com_err_ (code, NAME, "^/The minimum number of lines needed is ^d.", xmail_windows.min_lines_needed);
515                goto ERROR_EXIT;
516           end;
517           else if code ^= 0
518           then goto COMPLAIN;
519           video_needs_cleanup = "1"b;                       /* for cleanup */
520 
521           call iox_$modes (iox_$user_io, "", old_modes, code);
522           if code ^= 0
523           then call com_err_ (code, NAME, "Unable to get bottom window modes.  ^a", INT_ERR);
524           else do;
525                if index (old_modes, FOLD_MODE) > 0
526                then do;
527                     call iox_$modes (iox_$user_io, WRAP_MODE, old_modes, code);
528                     if code ^= 0
529                     then call com_err_ (code, NAME, "Unable to set wrap mode in bottom window.  ^a", INT_ERR);
530                end;
531           end;
532 
533           call xmail_sw_$initialize ();
534 
535           on condition (program_interrupt) begin;
536                     call window_$clear_window (iox_$user_io, code);
537                     goto xmail_data.first_label;
538                end;
539 
540           on condition (quit)
541                begin;
542                     dcl     xmail_window_manager_$reconnect entry ();
543                     call xmail_window_manager_$reconnect ();
544                     call window_$clear_window (iox_$user_io, code);
545                     goto xmail_data.first_label;
546                end;
547 
548 MAIN_MENU:
549 
550           if lifetime_first_invocation = YES
551           then call xmail_Getting_Started_ ();
552           else call xmail_Executive_Mail_;
553 
554           goto MAIN_MENU;
555 
556 QUIT:
557           if lifetime_first_invocation = YES
558           then do;
559                call xmail_value_$set ("lifetime_first_invocation", (NO), "", code);
560                if code ^= 0
561                then call xmail_error_$no_print (code, NAME, "l", "^a", INT_ERR);
562           end;
563           call xmail_review_defers_ ("message", "defer", 30);
564           call xmail_review_defers_ ("reply", "reply", 30);
565           call CLEANUP ("0"b);                              /* not cleanup condition */
566           goto EXIT;
567 
568 COMPLAIN:
569           call com_err_ (code, NAME, "^a", INT_ERR);
570 
571 ERROR_EXIT:
572           call CLEANUP ("0"b);                              /* not cleanup condition */
573 
574 EXIT:
575           return;
576 ^L
577 ssu_exit: entry;
578 
579 /* This entry doesn't do anything but it is needed by the ssu standalone */
580 /* invocation. It would be used by ssu_$print_message or
581 /* ssu_$abort_subsystem if it were ever called during the invocation.    */
582 
583           return;
584 ^L
585 /* INTERNAL PROCEDURES */
586 
587 CLEANUP: proc (condition_signalled);
588 
589 /* PARAMETERS */
590 
591           dcl     condition_signalled    bit (1);
592           dcl prompt                     char (46) init ("                    Press <RETURN> to continue") int static options (constant);
593           dcl 1 auto_query_info          like query_info;
594           dcl been_thru_this_before      bit (1) aligned;
595           dcl line                       char (80) var;
596           dcl iox_$user_output           ptr ext static;
597           dcl command_query_             entry() options(variable);
598           dcl ENABLE_ESCAPE             bit (2) aligned init ("11"b) int static options (constant);
599 
600                                                             /* input parameter */
601                                                             /* 1 = cleanup condition */
602                                                             /* 0 = no condition */
603                                                             /* BEGIN */
604 
605           if sci_ptr ^= null ()
606           then call ssu_$destroy_invocation (sci_ptr);
607           if xmail_data_ptr = null then return;
608           if xmail_data.error_seg_in_pdir & ^condition_signalled then do;
609 
610                call adjust_bit_count_ ((get_pdir_()),(ERROR_LOG_SEGMENT), "0"b, bit_count, code);
611                if code = 0 & bit_count > 0 then do;
612                     call ioa_ ("^/               Xmail is closing down.");
613                     call ioa_ ("^/          An xmail error log was created in your process");
614                     call ioa_ ("     directory.  It will only exist for the duration of your");
615                     call ioa_ ("     process.  If you wish to save the error_messages that were");
616                     call ioa_ ("     written to the xmail.error segment, you should copy it from");
617                     call ioa_ ("     your process directory to another directory before");
618                     call ioa_ ("     you logout.");
619 
620           auto_query_info.version = query_info_version_6;
621           auto_query_info.switches.yes_or_no_sw = "0"b;
622           auto_query_info.switches.suppress_name_sw = "1"b;
623           auto_query_info.switches.cp_escape_control = ENABLE_ESCAPE;
624           auto_query_info.switches.suppress_spacing = "1"b;
625           auto_query_info.switches.literal_sw = "0"b;
626           auto_query_info.switches.prompt_after_explanation = "0"b;
627           auto_query_info.switches.padding = "0"b;
628           auto_query_info.status_code = 0;
629           auto_query_info.query_code = 0;
630           auto_query_info.question_iocbp = null ();         /* default: user_i/o */
631           auto_query_info.answer_iocbp = null ();           /* default: user_input */
632           auto_query_info.repeat_time = 0;                  /* don't repeat */
633           auto_query_info.explanation_ptr = null ();
634           auto_query_info.explanation_len = 0;
635 
636           been_thru_this_before = "0"b;
637           do while ("1"b);
638                call iox_$control (iox_$user_output, "reset_more", null, (0)); /* ignore code */
639 
640                call command_query_ (addr (auto_query_info), line, "", "^[^/^]^a^2x", been_thru_this_before, prompt);
641                been_thru_this_before = "1"b;
642 
643                if line = "" then goto CONTINUE;
644                end;
645                     end;
646                end;
647 CONTINUE:
648           if xmail_dir_opened then call xmail_dir_manager_$close_dir ();
649 
650           if video_needs_cleanup then do;
651 
652 /* Reset fold mode if previously changed to wrap, do not ouput error
653    message if cleanup was signalled by condition                     */
654 
655                if index (old_modes, FOLD_MODE) > 0
656                then do;
657                     call iox_$modes (iox_$user_io, FOLD_MODE, old_modes, code);
658                     if code ^= 0 & ^condition_signalled
659                     then call com_err_ (code, NAME, "Unable to reset fold mode in bottom window.  ^a", INT_ERR);
660                end;
661 
662 /* pass parameter to flag condition */
663 
664                call xmail_window_manager_$destroy_windows (condition_signalled);
665                if ^video_was_on then call video_utils_$turn_off_login_channel (0);
666           end;
667 
668           if messages_need_cleanup & xmail_data.interactive_msgs then do;
669                if ^condition_signalled                      /* only print if not condition */
670                then call xmail_im_mgr_$print_messages;
671                call xmail_im_mgr_$restore_original;         /* restore users method of handling messages when leaving */
672           end;
673 
674           if xmail_data.function_key_data_ptr ^= null ()
675           then free xmail_data.function_key_data_ptr -> function_key_data;
676 
677           xmail_data_ptr = null;
678 
679 
680      end CLEANUP;
681 
682      end xmail;