PNOTICE_xmail.alm 11/14/89 1124.8r w 11/14/89 1124.7 2448 dec 1 "version 1 structure dec 1 "no. of pnotices dec 3 "no. of STIs dec 56 "lgth of all pnotices + no. of pnotices acc "Copyright, (C) Honeywell Information Systems Inc., 1989" aci "C1EMSM0E0000" aci "C2EMSM0E0000" aci "C3EMSM0E0000" end  xmail.pl1 09/02/88 0759.6rew 09/02/88 0735.8 240804 /****^ ****************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright (c) 1986 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * ****************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-12-23,LJAdams), approve(86-02-26,MCR7358), audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062): 85-03-12 JG Backs: Changed the "Do you wish to continue? (y/n)" message to "Do you still wish to enter executive_mail?" for clarity when there are no messages in the incoming mailbox. Took out constants YES and NO and literals of "yes" and "no". Replaced by the include file xmail_responses.incl.pl1. 85-04-17 JG Backs: Replaced all the Message Facility commands (accept_messages, defer_messages, print_messages) with calls to the new xmail_im_mgr_ module which uses the new Message Facility entrypoints for these functions. 85-04-18 JG Backs: Added code to check new personalization option confirm_print_yn, set default to yes, and set the flag in xmail_data. 2) change(85-12-23,LJAdams), approve(86-02-26,MCR7358), audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062): Added initialization of xmail_data.general_help switch. 3) change(86-02-27,Blair), approve(86-02-27,MCR7358), audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062): Change the auto_xmail_data structure to refere to the value seg pathname rather than the value seg ptr. This change is being made so that the structure is initiated each time it is used and we don't have to worry about having an invalid pointer. 4) change(87-01-19,Blair), approve(87-02-05,MCR7618), audit(87-04-14,RBarstad), install(87-04-26,MR12.1-1025): Check the total_messages in mailbox, not just ordinary ones so we'll have the ability to treat interactive msgs as mail. 5) change(88-06-28,Blair), approve(88-07-27,MCR7959), audit(88-08-25,RBarstad), install(88-09-02,MR12.2-1098): Initialize the fkey_data_ptr to null before we enable the cleanup handler to avoid out_of_bounds error if we go through the handler before the ptr is set. Add code to the cleanup procedure to check for whether the xmail.error segment is in the pdir. If so, and if its' bit_count is greater than 0, then warn the user that it exists. XServices error-list #153. END HISTORY COMMENTS */ xmail: executive_mail: proc (); /* BEGIN DESCRIPTION function: This is the main executive mail procedure. It sets up the user's xmail directory, the video system, interactive message handling and all data structures that are shared among the various xmail routines. It then calls the first menu. comments: Throughout xmail, the calls to the Message Facility's commands (accept_messages, print_messages, etc) should be changed to calls to the new entrypoints as soon as it is practical. history: Written by S. Krupp 12/14/81 83-06-21 DJ Schimke: Modified to use new mail_system calls and version 2 mailboxes. Added -nim/-im (undocumented) to disable/enable the interactive message handling. This option should eventually be available from the personalize menu as suggested by phx12801. 83-09-14 DJ Schimke: Modified the error output from a bad control arg to print the arg as well as the help message. phx13258 83-09-18 DJ Schimke: Modified xmail's cleanup handler to do a much better job and avoid the cleanup window that existed. phx15800 phx13944 Also added ssu_$record_usage call so the new version's use can be monitored. 83-10-05 DJ Schimke: Modified to call xmail_get_str_$yes_no rather than rolling its own question code. Since xmail_get_str_ uses command_query_, users who wish to enter xmail regardless of the fact that they have no incoming mail may use answer to bypass this question. phx 15963 83-11-04 DJ Schimke: Added undocumented control arg "-escape_sequences" ("-esc" for short) to control the use of escape sequences when function keys are available (intended primarily for debugging purposes). 83-12-07 DJ Schimke: Added cleanup for the ssu invocation and fixed the ssu_exit entry to do nothing. 84-09-06 JG Backs: Modified to check for personalization options and set flags after call to xmail_dir_manager_$open_dir and before control arguments are checked. Added checks for new personalization options: Display Lists As Menus, Process Interactive Messages, Always Use Escape Keys, Multics Command Mode. 84-09-18 JG Backs: Modified code to make internal procedure default_fkeys into a separate xmail module which can be called from both xmail.pl1 and xmail_Review_Defaults_.pl1. This allows function key information to be changed during processing. Also modified cleanup to free ptr to function key data. 84-09-24 JG Backs: Added "-brief" control argument to print_messages command so the message "You have no messages" would not print. This is to make xmail compatible with the new message facility for mr11. 84-10-09 JG Backs: Added a test to make sure the function_key_data_ptr is not null before attempting to free it, in preparation for setting up the default function keys. 84-10-20 JG Backs: Modified processing of control arguments to include messages to the user that indicate the control argument is obsolete, but will be supported for MR11 release, and to please use the personalization options. 84-11-04 JG Backs: Added a trailing underscore to the name of external procedure xmail_default_fkeys_ to coincide with the name change of that module. Audit change. 84-11-13 JG Backs: Added a 1 bit input parameter "condition_signalled" to internal CLEANUP proc, which is "1" if procedure is called during cleanup condition and "0" all other times. This bit is tested to prevent any screen output during a true cleanup condition. The call and declaration of xmail_window_manager_$destroy_windows was also modified to include an input parameter, to indicate if screen output should be avoided. 84-11-28 JG Backs: Added code in the CLEANUP internal procedure to reset the user_io modes "more_mode=fold" if it had been previously set by xmail to "more_mode=wrap" in the main procedure. The code to set wrap mode had been present for a long time, but did not cause any problems until a change was made to xmail to let the user-specified modes be allowed within xmail. Also changed the initializing of the old_modes variable from within the declaration to a statement. TR18542. END DESCRIPTION */ /* AUTOMATIC */ dcl answer_yn char (3) var; /* answer of yes or no */ dcl arg_index fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl bit_count fixed bin (35); dcl code fixed bin (35); dcl interactive_msgs_yn bit (1) aligned; dcl lifetime_first_invocation char (3) var; dcl messages_need_cleanup bit (1) aligned; dcl multics_yn bit (1) aligned; dcl no_of_args fixed bin; dcl old_modes char (256); dcl xmail_dir_opened bit (1) aligned; dcl (total_message_count, ordinary_message_count ) fixed bin; dcl person char (32); dcl project char (32); dcl prompt_string char (160) var; dcl reason char (128); dcl sci_ptr ptr; dcl use_default_fkeys bit (1) aligned; dcl video_needs_cleanup bit (1) aligned; dcl video_was_on bit (1) aligned; dcl yes_sw bit (1) aligned; dcl 1 auto_xmail_data like xmail_data; dcl 1 ti like terminal_info; /* BASED */ dcl arg char (arg_len) based (arg_ptr); /* BUILTINS */ dcl (addr, bin, codeptr, index, null, rtrim) builtin; /* CONDITIONS */ dcl (cleanup, program_interrupt, quit) condition; /* ENTRIES */ dcl adjust_bit_count_ entry (char(168), char(32), bit(1) aligned, fixed bin(35), fixed bin(35)); dcl com_err_ entry () options (variable); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl get_pdir_ entry() returns(char(168)); dcl ioa_ entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); dcl mail_system_$get_message_counts entry (char (*), char (*), bit (1) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl ssu_$destroy_invocation entry (ptr); dcl ssu_$record_usage entry (ptr, ptr, fixed bin (35)); dcl ssu_$standalone_invocation entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl ttt_info_$function_key_data entry (char (*), ptr, ptr, fixed bin (35)); dcl user_info_$whoami entry (char (*), char (*), char (*)); dcl video_utils_$turn_off_login_channel entry (fixed bin (35)); dcl video_utils_$turn_on_login_channel entry (fixed bin (35), char (*)); dcl window_$clear_window entry (ptr, fixed bin (35)); dcl xmail$ssu_exit entry (); dcl xmail_Executive_Mail_ entry (); dcl xmail_Getting_Started_ entry (); dcl xmail_default_fkeys_ entry () returns (ptr); dcl xmail_dir_manager_$close_dir entry options (variable); dcl xmail_dir_manager_$open_dir entry (fixed bin (35)); dcl xmail_error_$no_print entry () options (variable); dcl xmail_get_str_$yes_no entry (char (*) var, bit (1) aligned); dcl xmail_im_mgr_$defer_messages entry (); dcl xmail_im_mgr_$init entry (); dcl xmail_im_mgr_$print_messages entry (); dcl xmail_im_mgr_$restore_original entry (); dcl xmail_review_defers_ entry (char (*), char (*), fixed bin); dcl xmail_sw_$initialize entry (); dcl xmail_value_$get_no_validate entry (char (*), char (*) var, fixed bin (35)); dcl xmail_value_$get_with_default entry (char (*), char (*) var, char (*) var, fixed bin (35)); dcl xmail_value_$set entry (char (*), char (*) var, char (*) var, fixed bin (35)); dcl xmail_window_manager_$create_windows entry (fixed bin (35)); dcl xmail_window_manager_$destroy_windows entry (bit (1)); /* EXTERNAL STATIC */ dcl error_table_$badopt fixed bin (35) ext static; dcl error_table_$invalid_device fixed bin (35) ext static; dcl error_table_$no_table fixed bin (35) ext static; dcl iox_$user_io ptr ext static; dcl video_data_$terminal_iocb ptr ext static; dcl xmail_err_$exit_now fixed bin (35) ext static; dcl xmail_err_$insuff_room_for_xmail fixed bin (35) ext static; /* CONSTANTS */ dcl ALWAYS_ESCAPE char (21) init ("always_escape_keys_yn") int static options (constant); dcl CONFIRM_PRINT char (16) init ("confirm_print_yn") int static options (constant); dcl ERROR_LOG_SEGMENT char (11) init ("xmail.error") int static options (constant); dcl FOLD_MODE char (14) init ("more_mode=fold") int static options (constant); dcl HELP_LINE char (36) init ("If you need help, type ""help xmail"".") int static options (constant); dcl INT_ERR char (38) init ("This is an internal programming error.") int static options (constant); dcl INTERACTIVE_MSGS char (19) init ("interactive_msgs_yn") int static options (constant); dcl LISTS_AS_MENUS char (17) init ("lists_as_menus_yn") int static options (constant); dcl MIN_LINES_NEEDED fixed bin init (20) int static options (constant); dcl MSGS_AS_MAIL char (15) init ("msgs_as_mail_yn") int static options (constant); dcl MULTICS_MODE char (15) init ("multics_mode_yn") int static options (constant); dcl NAME char (14) init ("executive_mail") int static options (constant); dcl N_FKEYS_USED fixed bin init (7) int static options (constant); 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); dcl REMOVE_MENUS char (15) init ("remove_menus_yn") int static options (constant); dcl WRAP_MODE char (14) init ("more_mode=wrap") int static options (constant); /* INCLUDE FILES */ %include function_key_data; %page; %include terminal_info; %page; %include query_info; %page; %include xmail_data; %page; %include xmail_responses; %page; %include xmail_windows; %page; /* BEGIN*/ /* Make sure that xmail is not being recursively invoked. */ if xmail_data_ptr ^= null then do; call com_err_ (0, NAME, "Previous invocation still active."); goto EXIT; end; /* Establish cleanup handler */ xmail_data_ptr = null (); sci_ptr = null (); xmail_dir_opened = "0"b; video_needs_cleanup = "0"b; messages_need_cleanup = "0"b; old_modes = ""; on condition (cleanup) call CLEANUP ("1"b); /* signal condition */ /* Log usage (ignoring any errors) */ call ssu_$standalone_invocation (sci_ptr, NAME, (xmail_version), null (), xmail$ssu_exit, code); call ssu_$record_usage (sci_ptr, codeptr (xmail), code); call ssu_$destroy_invocation (sci_ptr); /***** Init common data structures. *****/ auto_xmail_data.mail_dir = ""; auto_xmail_data.first_label = MAIN_MENU; auto_xmail_data.quit_label = QUIT; auto_xmail_data.value_seg_pathname = ""; auto_xmail_data.function_key_data_ptr = null; /* Get person name and project. */ call user_info_$whoami (person, project, ""); auto_xmail_data.person = rtrim (person); auto_xmail_data.project = rtrim (project); xmail_data_ptr = addr (auto_xmail_data); /* Set up xmail directory. */ auto_xmail_data.error_seg_in_pdir = "0"b; call xmail_dir_manager_$open_dir (code); if code = xmail_err_$exit_now then do; call xmail_dir_manager_$close_dir (); xmail_data_ptr = null; goto EXIT; end; else if code ^= 0 then goto COMPLAIN; xmail_dir_opened = "1"b; /* for cleanup */ /* Check for personalization options first and set defaults & flags */ call xmail_value_$get_no_validate (ALWAYS_ESCAPE, answer_yn, code); if code = 0 & answer_yn = YES then use_default_fkeys = "1"b; else use_default_fkeys = "0"b; call xmail_value_$get_no_validate (MULTICS_MODE, answer_yn, code); if code = 0 & answer_yn = YES then multics_yn = "1"b; else multics_yn = "0"b; call xmail_value_$get_no_validate (LISTS_AS_MENUS, answer_yn, code); if code = 0 & answer_yn = YES then auto_xmail_data.lists_as_menus = "1"b; else auto_xmail_data.lists_as_menus = "0"b; call xmail_value_$get_no_validate (INTERACTIVE_MSGS, answer_yn, code); if code = 0 & answer_yn = NO then interactive_msgs_yn = "0"b; else interactive_msgs_yn = "1"b; call xmail_value_$get_no_validate (REMOVE_MENUS, answer_yn, code); if code = 0 & answer_yn = YES then auto_xmail_data.remove_menus = "1"b; else auto_xmail_data.remove_menus = "0"b; call xmail_value_$get_no_validate (CONFIRM_PRINT, answer_yn, code); if code = 0 & answer_yn = NO then auto_xmail_data.confirm_print = "0"b; else auto_xmail_data.confirm_print = "1"b; call xmail_value_$get_no_validate (MSGS_AS_MAIL, answer_yn, code); if code = 0 & answer_yn = YES then auto_xmail_data.msgs_as_mail = "1"b; else auto_xmail_data.msgs_as_mail = "0"b; /* Initialize general help switch and foreign mailbox switch */ auto_xmail_data.general_help, auto_xmail_data.foreign_mailbox = "0"b; /* Now check control arguments which can overide the settings for this invocation of xmail. Also print obsolete warning message. */ call cu_$arg_count (no_of_args, code); if code ^= 0 then goto COMPLAIN; if no_of_args > 0 then do arg_index = 1 to no_of_args; call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code); if code ^= 0 then goto COMPLAIN; if arg = "-mm" | arg = "-multics_mode" then do; multics_yn = "1"b; call ioa_ ("Control argument ""-multics_mode"" is now obsolete." || PERSONALIZE_STATEMENT); call timer_manager_$sleep (5, "11"b); end; else if arg = "-nim" | arg = "-no_interactive_messages" then do; interactive_msgs_yn = "0"b; call ioa_ ("Control argument ""-no_interactive_messages"" is now obsolete." || PERSONALIZE_STATEMENT); call timer_manager_$sleep (5, "11"b); end; else if arg = "-im" | arg = "-interactive_messages" then do; interactive_msgs_yn = "1"b; call ioa_ ("Control argument ""-interactive_messages"" is now obsolete." || PERSONALIZE_STATEMENT); call timer_manager_$sleep (5, "11"b); end; else if arg = "-esc" | arg = "-escape_sequences" then do; use_default_fkeys = "1"b; call ioa_ ("Control argument ""-escape_sequences"" is now obsolete." || PERSONALIZE_STATEMENT); call timer_manager_$sleep (5, "11"b); end; else do; call com_err_ (error_table_$badopt, NAME, "^a^/^a", arg, HELP_LINE); xmail_data_ptr = null; goto EXIT; end; end; auto_xmail_data.multics_mode = multics_yn; auto_xmail_data.interactive_msgs = interactive_msgs_yn; /* Check number of messages to decide if continuing */ call mail_system_$get_message_counts ((xmail_data.mail_dir), "incoming", "1"b, total_message_count, ordinary_message_count, (0), code); /* ignore code */ if total_message_count < 1 then do; call ioa_$rsnnl ("^/You have no messages in the ""incoming"" mailbox.^/Do you still wish to enter executive_mail?", prompt_string, (0)); call xmail_get_str_$yes_no (prompt_string, yes_sw); if ^yes_sw then do; call xmail_dir_manager_$close_dir (); xmail_data_ptr = null; goto EXIT; end; end; /* Get terminal data (function keys etc.). */ auto_xmail_data.n_fkeys_used = N_FKEYS_USED + bin (auto_xmail_data.multics_mode, 1, 0); ti.version = terminal_info_version; call iox_$control (iox_$user_io, "terminal_info", addr (ti), code); if code ^= 0 then goto COMPLAIN; call ttt_info_$function_key_data (ti.term_type, null, function_key_data_ptr, code); if code ^= 0 then use_default_fkeys = "1"b; else if function_key_data.highest < auto_xmail_data.n_fkeys_used then use_default_fkeys = "1"b; if use_default_fkeys then do; if function_key_data_ptr ^= null () then free function_key_data_ptr -> function_key_data; auto_xmail_data.function_key_data_ptr = xmail_default_fkeys_ (); auto_xmail_data.normal_usage = "(For help, press ESC, then ""?"")"; end; else do; auto_xmail_data.function_key_data_ptr = function_key_data_ptr; auto_xmail_data.normal_usage = "(For help, press F1)"; end; /* Window info */ xmail_windows.min_lines_needed = MIN_LINES_NEEDED;/* For now. */ xmail_windows.status.iocb, xmail_windows.menu.iocb, xmail_windows.bottom.iocb = null; xmail_windows.status.position, xmail_windows.menu.position, xmail_windows.bottom.position = 0; xmail_windows.initial_position = 0; /* Find out if the video system is already on. */ if video_data_$terminal_iocb ^= null then video_was_on = "1"b; else video_was_on = "0"b; /***** Now really start setting things up. *****/ /* Set up interactive message handling. */ call xmail_im_mgr_$init; /* always init */ if xmail_data.interactive_msgs then do; messages_need_cleanup = "1"b; /* for cleanup */ call xmail_im_mgr_$defer_messages; end; /* Find out if xmail has ever been invoked by this user before. */ call xmail_value_$get_with_default ("lifetime_first_invocation", (YES), lifetime_first_invocation, code); if code ^= 0 then do; call xmail_error_$no_print (code, NAME, "l", "^a", INT_ERR); lifetime_first_invocation = YES; end; /* Turn on the video system. */ if ^video_was_on then do; call video_utils_$turn_on_login_channel (code, reason); if code ^= 0 then do; if code = error_table_$no_table then call com_err_ (error_table_$invalid_device, NAME, "This command cannot operate with your current terminal type."); else call com_err_ (code, NAME, "^a", reason); goto ERROR_EXIT; end; end; /* Set up needed windows. */ call xmail_window_manager_$create_windows (code); if code = xmail_err_$insuff_room_for_xmail then do; call com_err_ (code, NAME, "^/The minimum number of lines needed is ^d.", xmail_windows.min_lines_needed); goto ERROR_EXIT; end; else if code ^= 0 then goto COMPLAIN; video_needs_cleanup = "1"b; /* for cleanup */ call iox_$modes (iox_$user_io, "", old_modes, code); if code ^= 0 then call com_err_ (code, NAME, "Unable to get bottom window modes. ^a", INT_ERR); else do; if index (old_modes, FOLD_MODE) > 0 then do; call iox_$modes (iox_$user_io, WRAP_MODE, old_modes, code); if code ^= 0 then call com_err_ (code, NAME, "Unable to set wrap mode in bottom window. ^a", INT_ERR); end; end; call xmail_sw_$initialize (); on condition (program_interrupt) begin; call window_$clear_window (iox_$user_io, code); goto xmail_data.first_label; end; on condition (quit) begin; dcl xmail_window_manager_$reconnect entry (); call xmail_window_manager_$reconnect (); call window_$clear_window (iox_$user_io, code); goto xmail_data.first_label; end; MAIN_MENU: if lifetime_first_invocation = YES then call xmail_Getting_Started_ (); else call xmail_Executive_Mail_; goto MAIN_MENU; QUIT: if lifetime_first_invocation = YES then do; call xmail_value_$set ("lifetime_first_invocation", (NO), "", code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "^a", INT_ERR); end; call xmail_review_defers_ ("message", "defer", 30); call xmail_review_defers_ ("reply", "reply", 30); call CLEANUP ("0"b); /* not cleanup condition */ goto EXIT; COMPLAIN: call com_err_ (code, NAME, "^a", INT_ERR); ERROR_EXIT: call CLEANUP ("0"b); /* not cleanup condition */ EXIT: return; ssu_exit: entry; /* This entry doesn't do anything but it is needed by the ssu standalone */ /* invocation. It would be used by ssu_$print_message or /* ssu_$abort_subsystem if it were ever called during the invocation. */ return; /* INTERNAL PROCEDURES */ CLEANUP: proc (condition_signalled); /* PARAMETERS */ dcl condition_signalled bit (1); dcl prompt char (46) init (" Press to continue") int static options (constant); dcl 1 auto_query_info like query_info; dcl been_thru_this_before bit (1) aligned; dcl line char (80) var; dcl iox_$user_output ptr ext static; dcl command_query_ entry() options(variable); dcl ENABLE_ESCAPE bit (2) aligned init ("11"b) int static options (constant); /* input parameter */ /* 1 = cleanup condition */ /* 0 = no condition */ /* BEGIN */ if sci_ptr ^= null () then call ssu_$destroy_invocation (sci_ptr); if xmail_data_ptr = null then return; if xmail_data.error_seg_in_pdir & ^condition_signalled then do; call adjust_bit_count_ ((get_pdir_()),(ERROR_LOG_SEGMENT), "0"b, bit_count, code); if code = 0 & bit_count > 0 then do; call ioa_ ("^/ Xmail is closing down."); call ioa_ ("^/ An xmail error log was created in your process"); call ioa_ (" directory. It will only exist for the duration of your"); call ioa_ (" process. If you wish to save the error_messages that were"); call ioa_ (" written to the xmail.error segment, you should copy it from"); call ioa_ (" your process directory to another directory before"); call ioa_ (" you logout."); auto_query_info.version = query_info_version_6; auto_query_info.switches.yes_or_no_sw = "0"b; auto_query_info.switches.suppress_name_sw = "1"b; auto_query_info.switches.cp_escape_control = ENABLE_ESCAPE; auto_query_info.switches.suppress_spacing = "1"b; auto_query_info.switches.literal_sw = "0"b; auto_query_info.switches.prompt_after_explanation = "0"b; auto_query_info.switches.padding = "0"b; auto_query_info.status_code = 0; auto_query_info.query_code = 0; auto_query_info.question_iocbp = null (); /* default: user_i/o */ auto_query_info.answer_iocbp = null (); /* default: user_input */ auto_query_info.repeat_time = 0; /* don't repeat */ auto_query_info.explanation_ptr = null (); auto_query_info.explanation_len = 0; been_thru_this_before = "0"b; do while ("1"b); call iox_$control (iox_$user_output, "reset_more", null, (0)); /* ignore code */ call command_query_ (addr (auto_query_info), line, "", "^[^/^]^a^2x", been_thru_this_before, prompt); been_thru_this_before = "1"b; if line = "" then goto CONTINUE; end; end; end; CONTINUE: if xmail_dir_opened then call xmail_dir_manager_$close_dir (); if video_needs_cleanup then do; /* Reset fold mode if previously changed to wrap, do not ouput error message if cleanup was signalled by condition */ if index (old_modes, FOLD_MODE) > 0 then do; call iox_$modes (iox_$user_io, FOLD_MODE, old_modes, code); if code ^= 0 & ^condition_signalled then call com_err_ (code, NAME, "Unable to reset fold mode in bottom window. ^a", INT_ERR); end; /* pass parameter to flag condition */ call xmail_window_manager_$destroy_windows (condition_signalled); if ^video_was_on then call video_utils_$turn_off_login_channel (0); end; if messages_need_cleanup & xmail_data.interactive_msgs then do; if ^condition_signalled /* only print if not condition */ then call xmail_im_mgr_$print_messages; call xmail_im_mgr_$restore_original; /* restore users method of handling messages when leaving */ end; if xmail_data.function_key_data_ptr ^= null () then free xmail_data.function_key_data_ptr -> function_key_data; xmail_data_ptr = null; end CLEANUP; end xmail;  xmail_Consult_Files_.pl1 09/02/88 0759.6r w 09/02/88 0745.0 255069 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-07,Blair), approve(86-01-07,MCR7358), audit(86-05-19,RBarstad), install(86-05-28,MR12.0-1062): 85-04-22 JG Backs: Modified SELECT_FILE proc, adding call to ioa_ to display a message to user that the file is being worked on. If the file is large, opening will take some time and the user should know something is happening. 2) change(86-01-07,Blair), approve(86-01-07,MCR7358), audit(86-05-19,RBarstad), install(86-05-28,MR12.0-1062): Modify SELECT_FILE to call a new entrypoint in xmail_select_files for the 'select new file' option to allow selecting other users' mailboxes. 3) change(86-02-25,Blair), approve(86-02-25,MCR7358), audit(86-05-19,RBarstad), install(86-05-28,MR12.0-1062): Change call to xmail_select_msgs_ in OPT (6) so that this option can be used to set the seen switch for messages as well as select them. Now there is a ptr to a structure of seen_msgs, and a switch_on_off flag. 4) change(87-01-19,Blair), approve(87-02-05,MCR7618), audit(87-04-10,RBarstad), install(87-04-26,MR12.1-1025): Set the bit xmail_data.msgs_as_mail to reflect whether or not we're processing interactive msgs. 5) change(87-02-10,Blair), approve(87-02-10,MCR7618), audit(87-04-10,RBarstad), install(87-04-26,MR12.1-1025): Test for whether or not we're processing a reply request when the redisplay menu condition has been signalled. This prevents the screen being messed up after a reconnect. Error_list #114. 6) change(87-09-16,Blair), approve(87-09-16,MECR0007), audit(87-09-16,LJAdams), install(87-09-16,MR12.1-1108): Initialize the xmail_data.reply_request bit to "0"b so that the Filed Mail menu will be built correctly (otherwise it gets supressed). 7) change(87-10-05,Blair), approve(87-10-05,MCR7771), audit(87-11-02,LJAdams), install(87-11-02,MR12.2-1002): This installation resolves MECR0007. END HISTORY COMMENTS */ xmail_Consult_Files_: proc (); /* BEGIN DESCRIPTION function: This module produces th "Process Filed Mail" menu and allows selection of the options displayed. Other xmail modules are called as a result of options selected. history: Author unknown 83-06-21 DJ Schimke: Modified to use new mail_system calls and version 2 mailboxes. 83-09-22 DJ Schimke: Added calls to mail_system_$read_new_messages in the main option loop to keep the mailbox structure current. This is especially for the case where mail is filed into the current mailbox from the current mailbox. phx14804 83-10-06 DJ Schimke: Changed both calls to xmail_file_msgs_ to calls to xmail_file_msgs_$current_msgs. The default file is now returned rather than kept as internal static in xmail_file_msgs_. These changes are a result of making xmail_file_msgs_ more robust. 83-11-01 DJ Schimke: Changed the calling sequence of xmail_select_file_. 84-02-07 DJ Schimke: Modified the code executed under xmail_err_$exit_now (PREV MENU key struck) to first revert the quit condition before calling done_with_file. This prevents a null pointer fault when the quit condition handler redirects execution back to the main loop (possibly after the mailbox has been closed). phx16853 84-04-10 DJ Schimke: Modified the code which checks the message count before opening a new mail file to allow opening of a mailbox without status permission to the mailbox. It now assumes there is at least 1 message so that an attempt will be made to open the mailbox even if the message count cannot be determined (Normally we don't allow opening an empty mailbox.) The opening mode was also changed to ACCESSIBLE_MESSAGES rather than ALL_MESSAGES. This allows reading of any mailbox that you have at least "o" or "r" access to. 84-07-03 DJ Schimke: Modified to use a three-column menu format and to add the "Write" option which calls xmail_write_msgs_. Replaced the "Message(s)" in many menu options with "Messages" to reduce the width for three-column menu format. 84-08-09 JG Backs: Added a call to xmail_list_msgs_$selected after the call to xmail_select_msgs_ when option (6) Select Messages is chosen, and after the call to xmail_select_msgs_$next when option (5) Next Message is chosen. This will automatically list the summary of newly selected messages. 84-08-27 JG Backs: Created an internal procedure SELECT_FILE to replace the duplicate coding for selecting a new file within both PERFORM_OPTION and main proc. This will insure a better message if there is incorrect access to a save mailbox. phx18059. 84-11-09 JG Backs: Modified to allow the updating and redisplay of the current message line after messages are selected (option 6), but before they are listed. This allows for the status line to be current if the listing stops at a more prompt when there are many current messages. 85-01-25 JG Backs: Added code to initialize file name at beginning of module. The variable was tested in SELECT_FILE before being initialized. END DESCRIPTION */ /* AUTOMATIC */ dcl choice fixed bin; dcl code fixed bin (35); dcl default_file char (32) var; dcl deletes_ptr ptr; dcl dir char (168); dcl display_needed bit (1) aligned; dcl file char (32) varying; dcl file_info char (256) var; dcl multiple_msgs bit (1) aligned; dcl new_dir char (168); dcl new_file char (32) varying; dcl old_no_of_entries fixed bin; dcl ordinary_message_count, total_message_count fixed bin; dcl pos_line char (256); dcl position char (256) var; dcl response char (3) varying; /* yes no or ask */ dcl selecting_new_file bit (1) aligned; dcl select_file_bad bit (1) aligned; dcl status fixed bin (35); dcl treat_msgs_as_mail bit (1) aligned; dcl unused_bit bit (1) aligned; dcl unused_bit2 bit (1) aligned; dcl yes_sw bit (1) aligned; dcl another_mailbox bit (1) aligned; dcl 1 auto_open_options like open_options; dcl 1 auto_close_options like close_options; /* BASED */ dcl 1 deletes based (deletes_ptr), 2 no_of_entries fixed bin, 2 deletes_array (xn refer (no_of_entries)) char (25); /* CONDITIONS */ dcl (cleanup, program_interrupt, xmail_redisplay_menu, quit) condition; /* CONSTANTS */ dcl ALLOW_OLD bit (1) aligned init ("1"b) int static options (constant); dcl ALLOW_SELECTION bit (1) aligned init ("1"b) int static options (constant); dcl DONT_ALLOW_NEW bit (1) aligned init ("0"b) int static options (constant); dcl EMPTY_FILE_MSG char (46) int static options (constant) init ("There are no messages in the ""^a"" mail file."); dcl MSGS_AS_MAIL char (15) int static options (constant) init ("msgs_as_mail_yn"); dcl NAME init ("xmail_Consult_Files_") char (20) int static options (constant); dcl N_COLUMNS fixed bin int static options (constant) init (3); dcl OPTION_NAMES int static options (constant) init ( "Display", "Reply", "File Original", "Discard Messages", "Next Message", "Select Messages", "List Current Messages", "List All Messages", "Forward", "Retrieve Messages", "File Copy", "Print", "Write", "Select New File" ) dim (14) char (30) var; dcl TITLE init ("Process Filed Mail") char (18) int static options (constant); /* BUILTINS */ dcl (addr, null, rtrim, translate) builtin; /* ENTRIES */ dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl ioa_ entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl mail_system_$get_message_counts entry (char (*), char (*), bit (1) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl mail_system_$open_mailbox entry (char (*), char (*), ptr, char (8), ptr, fixed bin (35)); dcl mail_system_$close_mailbox entry (ptr, ptr, fixed bin (35)); dcl mail_system_$read_new_messages entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl mail_system_$read_message entry (ptr, fixed bin, fixed bin (35)); dcl xmail_create_menu_ entry (char (*), (*) char (*) var, fixed bin, ptr, fixed bin (35)); dcl xmail_error_$code_first entry() options(variable); dcl xmail_error_$no_code entry () options (variable); dcl xmail_error_$no_print entry () options (variable); dcl xmail_get_choice_ entry (ptr, char (*), char (*), char (*), char (*), bit (1) aligned, char (*), fixed bin, fixed bin (35)); dcl xmail_get_str_$yes_no entry (char(*) var, bit(1) aligned); dcl xmail_select_file_$caller_msg entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned, char (168), char (32) var, char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl xmail_select_file_$foreign_mailboxes entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned, char (168), char (32) var, char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); dcl xmail_select_msgs_$first entry (ptr, ptr, char (*)); dcl xmail_delete_dreply_ entry (ptr); dcl xmail_sw_$redisplay entry (); dcl xmail_sw_$update_position entry (char (*)); dcl xmail_undelete_msgs_ entry (ptr, ptr, char (*), char (*)); dcl xmail_value_$get_with_default entry (char(*), char(*) var, char(*) var, fixed bin(35)); /* EXTERNAL STATIC */ dcl error_table_$moderr fixed bin (35) ext static; dcl iox_$user_output ptr ext static; dcl mlsys_et_$no_more_messages fixed bin (35) ext static; dcl mlsys_et_$no_r_permission fixed bin (35) ext static; dcl xmail_err_$help_requested fixed bin (35) ext static; dcl xmail_err_$exit_now fixed bin (35) ext static; /* INTERNAL STATIC */ dcl menup int static ptr init (null); /* INCLUDE FILES */ %include xmail_windows; %page; %include menu_dcls; %page; %include xmail_data; %page; %include window_dcls; %page; %include mlsys_open_options; %page; %include mlsys_close_options; %page; %include mlsys_mailbox; %page; %include mlsys_message; %page; %include xmail_curr_msg_info; %page; %include xmail_responses; /* BEGIN */ on condition (xmail_redisplay_menu) begin; if menup ^= null then do; if ^xmail_data.reply_request then call menu_$display (xmail_windows.menu.iocb, menup, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to display menu. This is an internal programming error."); end; end; deletes_ptr = null (); call hcs_$make_seg ("", "seg_of_deletes2", "", 01010b, deletes_ptr, (0)); no_of_entries, old_no_of_entries = 0; file = ""; /* initialize file name */ mailbox_ptr = null; curr_msgsp = null; xmail_data.cleanup_signalled, xmail_data.reply_request = "0"b; on condition (cleanup) begin; call done_with_file (); end; selecting_new_file = "0"b; if menup = null then do; call xmail_create_menu_ (TITLE, OPTION_NAMES, N_COLUMNS, menup, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "q", "Unable to get menu. This is an internal programming error."); end; call SELECT_FILE; if select_file_bad then go to EXIT; on condition (program_interrupt) go to START; on condition (quit) begin; dcl xmail_window_manager_$reconnect entry (); call xmail_window_manager_$reconnect (); go to START; end; START: display_needed = "1"b; do while ("1"b); if mailbox_ptr = null then do; file = " "; file_info = " "; position = "Current message: "; go to skipit; end; call ioa_$rsnnl ("Total messages: ^d", file_info, (0), mailbox.n_messages - mailbox.n_deleted_messages); if curr_msgsp ^= null then if curr_msgs.count > 1 then multiple_msgs = "1"b; else multiple_msgs = "0"b; call ioa_$rsnnl ("Current message^[^ss^;^[s^]^]: ^a", position, (0), curr_msgsp = null, multiple_msgs, pos_line); skipit: call xmail_get_choice_ (menup, "File: " || file, (file_info), (position), xmail_data.normal_usage, display_needed, "", choice, code); display_needed = "0"b; if code = 0 then do; call PERFORM_OPTION (choice, display_needed); call mail_system_$read_new_messages (mailbox_ptr, (0), (0), (0), status); if status ^= 0 & status ^= mlsys_et_$no_more_messages then call xmail_error_$no_code (status, NAME, "q", "Unable to read mail file. This is an internal programming error."); end; else if code = xmail_err_$help_requested then call EXPLAIN_OPTION (choice); else if code = xmail_err_$exit_now then do; /* PREV MENU */ revert quit; /* close null pointer window */ call done_with_file (); go to EXIT; end; else do; call window_$bell (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot ring terminal bell. This is an internal programming error."); end; end; EXIT: return; /* INTERNAL PROCEDURES */ PERFORM_OPTION: proc (opt, redisplay); /* PARAMETERS */ dcl opt fixed bin; dcl redisplay bit (1) aligned; /* AUTOMATIC */ dcl deleted_msg_string char (25); dcl message_num fixed bin; dcl idx fixed bin; dcl idx1 fixed bin; dcl dreply_msg_ptr ptr; dcl counter fixed bin; dcl seen_msgsp ptr; dcl switch_on_off bit (2) aligned; dcl switch bit (1) aligned; /* CONSTANTS */ dcl mailbox_empty_msg char (19) static options (constant) init ("Mail file is empty."); dcl SWITCH_ON bit (2) aligned init ("10"b) int static options (constant); /* ENTRIES */ dcl unique_chars_ entry (bit (*)) returns (char (15)); dcl xmail_delete_msgs_ entry (ptr, ptr, char (*), char (*)); dcl xmail_display_msgs_ entry (ptr, ptr, ptr); dcl xmail_dprint_msgs_ entry (ptr, ptr); dcl xmail_file_msgs_$current_msgs entry (ptr, ptr, char (32) var, bit (1) aligned); dcl xmail_forward_msg_ entry (ptr, ptr); dcl xmail_list_msgs_ entry (ptr, ptr, ptr); dcl xmail_list_msgs_$selected entry (ptr, ptr, ptr); dcl xmail_list_msgs_$set_seen_switch entry (ptr, ptr, bit (1) aligned); dcl xmail_reply_msg_ entry (ptr, ptr); dcl xmail_select_msgs_ entry (ptr, ptr, ptr, bit (2) aligned, char (*)); dcl xmail_select_msgs_$next entry (ptr, ptr, char (*)); dcl xmail_write_msgs_ entry (ptr, ptr); /* BEGIN PERFORM_OPTION */ call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); go to OPT (opt); OPT (1): /* Display Option */ if curr_msgsp ^= null () then call xmail_display_msgs_ (mailbox_ptr, curr_msgsp, iox_$user_output); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (2): /* Reply option */ if curr_msgsp ^= null () then call xmail_reply_msg_ (mailbox_ptr, curr_msgsp); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (3): /* File Original Option */ if curr_msgsp ^= null () then do; call xmail_file_msgs_$current_msgs (mailbox_ptr, curr_msgsp, default_file, ALLOW_SELECTION); call mail_system_$read_new_messages (mailbox_ptr, (0), (0), (0), status); if status ^= 0 & status ^= mlsys_et_$no_more_messages then call xmail_error_$no_code (status, NAME, "q", "Unable to read mail file. This is an internal programming error."); if default_file ^= "" then call delete_msgs; end; else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (4): /* Delete Option */ if curr_msgsp ^= null () then call delete_msgs; else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (5): /* Next Message Option */ if curr_msgsp ^= null () then do; call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); call xmail_list_msgs_$selected (mailbox_ptr, curr_msgsp, iox_$user_output); end; else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (6): /* Select Messages Option */ if curr_msgsp ^= null () then do; call xmail_select_msgs_ (mailbox_ptr, curr_msgsp, seen_msgsp, switch_on_off, pos_line); call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); /* update and redisplay the new message line before list */ if seen_msgsp ^= null then do; if switch_on_off = SWITCH_ON then switch = "1"b; else switch = "0"b; call xmail_list_msgs_$set_seen_switch (mailbox_ptr, seen_msgsp, switch); free seen_msgsp -> curr_msgs; end; else if curr_msgsp ^= null then do; if curr_msgs.count > 1 then multiple_msgs = "1"b; else multiple_msgs = "0"b; call ioa_$rsnnl ("Current message^[^ss^;^[s^]^]: ^a", position, (0), curr_msgsp = null, multiple_msgs, pos_line); call xmail_sw_$update_position ((position)); call xmail_sw_$redisplay (); call xmail_list_msgs_$selected (mailbox_ptr, curr_msgsp, iox_$user_output); end; end; else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (7): /* Display Summary of Current Messages Option */ if curr_msgsp ^= null () then call xmail_list_msgs_$selected (mailbox_ptr, curr_msgsp, iox_$user_output); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (8): /* Display Summary of Messages Option */ if curr_msgsp ^= null () then call xmail_list_msgs_ (mailbox_ptr, curr_msgsp, iox_$user_output); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (9): /* Forward option */ if curr_msgsp ^= null () then call xmail_forward_msg_ (mailbox_ptr, curr_msgsp); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (10): /* Undelete Messages Option */ if mailbox_ptr ^= null () then do; call xmail_undelete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, ""); if curr_msgsp = null () then go to PERFORM_EXIT; do idx = 1 to curr_msgs.count; message_num = curr_msgs.numbers (idx); if mailbox.messages (message_num).message_ptr = null then do; call mail_system_$read_message (mailbox_ptr, message_num, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to read message ^d. This is an internal programming error.", message_num); end; dreply_msg_ptr = mailbox.messages (message_num).message_ptr; deleted_msg_string = unique_chars_ ((dreply_msg_ptr -> message.header.message_id)) || ".reply"; do idx1 = 1 to no_of_entries; if deletes_array (idx1) = deleted_msg_string then deletes_array (idx1) = ""; end; /* end do */ end; /*end do */ end; else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (11): /* File Copy Option */ if curr_msgsp ^= null () then call xmail_file_msgs_$current_msgs (mailbox_ptr, curr_msgsp, default_file, ALLOW_SELECTION); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (12): /* Print Option */ if curr_msgsp ^= null () then call xmail_dprint_msgs_ (mailbox_ptr, curr_msgsp); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (13): /* Write Option */ if curr_msgsp ^= null () then call xmail_write_msgs_ (mailbox_ptr, curr_msgsp); else call ioa_ (mailbox_empty_msg); go to PERFORM_EXIT; OPT (14): /* Select New File Option */ selecting_new_file = "1"b; xmail_data.foreign_mailbox = "1"b; call SELECT_FILE; xmail_data.foreign_mailbox = "0"b; if select_file_bad then go to PERFORM_EXIT; else go to START; delete_msgs: proc; /* Internal to PERFORM_OPTION proc */ no_of_entries = old_no_of_entries + curr_msgs.count; call hcs_$set_bc_seg (deletes_ptr, no_of_entries * 225 + 36, code); counter = 0; do idx = (old_no_of_entries + 1) to no_of_entries; counter = counter + 1; message_num = curr_msgs.numbers (counter); if mailbox.messages (message_num).message_ptr = null then do; call mail_system_$read_message (mailbox_ptr, message_num, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to read message ^d. This is an internal programming error.", message_num); end; dreply_msg_ptr = mailbox.messages (message_num).message_ptr; deletes_array (idx) = unique_chars_ ((dreply_msg_ptr -> message.header.message_id)) || ".reply"; call hcs_$status_minf ((mail_dir), (deletes_array (idx)), (0), (0), (0), code); if code = 0 then call ioa_ ("^/ The deferred reply for message no.^d was discarded.^/ To retrieve it, select the ""Retrieve Messages"" option.^/", message_num); end; old_no_of_entries = no_of_entries; call xmail_delete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, (file)); return; end delete_msgs; PERFORM_EXIT: if mailbox_ptr = null /* test for null file */ then go to START; return; end PERFORM_OPTION; SELECT_FILE: proc; /* function: a new internal procedure to select a new mail file to process. Called from both main and PERFORM_OPTION procedures. The variable, select_file_bad, is set upon entry and will only be cleared if everything is OK. */ dcl file_name char (32); /* BEGIN SELECT_FILE */ select_file_bad = "1"b; if xmail_data.foreign_mailbox then do; call xmail_select_file_$foreign_mailboxes ("mail file", "sv.mbx", "", ALLOW_OLD, DONT_ALLOW_NEW, new_dir, new_file, "Enter name of mail file you wish to process (or ?? for list)",another_mailbox, unused_bit, code); if code ^= 0 | file = new_file then goto SELECT_EXIT; end; else do; call xmail_select_file_$caller_msg ("mail file", "sv.mbx", "", ALLOW_OLD, DONT_ALLOW_NEW, new_dir, new_file, "Enter name of mail file you wish to process (or ?? for list)", unused_bit, unused_bit2, code); if code ^= 0 | file = new_file then go to SELECT_EXIT; /* msg to user */ call ioa_ ("The ""^a"" file has been selected...", new_file); /* Allow no_s_permission for reading of mailboxes other than user's. */ call mail_system_$get_message_counts (new_dir, new_file || ".sv", "1"b, total_message_count, ordinary_message_count, (0), code); if code = mlsys_et_$no_r_permission then call xmail_error_$no_code (code, NAME, "i", " You do not have access to read the ""^a"" mail file.", new_file); else if code = 0 & total_message_count = 0 then do; call ioa_ (EMPTY_FILE_MSG, new_file); go to SELECT_EXIT; end; end; /* Option "Select New File" */ if selecting_new_file then do; call done_with_file (); selecting_new_file = "0"b; end; /* Set up to open mailbox */ default_file = ""; dir = new_dir; file = new_file; /* Determine if we want all msgs or just ordinary ones */ call xmail_value_$get_with_default (MSGS_AS_MAIL, (NO), response, code); if code ^= 0 then call xmail_error_$code_first (code, NAME, "q", "^/Unable to get a value for ""^a"" in the xmail value segment.", MSGS_AS_MAIL); treat_msgs_as_mail = "0"b; if response = YES then do; treat_msgs_as_mail = "1"b; xmail_data.msgs_as_mail = "1"b; end; else if response = ASK then do; call xmail_get_str_$yes_no ("Do you wish to treat interactive msgs as mail? ", yes_sw); if yes_sw then do; treat_msgs_as_mail = "1"b; xmail_data.msgs_as_mail = "1"b; end; end; else xmail_data.msgs_as_mail = "0"b; /* Open the mailbox and set the first current message to one */ auto_open_options.version = OPEN_OPTIONS_VERSION_2; if treat_msgs_as_mail then auto_open_options.message_selection_mode = ALL_MESSAGES; else auto_open_options.message_selection_mode = ORDINARY_MESSAGES; /* if xmail_data.foreign_mailbox then auto_open_options.message_selection_mode = OWN_MESSAGES; else auto_open_options.message_selection_mode = ORDINARY_MESSAGES; */ auto_open_options.sender_selection_mode = ACCESSIBLE_MESSAGES; auto_open_options.message_reading_level = READ_KEYS; if ^another_mailbox then file_name = rtrim(file) || ".sv"; else file_name = file; call mail_system_$open_mailbox (dir, rtrim(file_name), addr (auto_open_options), MAILBOX_VERSION_2, mailbox_ptr, code); if code = error_table_$moderr then call xmail_error_$no_code (code, NAME, "i", " You do not have access to read the ""^a"" mail file.", file); else if code ^= 0 then call xmail_error_$no_code (code, NAME, "q", "Unable to open mail file, ""^a"".", file); /* clear msg */ call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); /* test for no accessible messages in mail file */ if mailbox.n_messages = 0 then do; call done_with_file; call ioa_ (EMPTY_FILE_MSG, new_file); go to SELECT_EXIT; end; call xmail_select_msgs_$first (mailbox_ptr, curr_msgsp, pos_line); if curr_msgsp = null then do; call done_with_file (); go to SELECT_EXIT; end; /* Clear to indicate file OK */ select_file_bad = "0"b; SELECT_EXIT: return; end SELECT_FILE; EXPLAIN_OPTION: proc (opt); /* PARAMETERS */ dcl opt fixed bin; /* ENTRIES */ dcl xmail_display_help_ entry (char (*), char (*), fixed bin (35)); /* BEGIN EXPLAIN_OPTION */ call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); call xmail_display_help_ (NAME || ".gi.info", translate (OPTION_NAMES (opt), "_", " "), code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to display help. This is an internal programming error."); end EXPLAIN_OPTION; done_with_file: proc (); if mailbox_ptr ^= null then do; if xmail_data.cleanup_signalled then call xmail_undelete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, ""); xmail_data.cleanup_signalled = "0"b; auto_close_options.version = CLOSE_OPTIONS_VERSION_2; auto_close_options.flags.perform_deletions = "1"b; auto_close_options.flags.report_deletion_errors = "0"b; auto_close_options.flags.mbz = "0"b; call mail_system_$close_mailbox (mailbox_ptr, addr (auto_close_options), code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to close user mailbox. This is an internal programming error."); end; xmail_data.foreign_mailbox = "0"b; if curr_msgsp ^= null () then do; free curr_msgs; curr_msgsp = null (); end; if (deletes_ptr ^= null () & no_of_entries ^= 0) then call xmail_delete_dreply_ (deletes_ptr); old_no_of_entries = 0; end done_with_file; end xmail_Consult_Files_;  xmail_Executive_Mail_.pl1 09/02/88 0759.6r w 09/02/88 0746.6 94374 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-07,Blair), approve(86-02-26,MCR7358), audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062): 85-04-22 JG Backs: Deleted the parameter from xmail_Mail_File_Maint_ references. This parameter was not needed and was being passed a null string. 2) change(86-01-07,Blair), approve(86-02-26,MCR7358), audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062): Set the flag to allow users to read their own mail in other people's mailboxes just before choosing the option to select other files. 3) change(87-01-19,Blair), approve(87-02-05,MCR7618), audit(87-04-10,RBarstad), install(87-04-26,MR12.1-1025): Determine whether we should look at all messages in the mailbox or just ordinary ones before checking to see if there are any messages in the box. END HISTORY COMMENTS */ xmail_Executive_Mail_: proc; /* BEGIN DESCRIPTION history: Author unknown. 81-07-20 Paul Kyzivat: Modified to add Review Defaults. 81-07-21 Paul Kyzivat: Modified to add option help. 83-06-27 DJ Schimke: Modified to use new mail_system calls and version 2 mailboxes. 83-10-06 DJ Schimke: Replaced call to xmail_get_line_ and associated code which asked a yes_no question with a call to xmail_get_str_$yes_no. 84-01-04 DJ Schimke: Corrected the order of the arguments to ioa_$rsnnl reported in phx16645. Replaced the (0) in the ioa_$rsnnl calls with a new variable "unused_return_length". 84-07-02 DJ Schimke: Removed call to clear the user_i/o window when setting up. It is not necessary (all the winodws are cleared individually) and was causing the status window to not be displayed properly. This is part of the change for xmail error #92. 84-07-03 DJ Schimke: Modified the call to xmail_create_menu_ to add the N_COLUMNS parameter. END DESCRIPTION */ /* AUTOMATIC */ dcl display_needed bit (1) aligned; dcl choice fixed bin; dcl code fixed bin (35); dcl yes_sw bit (1) aligned; dcl (ordinary_message_count, total_message_count, message_count) fixed bin; dcl prompt_string char (100) var; dcl response char (3) varying; /* yes no or ask */ dcl unused_return_length fixed bin (21); dcl treat_msgs_as_mail bit (1) aligned; /* CONSTANTS */ dcl MSGS_AS_MAIL char (15) int static options (constant) init ("msgs_as_mail_yn"); dcl NAME init ("xmail_Executive_Mail_") char (21) int static options (constant); dcl N_COLUMNS fixed bin int static options (constant) init (2); dcl OPTION_NAMES int static options (constant) init ( "Process Incoming Mail", "Send Mail", "Process Filed Mail", "Mailing Lists", "Review Mail Files", "Personalize Exec Mail", "Getting Started" ) dim (7) char (24) varying; /* BUILTINS */ dcl (null, sum, translate) builtin; /* CONDITIONS */ dcl (cleanup, program_interrupt, quit, xmail_leave_menu, xmail_redisplay_menu) condition; /* ENTRIES */ dcl ioa_ entry options (variable); dcl ioa_$rsnnl entry () options (variable); dcl mail_system_$get_message_counts entry (char (*), char (*), bit (1) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl xmail_display_help_ entry (char (*), char (*), fixed bin (35)); dcl xmail_display_menu_ entry (ptr, fixed bin, fixed bin (35)); dcl xmail_get_choice_ entry (ptr, char (*), char (*), char (*), char (*), bit (1) aligned, char (*), fixed bin, fixed bin (35)); dcl xmail_get_str_$yes_no entry (char (*) var, bit (1) aligned); dcl xmail_value_$get_with_default entry (char(*), char(*) var, char(*) var, fixed bin(35)); dcl xmail_error_$code_first entry () options (variable); /* EXTERNAL STATIC */ dcl iox_$user_output ptr external static; dcl xmail_err_$help_requested ext static fixed bin (35); dcl xmail_err_$exit_now ext static fixed bin (35); /* INTERNAL STATIC */ dcl menu int static ptr init (null); /* INCLUDE FILES */ %include star_structures; %page; %include menu_dcls; %page; %include xmail_data; %page; %include window_dcls; %page; %include xmail_windows; %page; %include xmail_responses; /* START */ star_names_ptr = null (); star_entry_ptr = null (); on condition (cleanup) call CLEAN_UP; on condition (xmail_leave_menu) ; on condition (xmail_redisplay_menu) begin; if menu ^= null then call menu_$display (xmail_windows.menu.iocb, menu, (0)); /* ignore error */ end; if menu ^= null then call xmail_display_menu_ (menu, 1, code); else call GET_MENU (); on condition (program_interrupt) go to START; on condition (quit) begin; dcl xmail_window_manager_$reconnect entry (); call xmail_window_manager_$reconnect (); go to START; end; START: display_needed = "1"b; do while ("1"b); call xmail_get_choice_ (menu, "", "", "", xmail_data.normal_usage, display_needed, "", choice, code); display_needed = "0"b; if code = 0 then call PERFORM_OPTION (choice, display_needed); else if code = xmail_err_$help_requested then call EXPLAIN_OPTION (choice); else if code = xmail_err_$exit_now then go to EXIT; else call window_$bell (iox_$user_output, (0)); /* ignore error */ end; EXIT: return; /* INTERNAL PROCEDURES */ PERFORM_OPTION: proc (opt, redisplay); dcl what_next char (9); dcl opt fixed bin; dcl redisplay bit (1) aligned; dcl xmail_Process_Mail_ entry (char (9), bit (1) aligned); dcl xmail_Send_Mail_ entry (char (9)); dcl xmail_Consult_Files_ entry (); dcl xmail_Review_Defaults_ entry (); dcl xmail_Review_Mlist_ entry (); dcl xmail_Mail_File_Maint_ entry (); dcl xmail_Getting_Started_ entry (); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); call window_$clear_window (iox_$user_output, (0));/* ignore error */ go to OPT (opt); OPT (1): xmail_data.mail_in_incoming = "1"b; /* Determine if we want all msgs or just ordinary ones */ call xmail_value_$get_with_default (MSGS_AS_MAIL, (NO), response, code); if code ^= 0 then call xmail_error_$code_first (code, NAME, "q", "^/Unable to get a value for ""^a"" in the xmail value segment.", MSGS_AS_MAIL); treat_msgs_as_mail = "0"b; if response = YES then do; treat_msgs_as_mail = "1"b; xmail_data.msgs_as_mail = "1"b; end; else if response = ASK then do; call xmail_get_str_$yes_no ("Do you wish to treat interactive msgs as mail? ", yes_sw); if yes_sw then do; treat_msgs_as_mail = "1"b; xmail_data.msgs_as_mail = "1"b; end; end; else xmail_data.msgs_as_mail = "0"b; /* Open the mailbox and set the first current message to one */ call mail_system_$get_message_counts ((xmail_data.mail_dir), "incoming", "1"b, total_message_count, ordinary_message_count, (0), code); if treat_msgs_as_mail then message_count = total_message_count; else message_count = ordinary_message_count; if message_count = 0 then do; xmail_data.mail_in_incoming = "0"b; call iox_$control (iox_$user_output, "reset_more", null, (0)); /* ignore error */ call ioa_ ("There are no messages in your ""incoming"" mailbox."); call hcs_$star_ ((xmail_data.mail_dir), "*.mbx", star_ALL_ENTRIES, null (), star_entry_count, (null ()), (null ()), code); if star_entry_count <= 1 then go to OPT_EXIT; call ioa_$rsnnl ("Still wish to go to ""Process Incoming Mail""? (y,n) ", prompt_string, unused_return_length); call xmail_get_str_$yes_no (prompt_string, yes_sw); if yes_sw then call window_$clear_window (iox_$user_output, code); else go to OPT_EXIT; end; what_next = ""; redisplay = "1"b; call xmail_Process_Mail_ (what_next, treat_msgs_as_mail); if what_next = "send_mail" then go to OPT (2); go to OPT_EXIT; OPT (2): what_next = ""; redisplay = "1"b; call xmail_Send_Mail_ (what_next); if what_next = "proc_mail" then go to OPT (1); go to OPT_EXIT; OPT (3): redisplay = "1"b; xmail_data.foreign_mailbox = "1"b; call xmail_Consult_Files_ (); xmail_data.foreign_mailbox = "0"b; go to OPT_EXIT; OPT (4): redisplay = "1"b; call xmail_Review_Mlist_ (); go to OPT_EXIT; OPT (5): redisplay = "1"b; call xmail_Mail_File_Maint_ (); go to OPT_EXIT; OPT (6): redisplay = "1"b; call xmail_Review_Defaults_; go to OPT_EXIT; OPT (7): redisplay = "1"b; call xmail_Getting_Started_ (); go to OPT_EXIT; OPT_EXIT: return; end PERFORM_OPTION; EXPLAIN_OPTION: proc (opt); dcl opt fixed bin; call window_$clear_window (iox_$user_output, (0));/* ignore error */ call xmail_display_help_ (NAME || ".gi.info", translate (OPTION_NAMES (opt), "_", " "), (0)); /* ignore error */ return; end EXPLAIN_OPTION; GET_MENU: proc; dcl title char (xmail_windows.menu.width) var; dcl status fixed bin (35); dcl xmail_error_$no_code entry options (variable), xmail_create_menu_ entry (char (*), (*) char (*) var, fixed bin, ptr, fixed bin (35)); call ioa_$rsnnl ("Executive Mail (Version ^a)", title, unused_return_length, xmail_version); call xmail_create_menu_ ((title), OPTION_NAMES, N_COLUMNS, menu, status); if status ^= 0 then call xmail_error_$no_code (status, NAME, "q", "A programming error has been detected which prevents " || "the use of the ^a menu.", title); /* never returns */ call xmail_display_menu_ (menu, 1, code); return; end GET_MENU; CLEAN_UP: proc; if star_names_ptr ^= null () then free star_names;/* order is important */ if star_entry_ptr ^= null () then free star_entries; end CLEAN_UP; end xmail_Executive_Mail_;  xmail_Getting_Started_.pl1 05/28/86 1058.5r w 05/28/86 1027.3 58059 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Author unknown 84-07-03 DJ Schimke: Modified the call to xmail_create_menu_ to add the N_COLUMNS parameter. */ xmail_Getting_Started_: proc (); /* Automatic */ dcl choice fixed bin; dcl code fixed bin (35); dcl display_needed bit (1) aligned; dcl initial_menu_help char (32) var; dcl saw_lifetime_init_info char (3) var init (""); /* Entries */ dcl menu_$display entry (ptr, ptr, fixed bin (35)); dcl window_$bell entry (ptr, fixed bin (35)); dcl window_$clear_window entry (ptr, fixed bin (35)); dcl xmail_error_$no_code entry () options (variable); dcl xmail_error_$no_print entry () options (variable); dcl xmail_display_help_ entry (char (*), char (*), fixed bin (35)); dcl xmail_Executive_Mail_ entry options (variable); dcl xmail_get_choice_$dm entry (ptr, char (*), char (*), char (*), char (*), bit (1) aligned, char (*), fixed bin, fixed bin (35)); dcl xmail_value_$get_with_default entry (char (*), char (*) var, char (*) var, fixed bin (35)); dcl xmail_value_$set entry (char (*), char (*) var, char (*) var, fixed bin (35)); /* Builtin */ dcl (null, translate) builtin; /* Condition */ dcl (program_interrupt, xmail_leave_menu, xmail_redisplay_menu, quit) condition; /* Constant */ dcl NAME char (22) init ("xmail_Getting_Started_") int static options (constant); dcl N_COLUMNS fixed bin static options (constant) init (2); dcl OPTION_NAMES (7) char (29) var int static options (constant) init ("Getting to Know Your Terminal", "How to Get Help", "How to Get Out", "Getting Around", "How to Correct Typos", "Personalizing Executive Mail", "Go To Executive Mail Menu"); dcl BEGIN_USAGE char (59) init ("Press a number and the associated action will be performed.") int static options (constant); /* External Static */ dcl iox_$user_output ptr ext static; dcl (xmail_err_$exit_now, xmail_err_$help_requested) fixed bin (35) ext static; /* Internal Static */ dcl menup ptr init (null) int static; on condition (xmail_leave_menu) ; on condition (xmail_redisplay_menu) begin; if menup ^= null then call menu_$display (xmail_windows.menu.iocb, menup, (0)); end; if menup = null then call GET_MENU (); call xmail_value_$get_with_default ("saw_lifetime_init_info", "no", saw_lifetime_init_info, code); if code ^= 0 then do; call xmail_error_$no_code (code, NAME, "l", "Unable to get info from user value segment. This is an internal programming error."); saw_lifetime_init_info = "no"; end; if saw_lifetime_init_info = "yes" then initial_menu_help = ""; else initial_menu_help = INITIAL_HELP; on condition (program_interrupt) go to START; on condition (quit) begin; dcl xmail_window_manager_$reconnect entry (); call xmail_window_manager_$reconnect (); go to START; end; call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to clear user_io window. This is an internal programming error."); START: display_needed = "1"b; do while ("1"b); call xmail_get_choice_$dm (menup, "", "", "", BEGIN_USAGE, display_needed, (initial_menu_help), choice, code); if saw_lifetime_init_info = "no" then do; call xmail_value_$set ("saw_lifetime_init_info", "yes", "", code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to set info in user value segment. This is an internal programming error."); initial_menu_help = ""; saw_lifetime_init_info = "yes"; end; display_needed = "0"b; if code = 0 then call PERFORM_OPTION (choice, display_needed); else if code = xmail_err_$help_requested then call EXPLAIN_OPTION (choice); else if code = xmail_err_$exit_now then return; else do; call window_$bell (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to ring terminal bell. This is an internal programming error."); end; end; %page; PERFORM_OPTION: proc (opt, redisplay); dcl opt fixed bin; dcl redisplay bit (1) aligned; dcl code fixed bin (35); call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to clear user_io window. This is an internal programming error."); go to OPT (opt); OPT (1): OPT (2): OPT (3): OPT (4): OPT (5): OPT (6): call xmail_display_help_ (GETTING_STARTED_HELP, translate (OPTION_NAMES (opt), "_", " "), code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to get help. This is an internal programming error."); return; OPT (7): call xmail_Executive_Mail_ (); redisplay = "1"b; return; end PERFORM_OPTION; EXPLAIN_OPTION: proc (opt); dcl opt fixed bin; dcl code fixed bin (35); call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to clear user_io window. This is an internal programming error."); call xmail_display_help_ (NAME || ".gi.info", translate (OPTION_NAMES (opt), "_", " "), code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to get help. This is an internal programming error."); end EXPLAIN_OPTION; %page; GET_MENU: proc (); dcl title char (15) init ("Getting Started"); dcl code fixed bin (35); dcl xmail_create_menu_ entry (char (*), (*) char (*) var, fixed bin, ptr, fixed bin (35)); call xmail_create_menu_ (title, OPTION_NAMES, N_COLUMNS, menup, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "q", "A programming error has been detected which prevents the use of the ^a menu.", title); end GET_MENU; %page; %include xmail_help_infos; %page; %include xmail_windows; end xmail_Getting_Started_;  xmail_Mail_File_Maint_.pl1 09/02/88 0759.6r w 09/02/88 0745.0 226251 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-02-03,Blair), approve(86-02-26,MCR7358), audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 85-01-18 JG Backs: Replaced call to SELECT_NEW_FILE at OPT (6) with a call to xmail_select_file_$caller_msg to eliminate opening the mailbox before renaming it. Opening is not necessary and wastes time if a large file. Choosing this option will close the previous mailbox but only after the file to be renamed is accepted. 85-04-22 JG Backs: Modified SELECT_NEW_FILE proc, adding call to ioa_ to display a message to user that the file is being worked on. If the file is large, opening will take some time and the user should know something is happening. 85-04-22 JG Backs: Deleted the P_default_file parameter from this module which was not being used. Also modified xmail_Executive_Mail_.pl1 to call this module without a parameter, since it was only passing a null string and it is the only module to call this one. Trimmed the suffix from star_names before listing the mail files and increasing the size of the space by one for each file. This was a bug where there was no space between files names if a file of max size (25 char) was listed in the first column. 2) change(86-02-03,Blair), approve(86-02-26,MCR7358), audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): Free the star_entry structures and comment out an unnecessary call to select_msgs_$all so that there aren't a lot of things hanging around in the process_dir (with no way to get to them) which got allocated when various options were looped through in succession. Error_list entry 116. 3) change(87-01-19,Blair), approve(87-02-05,MCR7618), audit(87-04-10,RBarstad), install(87-04-26,MR12.1-1025): Add code to allow the user to discriminate between interactive and ordinary messages when listing them, but always select all and don't give him a choice if he is emptying, discarding or archiving his mailfile. 4) change(87-01-21,Blair), approve(87-02-05,MCR7618), audit(87-04-10,RBarstad), install(87-04-26,MR12.1-1025): Check the width of the window to figure out how many columns are needed when we print a list of mail files. Error_list #121. END HISTORY COMMENTS */ xmail_Mail_File_Maint_: proc ; /* BEGIN DESCRIPTION history: Written by R. Ignagni Nov 1981 82-12-10 Schimke: Changed the code to use star_names (nindex(idx)) rather than star_names (idx) so addnames on mail files don't cause errors when listing mail files. Also changed loop boundary from star_entry_count to sum(star_entries(*).nnames) so addnames can be used to delete the files. TRs: 13951, 13793, 13958, 12803 83-06-27 DJ Schimke: Modified to use new mail_system calls and version 2 mailboxes. 83-10-12 DJ Schimke: Replaced call to xmail_archive_msgs_ by a call to the enhanced xmail_file_msgs_$current_msgs_. The only user-visible change is in the error messages which will say "file" rather than "archive". 83-11-01 DJ Schimke: Changed the calling sequence of xmail_select_file_. 84-04-13 DJ Schimke: Deleted the call to mail_system_$get_message_count before opening a new mail file to allow opening of a mailbox without status permission to the mailbox. The message count obtained here wasn't even used. The opening mode was also changed to ACCESSIBLE_MESSAGES rather than ALL_MESSAGES. This allows reading of any mailbox that you have at least "o" or "r" access to. 84-07-03 DJ Schimke: Modified the call to xmail_create_menu_ to add the N_COLUMNS parameter for three-column menu format. 84-08-29 JG Backs: Modified SELECT_NEW_FILE proc to test for 0 messages in a new file immediately after opening mailbox. If there are no messages, the file is closed and not displayed. This prevents a fatal error if the user tries to retrieve deleted messages from someone elses mailbox when there are no accessible messages. END DESCRIPTION */ /* CONSTANTS */ dcl OPTION_NAMES int static options (constant) init ( "List Files", "Create", "Archive", "Print", "Empty", "Rename", "List Messages", "Discard File", "Retrieve Messages" ) dim (9) char (20) var; dcl ALLOW_NEW bit (1) aligned init ("1"b) int static options (constant); dcl ALLOW_OLD bit (1) aligned init ("1"b) int static options (constant); dcl DONT_ALLOW_NEW bit (1) aligned init ("0"b) int static options (constant); dcl DONT_ALLOW_OLD bit (1) aligned init ("0"b) int static options (constant); dcl FULL_MFILE_SUFFIX char (7) init (".sv.mbx") int static options (constant); dcl MFILE_SUFFIX char (6) init ("sv.mbx") int static options (constant); dcl MSGS_AS_MAIL char (15) int static options (constant) init ("msgs_as_mail_yn"); dcl NAME char (22) init ("xmail_Mail_File_Maint_") int static options (constant); dcl NL init (" ") char (1) int static options (constant); dcl NO_FILE_MSG char (23) init ("You have no mail files.") int static options (constant); dcl NO_SELECTION bit (1) aligned init ("0"b) int static options (constant); dcl N_COLUMNS fixed bin int static options (constant) init (3); dcl TITLE char (19) init (" Review Mail Files ") int static options (constant); /* AUTOMATIC */ dcl choice fixed bin; dcl code fixed bin (35); dcl default_file char (24) varying; dcl dir char (168); dcl display_needed bit (1) aligned; dcl file char (32) varying; dcl file_indicator char (32) var; dcl file_info char (256) var; dcl file_is_empty bit (1); dcl last_file_used char (24) varying; dcl last_opt fixed bin; dcl multiple_msgs bit (1) aligned; dcl new_dir char (168); dcl new_file char (32) varying; dcl pos_line char (256); dcl position char (256) var; dcl response char (3)varying; dcl treat_msgs_as_mail bit (1) aligned; dcl unused_bit bit (1) aligned; dcl unused_bit2 bit (1) aligned; dcl yes_sw bit (1) aligned; dcl 1 auto_open_options like open_options; dcl 1 auto_close_options like close_options; /* BUILTINS */ dcl (addr, before, char, divide, ltrim, null, rtrim, substr, sum, translate, trunc) builtin; /* CONDITIONS */ dcl (cleanup, quit, program_interrupt, xmail_redisplay_menu) condition; /* ENTRIES */ dcl get_system_free_area_ entry () returns (ptr); dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl ioa_ entry options (variable); dcl ioa_$nnl entry () options (variable); dcl ioa_$rsnnl entry options (variable); dcl mail_system_$close_mailbox entry (ptr, ptr, fixed bin (35)); dcl mail_system_$open_mailbox entry (char (*), char (*), ptr, char (8), ptr, fixed bin (35)); dcl mailbox_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl xmail_error_$code_first entry() options(variable); dcl xmail_error_$code_last entry () options (variable); dcl xmail_error_$no_code entry () options (variable); dcl xmail_error_$no_print entry () options (variable); dcl xmail_get_choice_ entry (ptr, char (*), char (*), char (*), char (*), bit (1) aligned, char (*), fixed bin, fixed bin (35)); dcl xmail_get_str_$yes_no entry (char(*) var, bit(1) aligned); dcl xmail_select_file_$caller_msg entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned, char (168), char (32) var, char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl xmail_select_msgs_$all entry (ptr, ptr, char (*)); dcl xmail_create_menu_ entry (char (*), (*) char (*) var, fixed bin, ptr, fixed bin (35)); dcl xmail_value_$get_with_default entry (char(*), char(*) var, char(*) var, fixed bin(35)); /* EXTERNAL STATIC */ dcl error_table_$moderr fixed bin (35) ext static; dcl iox_$user_output ptr external static; dcl xmail_err_$exit_now ext static fixed bin (35); dcl xmail_err_$help_requested ext static fixed bin (35); /* INTERNAL STATIC */ dcl menup int static ptr init (null); /* INCLUDE FILES */ %include star_structures; %page; %include xmail_windows; %page; %include menu_dcls; %page; %include xmail_data; %page; %include window_dcls; %page; %include mlsys_open_options; %page; %include mlsys_close_options; %page; %include mlsys_mailbox; %page; %include mlsys_message; %page; %include xmail_curr_msg_info; %page; %include xmail_responses; /* BEGIN */ on condition (xmail_redisplay_menu) begin; if menup ^= null then call menu_$display (xmail_windows.menu.iocb, menup, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to display menu. This is an internal programming error."); end; menup = null (); last_opt = 0; default_file = ""; mailbox_ptr = null; curr_msgsp = null; file_info = " "; position = " "; file = ""; star_names_ptr = null (); star_entry_ptr = null (); on condition (cleanup) begin; call CLEAN_UP (); end; if menup = null then do; call xmail_create_menu_ (TITLE, OPTION_NAMES, N_COLUMNS, menup, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "q", "Unable to get menu. This is an internal programming error."); end; on condition (program_interrupt) go to START; on condition (quit) begin; dcl xmail_window_manager_$reconnect entry (); call xmail_window_manager_$reconnect (); go to START; end; START: display_needed = "1"b; do while ("1"b); if star_names_ptr ^= null () then free star_names;/* order is important */ if star_entry_ptr ^= null () then free star_entries; star_entry_ptr, star_names_ptr = null; call hcs_$star_ ((xmail_data.mail_dir), "**" || FULL_MFILE_SUFFIX, star_ALL_ENTRIES, get_system_free_area_ (), star_entry_count, star_entry_ptr, star_names_ptr, (0)); if mailbox_ptr = null () then do; file_indicator = " "; file_info = " "; go to skipit; end; call ioa_$rsnnl ("Total messages: ^d", file_info, (0), mailbox.n_messages - mailbox.n_deleted_messages); if (mailbox.n_messages - mailbox.n_deleted_messages) > 0 then file_is_empty = "0"b; else file_is_empty = "1"b; if curr_msgsp ^= null then if curr_msgs.count > 1 then multiple_msgs = "1"b; else multiple_msgs = "0"b; file_indicator = "File: " || file; skipit: position = " "; call xmail_get_choice_ (menup, (file_indicator), (file_info), (position), xmail_data.normal_usage, display_needed, "", choice, code); display_needed = "0"b; if code = 0 then call PERFORM_OPTION (choice, display_needed); else if code = xmail_err_$help_requested then call EXPLAIN_OPTION (choice); else if code = xmail_err_$exit_now then go to EXIT; else do; call window_$bell (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot ring terminal bell. This is an internal programming error."); end; end; EXIT: call CLEAN_UP (); return; %page; /* INTERNAL PROCEDURES */ PERFORM_OPTION: proc (opt, redisplay); /* Auto */ dcl discarded bit (1) aligned; dcl entry_is_link bit (1); dcl i fixed bin; dcl idx fixed bin; dcl mbx_name char (32); dcl msg_pointer ptr; dcl opt fixed bin; dcl redisplay bit (1) aligned; /* Entries */ dcl mlsys_utils_$create_mailbox entry (char (*), char (*), fixed bin (35)); dcl xmail_delete_msgs_ entry (ptr, ptr, char (*), char (*)); dcl xmail_discard_file_ entry (ptr, ptr, char (*), bit (1) aligned); dcl xmail_discard_file_$link entry (ptr, ptr, char (*), bit (1) aligned); dcl xmail_dprint_msgs_ entry (ptr, ptr); dcl xmail_file_msgs_$current_msgs entry (ptr, ptr, char (32) var, bit (1) aligned); dcl xmail_list_msgs_ entry (ptr, ptr, ptr); dcl xmail_undelete_msgs_ entry (ptr, ptr, char (*), char (*)); /* BEGIN PERFORM OPTION */ call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); entry_is_link = "0"b; if opt = last_opt then last_file_used = ""; else last_file_used = default_file; go to OPT (opt); OPT (1): /* List mail files option */ if star_entry_count = 0 then do; call ioa_ ("^a", NO_FILE_MSG); return; end; call ioa_ ("You have ^d mail files:", star_entry_count); begin; dcl mail_file_list char (star_entry_count * 27); dcl char_count fixed bin; dcl no_columns fixed bin; mail_file_list = ""; char_count = 0; /* How many columns will fit across our line width? */ no_columns = trunc(divide(xmail_windows.bottom.extent.width,26,2)); do i = 1 to star_entry_count; /* strip off suffix */ star_names (star_entries.nindex (i)) = rtrim (before (star_names (star_entries.nindex (i)), FULL_MFILE_SUFFIX)); end; do i = 1 by no_columns to star_entry_count; /* put a newline char in front of each set of 3 files */ star_names (star_entries.nindex (i)) = NL || substr (star_names (star_entries.nindex (i)), 1, 31); end; do i = 1 to star_entry_count; mail_file_list = substr (mail_file_list, 1, char_count) || (star_names (star_entries.nindex (i))); char_count = char_count + 27; end; /* end of do loop */ call ioa_ ("^a", mail_file_list); end; /* end of begin block */ return; OPT (2): /* Create mail file option */ call xmail_select_file_$caller_msg ("mail file", MFILE_SUFFIX, "", DONT_ALLOW_OLD, ALLOW_NEW, new_dir, new_file, "Enter name of mail file you wish to create", unused_bit, unused_bit2, code); if code ^= 0 then do; call ioa_ ("Unable to create mail file. This is an internal programming error."); return; end; mbx_name = rtrim (new_file) || FULL_MFILE_SUFFIX; call mlsys_utils_$create_mailbox (new_dir, mbx_name, code); if code = 0 then call ioa_ ("Mail file ""^a"" created.", new_file); else call ioa_ ("Unable to create mail file ""^a"".^/This is an internal programming error.", new_file); return; OPT (3): /* Archive file option */ if star_entry_count = 0 then do; call ioa_ (NO_FILE_MSG); return; end; if default_file = "xmail_archive" | file_is_empty then call SELECT_NEW_FILE ("archive", ""); else call SELECT_NEW_FILE ("archive", (last_file_used)); last_opt = opt; if file = "xmail_archive" then do; call ioa_ ("Sorry, but you cannot archive your archive file."); return; end; if file_is_empty then do; call ioa_ ("Mail file ""^a"" is empty.", file); return; end; call xmail_file_msgs_$current_msgs (mailbox_ptr, curr_msgsp, "xmail_archive", NO_SELECTION); call xmail_delete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, (file)); file_is_empty = "1"b; return; OPT (4): /* Print all messages option */ if star_entry_count = 0 then do; call ioa_ (NO_FILE_MSG); return; end; if file_is_empty then last_file_used = ""; call SELECT_NEW_FILE ("print", (last_file_used)); last_opt = opt; if file_is_empty then do; call ioa_ ("Mail file ""^a"" is empty.", file); return; end; call xmail_dprint_msgs_ (mailbox_ptr, curr_msgsp); return; OPT (5): /* Empty File Option */ if star_entry_count = 0 then do; call ioa_ (NO_FILE_MSG); return; end; if file_is_empty then last_file_used = ""; call SELECT_NEW_FILE ("empty", (last_file_used)); last_opt = opt; if file_is_empty then do; call ioa_ ("Mail file ""^a"" is already empty.", file); return; end; call xmail_select_msgs_$all (mailbox_ptr, curr_msgsp, pos_line); call xmail_delete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, (file)); file_is_empty = "1"b; return; OPT (6): /* Rename Option */ if default_file = "outgoing" then last_file_used = ""; call xmail_select_file_$caller_msg ("mail file", "sv.mbx", (last_file_used), ALLOW_OLD, DONT_ALLOW_NEW, new_dir, new_file, "Enter name of file you wish to rename", unused_bit, unused_bit2, code); if new_file = "outgoing" then do; call ioa_ ("Sorry, but the ""^a"" mail file is required and cannot be renamed.", new_file); return; end; call done_with_file (); /* close prev mailbox */ /* but do not open new one */ dir = new_dir; file = new_file; default_file = file; call ioa_$nnl ("Renaming ""^a"": ", file); call xmail_select_file_$caller_msg ("mail file", "sv.mbx", "", DONT_ALLOW_OLD, ALLOW_NEW, new_dir, new_file, "New name", unused_bit, unused_bit2, code); if code ^= 0 then do; call ioa_ ("Selection of new mail file name not successful."); return; end; call mailbox_$chname_file (rtrim (new_dir), file || "." || MFILE_SUFFIX, file || "." || MFILE_SUFFIX, rtrim (new_file) || "." || MFILE_SUFFIX, code); if code ^= 0 then call xmail_error_$code_last (code, NAME, "q", "Renaming of mail file failed."); call ioa_ ("Mail file name changed from ""^a"" to ""^a"".", file, new_file); file = new_file; dir = new_dir; default_file = file; last_opt = opt; return; OPT (7): /* Display Summary of Messages Option */ if star_entry_count = 0 then do; call ioa_ (NO_FILE_MSG); return; end; if file_is_empty then last_file_used = ""; call SELECT_NEW_FILE ("list", (last_file_used)); last_opt = opt; if file_is_empty then do; call ioa_ ("Mail file ""^a"" is empty.", file); return; end; call xmail_list_msgs_ (mailbox_ptr, curr_msgsp, iox_$user_output); return; OPT (8): /* Discard mail file option */ if star_entry_count = 0 then do; call ioa_ (NO_FILE_MSG); return; end; if default_file = "outgoing" then call SELECT_NEW_FILE ("discard", ""); else call SELECT_NEW_FILE ("discard", (last_file_used)); if file = "outgoing" then do; call ioa_ ("Sorry, but the ""^a"" mail file is required and cannot be discarded.", file); return; end; last_opt = opt; msg_pointer = curr_msgsp; if file_is_empty then msg_pointer = null (); /* else call xmail_select_msgs_$all (mailbox_ptr, msg_pointer, pos_line); this is redundant because selection is done above */ do idx = 1 to star_entry_count; do i = star_entries (idx).nindex to star_entries (idx).nindex + star_entries (idx).nnames - 1; if rtrim (file) = before (star_names (i), FULL_MFILE_SUFFIX) then go to success; end; end; call xmail_error_$no_code (code, NAME, "q", "Sorry, but an internal programming error has occurred.^/Mail file ""^a"" could not be discarded.", file); success: if star_entries (idx).type = 0 then call xmail_discard_file_$link (mailbox_ptr, msg_pointer, (file), discarded); else call xmail_discard_file_ (mailbox_ptr, msg_pointer, (file), discarded); /* curr_msgsp = null; */ if discarded = "0"b then return; mailbox_ptr = null (); file_info = ""; default_file = ""; file = ""; if (star_entry_count - 1) < 1 then call ioa_ ("You have no more mail files."); return; OPT (9): /* Retrieve option */ if mailbox_ptr = null () then do; call ioa_ ("Sorry, but no messages can be retrieved for one or more reasons: 1. You have not discarded any messages 2. You have changed mail file since you last discarded messages 3. You have discarded the mail file"); return; end; call xmail_undelete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, "all"); return; end PERFORM_OPTION; %page; EXPLAIN_OPTION: proc (opt); dcl opt fixed bin; dcl xmail_display_help_ entry (char (*), char (*), fixed bin (35)); call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); call xmail_display_help_ (NAME || ".gi.info", translate (OPTION_NAMES (opt), "_", " "), code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to display help. This is an internal programming error."); end EXPLAIN_OPTION; done_with_file: proc (); if mailbox_ptr ^= null then do; auto_close_options.version = CLOSE_OPTIONS_VERSION_2; auto_close_options.flags.perform_deletions = "1"b; auto_close_options.flags.report_deletion_errors = "0"b; auto_close_options.flags.mbz = "0"b; call mail_system_$close_mailbox (mailbox_ptr, addr (auto_close_options), code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to close user mailbox. This is an internal programming error."); end; if curr_msgsp ^= null then do; free curr_msgs; curr_msgsp = null; end; return; end done_with_file; SELECT_NEW_FILE: proc (P_text, P_default_file); dcl P_text char (*) parameter; dcl P_default_file char (*) parameter; dcl user_message char (78) varying; dcl xmail_sw_$update_file entry (char (*)); dcl xmail_sw_$update_file_info entry (char (*)); dcl xmail_sw_$redisplay entry (); user_message = "Enter name of file you wish to " || P_text || " "; call xmail_select_file_$caller_msg ("file", "sv.mbx", (P_default_file), ALLOW_OLD, DONT_ALLOW_NEW, new_dir, new_file, (user_message), unused_bit, unused_bit2, code); if code = 0 then do; /* msg to user */ call ioa_ ("The ""^a"" file has been selected...", new_file); call done_with_file (); dir = new_dir; file = new_file; /* Determine if we want all msgs or just ordinary ones */ call xmail_value_$get_with_default (MSGS_AS_MAIL, (NO), response, code); if code ^= 0 then call xmail_error_$code_first (code, NAME, "q", "^/Unable to get a value for ""^a"" in the xmail value segment.", MSGS_AS_MAIL); treat_msgs_as_mail = "0"b; if response = YES | choice = 3 | choice = 5 | choice = 8 then do; treat_msgs_as_mail = "1"b; xmail_data.msgs_as_mail = "1"b; end; else if response = ASK then do; call xmail_get_str_$yes_no ("Do you wish to treat interactive msgs as mail? ", yes_sw); if yes_sw then do; treat_msgs_as_mail = "1"b; xmail_data.msgs_as_mail = "1"b; end; end; else xmail_data.msgs_as_mail = "0"b; /* Open the mailbox and set the first current message to one */ auto_open_options.version = OPEN_OPTIONS_VERSION_2; if treat_msgs_as_mail then auto_open_options.message_selection_mode = ALL_MESSAGES; else auto_open_options.message_selection_mode = ORDINARY_MESSAGES; auto_open_options.sender_selection_mode = ACCESSIBLE_MESSAGES; auto_open_options.message_reading_level = READ_KEYS; call mail_system_$open_mailbox (dir, file || ".sv", addr (auto_open_options), MAILBOX_VERSION_2, mailbox_ptr, code); if code = error_table_$moderr then call xmail_error_$no_code (code, NAME, "i", "You do not have access to the ""^a"" mail file.", new_file); if code ^= 0 then call xmail_error_$no_code (code, NAME, "q", "Unable to open mail file. This is an internal programming error."); /* clear msg */ call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); if mailbox.n_messages = 0 then do; call done_with_file; file_is_empty = "1"b; end; else do; call xmail_select_msgs_$all (mailbox_ptr, curr_msgsp, pos_line); call xmail_sw_$update_file ("File: " || (file)); call xmail_sw_$update_file_info (rtrim ("Total messages: " || ltrim (char (mailbox.n_messages - mailbox.n_deleted_messages)))); call xmail_sw_$redisplay (); if (mailbox.n_messages - mailbox.n_deleted_messages) > 0 then file_is_empty = "0"b; else file_is_empty = "1"b; default_file = file; end; end; SELECT_NEW_FILE_EXIT: return; end SELECT_NEW_FILE; CLEAN_UP: proc (); call done_with_file; if star_names_ptr ^= null () then free star_names;/* order is important */ if star_entry_ptr ^= null () then free star_entries; return; end CLEAN_UP; end xmail_Mail_File_Maint_;  xmail_Process_Mail_.pl1 09/02/88 0759.6r w 09/02/88 0745.0 242136 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-07,Blair), approve(86-01-07,MCR7358), audit(86-05-19,RBarstad), install(86-05-28,MR12.0-1062): Added the variable foreign_mailbox to be set on before calling xmail_Consult_Files_ in Option 14 so we can access mail in other users' mailboxes. 2) change(86-02-25,Blair), approve(86-02-25,MCR7358), audit(86-05-19,RBarstad), install(86-05-28,MR12.0-1062): Change call to xmail_select_msgs_ in OPT (6) so that this option can be used to set the seen switch for messages as well as select them. Now there is a ptr to a structure of seen_msgs, and a switch_on_off flag. 3) change(87-01-21,Blair), approve(87-02-05,MCR7618), audit(87-04-14,RBarstad), install(87-04-26,MR12.1-1025): Pass a new parameter to indicate whether or not we're processing msgs as mail and get the msgs in the mailbox based on the value. 4) change(87-02-10,Blair), approve(87-02-10,MCR7618), audit(87-04-14,RBarstad), install(87-04-26,MR12.1-1025): Check to see if we're processing a reply request when we execute the redisplay_menu condition code and don't display the menu on a reply. This prevents the screen being messed up after a reconnect. Error_list #114. END HISTORY COMMENTS */ /* Author unknown. 83-06-27 DJ Schimke: Modified to use new mail_system calls and version 2 mailboxes. 83-09-22 DJ Schimke: Added calls to mail_system_$read_new_messages in PERFORM_OPTION to inform user of new mail and update mailbox structure so any new messages are available to the user. phx14130 Created the internal procedures: delete_msgs and NEW_MESSAGES. 83-10-04 DJ Schimke: Changed want_to_examine_more internal proc to call xmail_get_str_$yes_no rather than xmail_get_str_. 83-10-10 DJ Schimke: Changed bothg calls to xmail_file_msgs_ to calls to xmail_file_msgs_$current_msgs. The default file is now returned rather than kept as internal static in xmail_file_msgs_. These changes are a result of making xmail_file_msgs_ more robust. 83-11-01 DJ Schimke: Changed the calling sequence of xmail_select_file_. 84-04-11 DJ Schimke: Changed the opening sender_selection_mode from ALL_MESSAGES to ACCESSIBLE_MESSAGES so mailboxes with either "r" or "o" access can be opened and read. 84-07-03 DJ Schimke: Modified to use a three-column menu format and to add the "Write" option which calls xmail_write_msgs_. Replaced the "Message(s)" in many menu options with "Messages" to reduce the width for three-column menu format. 84-08-10 JG Backs: Added a call to xmail_list_msgs_$selected after the call to xmail_select_msgs_ when option (6) Select Messages is chosen, and after the call to xmail_select_msgs_$next when option (5) Next Message is chosen. This will automatically list the summary of current messages. 84-11-09 JG Backs: Modified to allow the updating and redisplay of the current message line after messages are selected (option 6), but before they are listed. This allows for the status line to be current if the listing stops at a more prompt when there are many current messages. 84-12-07 JG Backs: Changed the call to xmail_select_msgs_$next in OPT (2) in PERFORM OPTION proc to only occur if NEW_MESSAGES is true and curr_msgsp is null. This is the same as all the other OPT's. It was testing for curr_msgsp ^= null and in the case of replying and saving to incoming, the current messages line was being incorrectly updated to the next message. TR 18632. */ /* format: style1 */ xmail_Process_Mail_: proc (what_next, treat_msgs_as_mail); /* Parameter */ dcl treat_msgs_as_mail bit (1) aligned; dcl what_next char (9); /* Automatic */ dcl choice fixed bin; dcl code fixed bin (35); dcl def_prompt char (8) var; dcl default_file char (32) var; dcl deletes_ptr ptr; dcl dir char (168); dcl file char (32) varying; dcl file_info char (256) var; dcl multiple_msgs bit (1) aligned; dcl n_interactive_msgs fixed bin; dcl n_new_msgs fixed bin; dcl n_total_msgs fixed bin; dcl n_ordinary_msgs fixed bin; dcl old_no_of_entries fixed bin; dcl pos_line char (256); dcl position char (256) var; dcl redisplay_menu bit (1) aligned; dcl return_to_caller bit (1) aligned; dcl status fixed bin (35); dcl unused_bit bit (1) aligned; dcl unused_bit2 bit (1) aligned; dcl 1 auto_open_options like open_options; dcl 1 auto_close_options like close_options; /* Constant */ dcl ALLOW_OLD bit (1) aligned init ("1"b) int static options (constant); dcl ALLOW_SELECTION bit (1) aligned init ("1"b) int static options (constant); dcl DONT_ALLOW_NEW bit (1) aligned init ("0"b) int static options (constant); dcl NAME init ("xmail_Process_Mail_") char (19) int static options (constant); dcl N_COLUMNS fixed bin int static options (constant) init (3); dcl OPTION_NAMES int static options (constant) init ( "Display", "Reply", "File Original", "Discard Messages", "Next Message", "Select Messages", "List Current Messages", "List All Messages", "Forward", "Retrieve Messages", "File Copy", "Print", "Write", "Process Filed Mail", "Send Mail" ) dim (15) char (30) var; dcl INCLUDE_BY_TYPE bit (1) aligned int static options (constant) init ("1"b); /* Based */ dcl 1 deletes based (deletes_ptr), 2 no_of_entries fixed bin, 2 deletes_array (xn refer (no_of_entries)) char (25); /* Internal Static */ dcl menup int static ptr init (null); /* External Static */ dcl error_table_$moderr fixed bin (35) ext static; dcl iox_$user_output ptr external static; dcl mlsys_et_$no_more_messages fixed bin (35) ext static; dcl mlsys_et_$no_o_permission fixed bin (35) ext static; dcl mlsys_et_$no_r_permission fixed bin (35) ext static; dcl mlsys_et_$no_s_permission fixed bin (35) ext static; dcl xmail_err_$exit_now ext static fixed bin (35); dcl xmail_err_$help_requested ext static fixed bin (35); dcl xmail_err_$int_prog_err ext static fixed bin (35); /* Entries */ dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); dcl ioa_ entry options (variable); dcl ioa_$rsnnl entry () options (variable); dcl mail_system_$close_mailbox entry (ptr, ptr, fixed bin (35)); dcl mail_system_$open_mailbox entry (char (*), char (*), ptr, char (8), ptr, fixed bin (35)); dcl mail_system_$read_new_messages entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl mail_system_$read_message entry (ptr, fixed bin, fixed bin (35)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl xmail_delete_dreply_ entry (ptr); dcl xmail_display_menu_ entry (ptr, fixed bin, fixed bin (35)); dcl xmail_error_$code_last entry () options (variable); dcl xmail_error_$no_code entry () options (variable); dcl xmail_error_$no_print entry () options (variable); dcl xmail_get_choice_ entry (ptr, char (*), char (*), char (*), char (*), bit (1) aligned, char (*), fixed bin, fixed bin (35)); dcl xmail_select_file_$caller_msg entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned, char (168), char (32) var, char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl xmail_select_msgs_$first entry (ptr, ptr, char (*)); dcl xmail_sw_$redisplay entry (); dcl xmail_sw_$update_position entry (char (*)); dcl xmail_undelete_msgs_ entry (ptr, ptr, char (*), char (*)); /* Condition */ dcl (cleanup, program_interrupt, xmail_leave_menu, xmail_redisplay_menu, quit) condition; /* Builtin */ dcl (addr, null, rtrim, translate) builtin; on condition (xmail_redisplay_menu) begin; if menup ^= null then do; if ^xmail_data.reply_request then call menu_$display (xmail_windows.menu.iocb, menup, code); if code ^= 0 then do; call xmail_error_$no_code (code, NAME, "l", "Sorry, unable to display menu. This is an internal programming error."); call timer_manager_$sleep (4, "11"b); end; end; end; default_file = ""; mailbox_ptr = null; curr_msgsp = null; xmail_data.cleanup_signalled, xmail_data.reply_request = "0"b; on condition (xmail_leave_menu) begin; call query_if_more_msgs (); end; deletes_ptr = null (); call hcs_$make_seg ("", "seg_of_deletes1", "", 01010b, deletes_ptr, (0)); no_of_entries, old_no_of_entries = 0; on condition (cleanup) begin; call leave_menu (); end; if xmail_data.mail_in_incoming then def_prompt = "incoming"; else def_prompt = ""; call xmail_select_file_$caller_msg ("mailbox", "mbx", (def_prompt), ALLOW_OLD, DONT_ALLOW_NEW, dir, file, "Enter name of mailbox you wish to process", unused_bit, unused_bit2, code); if code ^= 0 then call error_leave_menu (); if menup ^= null then call xmail_display_menu_ (menup, 2, code); else call GET_MENU (); /* Open the mailbox and set the first current message to one */ auto_open_options.version = OPEN_OPTIONS_VERSION_2; if treat_msgs_as_mail then auto_open_options.message_selection_mode = ALL_MESSAGES; else auto_open_options.message_selection_mode = ORDINARY_MESSAGES; auto_open_options.sender_selection_mode = ACCESSIBLE_MESSAGES; auto_open_options.message_reading_level = READ_KEYS; call mail_system_$open_mailbox (dir, (file), addr (auto_open_options), MAILBOX_VERSION_2, mailbox_ptr, code); if code = 0 then go to all_ok; if code = error_table_$moderr | code = mlsys_et_$no_o_permission | code = mlsys_et_$no_r_permission then do; call ioa_ ("Sorry, but you do not have permission to read the specified mailbox."); call error_leave_menu (); end; else do; call xmail_error_$code_last (xmail_err_$int_prog_err, NAME, "l", "Sorry, unable to get contents of mailbox: ^a", (file)); call error_leave_menu (); end; all_ok: call xmail_select_msgs_$first (mailbox_ptr, curr_msgsp, pos_line); if curr_msgsp = null /* error has occured and been diagnosed */ then call error_leave_menu (); if mailbox.n_messages = 0 then do; call ioa_ ("There are no messages in the ""^a"" mailbox.", file); /* call error_leave_menu(); */ curr_msgsp = null (); pos_line = "NONE"; if file = "incoming" then xmail_data.mail_in_incoming = "0"b; goto START; end; on condition (program_interrupt) go to START; on condition (quit) begin; dcl xmail_window_manager_$reconnect entry; call xmail_window_manager_$reconnect (); go to START; end; call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to clear user_io window. This is an internal programming error."); START: redisplay_menu = "1"b; return_to_caller = "0"b; do while ("1"b); if rtrim (pos_line) = "NONE" then xmail_data.mail_in_incoming = "0"b; call ioa_$rsnnl ("Total messages: ^d", file_info, (0), mailbox.n_messages - mailbox.n_deleted_messages); if curr_msgsp ^= null then if curr_msgs.count > 1 then multiple_msgs = "1"b; else multiple_msgs = "0"b; call ioa_$rsnnl ("Current message^[^ss^;^[s^]^]: ^a", position, (0), curr_msgsp = null, multiple_msgs, pos_line); call xmail_get_choice_ (menup, "Mailbox: " || file, (file_info), (position), xmail_data.normal_usage, redisplay_menu, "", choice, code); redisplay_menu = "0"b; if code = 0 then do; call PERFORM_OPTION (choice, redisplay_menu); if return_to_caller then do; call leave_menu (); return; end; end; else if code = xmail_err_$help_requested then call EXPLAIN_OPTION (choice); else if code = xmail_err_$exit_now then do; call query_if_more_msgs (); call leave_menu (); go to EXIT; end; else do; call window_$bell (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot ring terminal bell. This is an internal programming error."); end; end; EXIT: return; %page; PERFORM_OPTION: proc (opt, redisplay); dcl xmail_delete_msgs_ entry (ptr, ptr, char (*), char (*)); dcl xmail_display_msgs_ entry (ptr, ptr, ptr); dcl xmail_dprint_msgs_ entry (ptr, ptr); dcl xmail_file_msgs_$current_msgs entry (ptr, ptr, char (32) var, bit (1) aligned); dcl xmail_forward_msg_ entry (ptr, ptr); dcl xmail_list_msgs_ entry (ptr, ptr, ptr); dcl xmail_list_msgs_$selected entry (ptr, ptr, ptr); dcl xmail_list_msgs_$set_seen_switch entry (ptr, ptr, bit (1) aligned); dcl xmail_reply_msg_ entry (ptr, ptr); dcl xmail_select_msgs_ entry (ptr, ptr, ptr, bit (2) aligned, char (*)); dcl xmail_select_msgs_$next entry (ptr, ptr, char (*)); dcl xmail_write_msgs_ entry (ptr, ptr); dcl xmail_Consult_Files_ entry (); dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); dcl unique_chars_ entry (bit (*)) returns (char (15)); dcl deleted_msg_string char (25); dcl opt fixed bin; dcl message_num fixed bin; dcl idx fixed bin; dcl idx1 fixed bin; dcl dreply_msg_ptr ptr; dcl counter fixed bin; dcl redisplay bit (1) aligned; dcl seen_msgsp ptr; dcl switch bit (1) aligned; dcl switch_on_off bit (2) aligned; dcl SWITCH_ON bit (2) aligned init ("10"b) int static options (constant); dcl MAILBOX_EMPTY_MSG char (17) static options (constant) init ("Mailbox is empty."); call window_$clear_window (iox_$user_output, code); go to OPT (opt); OPT (1): /* Display Messages Option */ if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); if curr_msgsp ^= null () then call xmail_display_msgs_ (mailbox_ptr, curr_msgsp, iox_$user_output); else call ioa_ (MAILBOX_EMPTY_MSG); return; OPT (2): /* Reply to Messages */ if curr_msgsp ^= null () then call xmail_reply_msg_ (mailbox_ptr, curr_msgsp); else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null () then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (3): /* File Original Option */ if curr_msgsp ^= null () then do; call xmail_file_msgs_$current_msgs (mailbox_ptr, curr_msgsp, default_file, ALLOW_SELECTION); if default_file ^= "" then call delete_msgs; end; else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (4): /* Delete Messages Option */ if curr_msgsp ^= null () then call delete_msgs; else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (5): /* Next Message Option */ if curr_msgsp ^= null | (NEW_MESSAGES () & curr_msgsp = null) then do; call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); call xmail_list_msgs_$selected (mailbox_ptr, curr_msgsp, iox_$user_output); end; else call ioa_ (MAILBOX_EMPTY_MSG); return; OPT (6): /* Select Messages Option */ if curr_msgsp = null then if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); if curr_msgsp ^= null then do; call xmail_select_msgs_ (mailbox_ptr, curr_msgsp, seen_msgsp, switch_on_off, pos_line); call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Unable to clear user_io window. This is an internal programming error."); /* update and redisplay the new message line before list */ if seen_msgsp ^= null then do; if switch_on_off = SWITCH_ON then switch = "1"b; else switch = "0"b; call xmail_list_msgs_$set_seen_switch (mailbox_ptr, seen_msgsp, switch); free seen_msgsp -> curr_msgs; end; else if curr_msgsp ^= null then do; if curr_msgs.count > 1 then multiple_msgs = "1"b; else multiple_msgs = "0"b; call ioa_$rsnnl ("Current message^[^ss^;^[s^]^]: ^a", position, (0), curr_msgsp = null, multiple_msgs, pos_line); call xmail_sw_$update_position ((position)); call xmail_sw_$redisplay (); call xmail_list_msgs_$selected (mailbox_ptr, curr_msgsp, iox_$user_output); end; end; else call ioa_ (MAILBOX_EMPTY_MSG); return; OPT (7): /* Display Summary of Current Messages Option */ if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); if curr_msgsp ^= null then call xmail_list_msgs_$selected (mailbox_ptr, curr_msgsp, iox_$user_output); else call ioa_ (MAILBOX_EMPTY_MSG); return; OPT (8): /* Display Summary of Messages Option */ if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); if curr_msgsp ^= null then call xmail_list_msgs_ (mailbox_ptr, curr_msgsp, iox_$user_output); else call ioa_ (MAILBOX_EMPTY_MSG); return; OPT (9): /* Forward Messages */ if curr_msgsp ^= null () then call xmail_forward_msg_ (mailbox_ptr, curr_msgsp); else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (10): /* Undelete Messages Option */ call xmail_undelete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, ""); if curr_msgsp ^= null () then do; do idx = 1 to curr_msgs.count; message_num = curr_msgs.numbers (idx); if mailbox.messages (message_num).message_ptr = null then do; call mail_system_$read_message (mailbox_ptr, message_num, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to read message ^d. This is an internal programming error.", message_num); end; dreply_msg_ptr = mailbox.messages (message_num).message_ptr; deleted_msg_string = unique_chars_ ((dreply_msg_ptr -> message.header.message_id)) || ".reply"; do idx1 = 1 to no_of_entries; if deletes_array (idx1) = deleted_msg_string then deletes_array (idx1) = ""; end; end; if rtrim (file) = "incoming" then xmail_data.mail_in_incoming = "1"b; end; if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (11): /* File Copy Option */ if curr_msgsp ^= null () then call xmail_file_msgs_$current_msgs (mailbox_ptr, curr_msgsp, default_file, ALLOW_SELECTION); else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (12): /* Print Messages Option */ if curr_msgsp ^= null () then call xmail_dprint_msgs_ (mailbox_ptr, curr_msgsp); else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (13): /* Write Messages Option */ if curr_msgsp ^= null () then call xmail_write_msgs_ (mailbox_ptr, curr_msgsp); else call ioa_ (MAILBOX_EMPTY_MSG); if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); return; OPT (14): /* Process Filed Mail Option */ if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); redisplay = "1"b; xmail_data.foreign_mailbox = "1"b; call xmail_Consult_Files_ (); xmail_data.foreign_mailbox = "0"b; return; OPT (15): /* Send Mail Option */ if NEW_MESSAGES () & curr_msgsp = null then call xmail_select_msgs_$next (mailbox_ptr, curr_msgsp, pos_line); what_next = "send_mail"; return_to_caller = "1"b; return; %page; delete_msgs: proc; no_of_entries = old_no_of_entries + curr_msgs.count; call hcs_$set_bc_seg (deletes_ptr, no_of_entries * 225 + 36, code); counter = 0; do idx = (old_no_of_entries + 1) to no_of_entries; counter = counter + 1; message_num = curr_msgs.numbers (counter); if mailbox.messages (message_num).message_ptr = null then do; call mail_system_$read_message (mailbox_ptr, message_num, code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to read message ^d. This is an internal programming error.", message_num); end; dreply_msg_ptr = mailbox.messages (message_num).message_ptr; deletes_array (idx) = unique_chars_ ((dreply_msg_ptr -> message.header.message_id)) || ".reply"; call hcs_$status_minf ((mail_dir), (deletes_array (idx)), (0), (0), (0), code); if code = 0 then call ioa_ ("^/ The deferred reply for message no.^d was discarded.^/ To retrieve it, select the ""Retrieve Messages"" option.^/", message_num); end; old_no_of_entries = no_of_entries; call xmail_delete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, (file)); return; end delete_msgs; NEW_MESSAGES: proc returns (bit (1)); dcl new_flag bit (1); call mail_system_$read_new_messages (mailbox_ptr, (0), n_new_msgs, (0), status); if status ^= 0 & status ^= mlsys_et_$no_more_messages then call xmail_error_$no_code (status, NAME, "q", "Unable to read mail file. This is an internal programming error."); if n_new_msgs = 1 then call ioa_ ("A new message has arrived."); else if n_new_msgs > 1 then call ioa_ ("^d new messages have arrived.", n_new_msgs); if n_new_msgs = 0 then new_flag = "0"b; else do; new_flag = "1"b; if rtrim (file) = "incoming" then xmail_data.mail_in_incoming = "1"b; end; return (new_flag); end NEW_MESSAGES; end PERFORM_OPTION; %page; EXPLAIN_OPTION: proc (opt); dcl opt fixed bin; dcl xmail_display_help_ entry (char (*), char (*), fixed bin (35)); call window_$clear_window (iox_$user_output, code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); call xmail_display_help_ (NAME || ".gi.info", translate (OPTION_NAMES (opt), "_", " "), code); if code ^= 0 then call xmail_error_$no_print (code, NAME, "l", "Cannot clear user_io window. This is an internal programming error."); end EXPLAIN_OPTION; %page; GET_MENU: proc; dcl code fixed bin (35); dcl TITLE init ("Process Incoming Mail") char (21) static options (constant); dcl xmail_create_menu_ entry (char (*), (*) char (*) var, fixed bin, ptr, fixed bin (35)); call xmail_create_menu_ (TITLE, OPTION_NAMES, N_COLUMNS, menup, code); if code ^= 0 then do; call xmail_error_$code_last (xmail_err_$int_prog_err, NAME, "l", "Unable to get the ""Executive Mail"" menu."); call error_leave_menu (); end; call xmail_display_menu_ (menup, 2, code); end GET_MENU; error_leave_menu: proc (); call leave_menu (); go to EXIT; end error_leave_menu; query_if_more_msgs: proc (); dcl xmail_select_msgs_$new entry (ptr, ptr, char (*)); dcl mail_system_$get_message_counts entry (char (*), char (*), bit (1) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35)); if mailbox_ptr ^= null then do; call mail_system_$get_message_counts (dir, (file), INCLUDE_BY_TYPE, n_total_msgs, n_ordinary_msgs, n_interactive_msgs, code); if code = 0 then do; if auto_open_options.message_selection_mode = ALL_MESSAGES then n_new_msgs = n_total_msgs - mailbox.n_messages; else n_new_msgs = n_ordinary_msgs - mailbox.n_messages; if n_new_msgs > 0 then do; xmail_data.mail_in_incoming = "1"b; if want_to_examine_more () then do; call xmail_select_msgs_$new (mailbox_ptr, curr_msgsp, pos_line); call ioa_ ("The newly arrived messages are now the current messages."); go to START; end; end; end; else if code ^= mlsys_et_$no_s_permission & code ^= mlsys_et_$no_r_permission then call xmail_error_$no_code (code, NAME, "q", "Unable to read mail file. This is an internal programming error."); end; end query_if_more_msgs; leave_menu: proc (); if mailbox_ptr ^= null then do; if cleanup_signalled then call xmail_undelete_msgs_ (mailbox_ptr, curr_msgsp, pos_line, ""); xmail_data.cleanup_signalled = "0"b; auto_close_options.version = CLOSE_OPTIONS_VERSION_2; auto_close_options.flags.perform_deletions = "1"b; auto_close_options.flags.report_deletion_errors = "0"b; auto_close_options.flags.mbz = "0"b; call mail_system_$close_mailbox (mailbox_ptr, addr (auto_close_options), code); if code ^= 0 then call xmail_error_$no_code (code, NAME, "l", "Unable to close user mailbox. This is an internal programming error."); end; xmail_data.foreign_mailbox = "0"b; if curr_msgsp ^= null () then do; free curr_msgs; curr_msgsp = null (); end; if (deletes_ptr ^= null () & no_of_entries ^= 0) then call xmail_delete_dreply_ (deletes_ptr); old_no_of_entries = 0; end leave_menu; want_to_examine_more: proc () returns (bit (1) aligned); dcl yes_sw bit (1) aligned; dcl xmail_get_str_$yes_no entry (char (*) var, bit (1) aligned); call ioa_ ("^d new message^[s^] ^[have^;has^] arrived.", n_new_msgs, n_new_msgs > 1, n_new_msgs > 1); call xmail_get_str_$yes_no ("Do you still wish to quit?", yes_sw); return (^yes_sw); end want_to_examine_more; %page; %include menu_dcls; %page; %include xmail_responses; %page; %include xmail_data; %page; %include window_dcls; %page; %include mlsys_open_options; %page; %include mlsys_close_options; %page; %include mlsys_mailbox; %page; %include xmail_windows; %page; %include xmail_curr_msg_info; %page; %include mlsys_message; %page; end xmail_Process_Mail_;  xmail_Review_Defaults_.pl1 09/02/88 0759.6rew 09/02/88 0735.8 479790 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-07,Blair), approve(86-02-26,MCR7358), audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 85-03-12 JG Backs: Split the Personalize Executive Mail menu into one small menu with 3 options. Each of those options will display another menu. The internal procedures for each of the original options plus new options being added were changed to entrypoints to be executed by the new menu modules: xmail_Review_Printing_.pl1, xmail_Review_Outgoing_.pl1, and xmail_Review_Processing_.pl1. 85-03-27 JG Backs: Deleted duplicate code in the different entrypoints by using a call to internal procedure CHECK_VALUE_YN if valid responses to options are yes, no, or ask. Modified CHECK_VALUE_YN to allow case insensitive responses, as well as "ask" and "a" as valid responses if flag is set. Moved ASK, A, SET, and S constants to xmail_responses.incl.pl1. Added input parameters of option names to the entrypoints and additional info names to support the new options. 85-04-17 JG Backs: Replaced all the Message Facility commands (accept_messages, defer_messages, print_messages) with calls to the new xmail_im_mgr_ module which uses the new Message Facility entrypoints for these functions. 2) change(86-01-07,Blair), approve(86-02-26,MCR7358), audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 85-04-19 JG Backs: Modified multics_mode entrypoint to get the value of always_escape_yn after the multics mode option is changed, in case the default for function keys has to change because of the new # of function keys needed. Introduced bug when creating entrypoint from procedure. It was getting the multics_mode_yn value instead. 85-04-25 JG Backs: Created new entrypoints related to getting the new values for each of the printing options: get_new_header, get_new_station, get_new_destination, get_new_copies, get_new_margin, get_new_notify. xmail_print_ will call these to obtain new values and not change the values in the value segment permanently. Modified the existing entrypoints for the printing options to also call the new ones to keep the interface consistant for the user. 85-04-26 JG Backs: Modified get_new_notify entrypoint to translate and test the new value instead of the old value. Modified get_new_station to test the new value for a valid request_type, instead of changing the old value. No changes to the old value should occur during get_new.... entrypoints. Bugfixes. 3) change(86-01-07,Blair), approve(86-02-26,MCR7358), audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): Modified include_original entrypoint to ask if the original should be displayed in the upper window. The new value name is ORIGINAL_UP_WINDOW_YN. 4) change(87-01-16,Blair), approve(87-02-05,MCR7618), audit(87-04-14,RBarstad), install(87-04-26,MR12.1-1025): Make a new entry for including interactive messages in the mailbox. MSGS_AS_MAIL. 5) change(88-06-27,Blair), approve(88-07-27,MCR7959), audit(88-08-25,RBarstad), install(88-09-02,MR12.2-1098): Allow full_name to be changed when the xmail_data.value seg is in the pdir. END HISTORY COMMENTS */ xmail_Review_Defaults_: proc; /* BEGIN DESCRIPTION function: This procedure provides the xmail user with a menu for the purpose of inspecting and updating default values which control aspects of the operation of xmail. history: Written 7/16/81 by Paul Kyzivat Modified by R. Ignagni Oct 1981 to add REVIEW_ACKNOWLEDGE Extensively modified by R. Ignagni 3/4/82 83-08-08 DJ Schimke: Changed all references of Person_id.xmail to Person_id.mlsys. These references are in the delegation of authority code which is not used in this version, but may be used in the future. Deleted unreferenced variables and declared addr, before, index, rtrim and verify builtins. 83-09-14 DJ Schimke: Modified to allow "y", "n", and "a" as well as "yes", "no", and "ask" as legal values for the YES/NO/ASK type options. TR12009 83-09-16 DJ Schimke: Modified the printout station code to allow the keyword "default" which returns the printout station to the original site default by deleting the option from the value seg. phx13205 83-10-10 DJ Schimke: replaced the calls to xmail_get_line with calls to xmail_get_str_ which also handles the help function code. 83-11-23 DJ Schimke: Added a new personalization option "Outgoing Savefile" which allows selection of where to file save messages. This also solves the discrepancy between the different actions resulting from setting "Save Outgoing Messages" to "yes" vs never having set "Save Outgoing Messages". The former a