COMPILATION LISTING OF SEGMENT xmail_send_stored_msg_ Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 09/02/88 0745.8 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(87-12-10,Blair), approve(87-12-10,MCR7818), 16* audit(87-12-23,LJAdams), install(88-01-12,MR12.2-1013): 17* Add capability to update a deferred message to include a reply-to field. 18* END HISTORY COMMENTS */ 19 20 21 xmail_send_stored_msg_: proc (); 22 23 /* BEGIN DESCRIPTION 24* 25*History: Author unknown 26* 27* 83-07-21 DJ Schimke: Declared addr, codeptr, divide, null, and rtrim 28* builtins. Removed unreferenced char_count, emacs_data_$status_code, 29* program_interrupt. 30* 31* 83-10-15 DJ Schimke: Removed useless cleanup handler and performed other 32* general code restructuring suggested by audit. 33* 34* 83-10-26 DJ Schimke: Changed call to xmail_window_manager_$reconnect to a 35* call to xmail_window_manager_$quit_handler so the quit condition handler 36* can special-case the reconnect condition which should NOT interrupt 37* processing after the quit. phx 13227 This entry also prompts when not at 38* a reconnect condition so that unintentionally hitting the BREAK won't 39* throw away any pending work. phx 13018 40* 41* 83-11-01 DJ Schimke: Changed calling sequence of xmail_select_file_. 42* 43* 84-09-24 JG Backs: Added code before and after the call to emacs_ to test 44* if menus should be removed before editing (personalization option Remove 45* Menus While Editing). If option is in effect, calls to new entrypoints, 46* $suppress_menu and $restore_menu in xmail_window_manager_ are made. Also 47* added test in quit handler to make sure restore menus is done if quit in 48* editor. 49* 50* 84-11-08 JG Backs: Changed the call and declaration statement of 51* xmail_process_user_msg_ to eliminate the parameter which was not needed 52* or used, and was eliminated from that module. Audit change. 53* 54*END DESCRIPTION 55**/ 56 57 /* AUTOMATIC */ 58 59 dcl bit_count fixed bin (24); 60 dcl buffer_used fixed bin; 61 dcl code fixed bin (35); 62 dcl flavor char (32); 63 dcl format_reply char (32); 64 dcl format_reply_length fixed bin; 65 dcl length_first_part fixed bin; 66 dcl message_num fixed bin; 67 dcl no_chars fixed bin (21); 68 dcl restore_menu_needed bit (1) aligned; /* if remove menu */ 69 dcl status fixed bin (35); 70 dcl store_dir char (168); 71 dcl store_file char (32) var; 72 dcl stored_msg_ptr ptr; 73 dcl type fixed bin (2); 74 dcl unused_bit bit (1) aligned; 75 dcl unused_bit2 bit (1) aligned; 76 dcl user_name char (22); 77 78 dcl 1 auto_parse_text_options like parse_text_options; 79 80 /* INTERNAL STATIC */ 81 82 dcl ext_dir char (168) int static; 83 dcl ext_file char (32) int static; 84 dcl ext_pname char (168) int static; 85 dcl ext_ptr ptr init (null) int static; 86 87 /* CONSTANTS */ 88 89 dcl ALLOW_OLD bit (1) aligned options (constant) init ("1"b) int static; 90 dcl BITS_PER_BYTE fixed bin (4) aligned options (constant) init (9) int static; 91 dcl DONT_ALLOW_NEW bit (1) aligned options (constant) init ("0"b) int static; 92 dcl EMACS_EXT char (21) options (constant) init ("xmail_emacs_ext_main_") int static; 93 dcl ENTRY_NAME entry variable init (xmail_send_stored_msg_); 94 dcl ERROR_MESSAGE char (66) static options (constant) init ("Sorry, due to an internal error the stored message cannot be sent."); 95 dcl LOG char (1) static options (constant) init ("l"); 96 dcl MAKE_SEG_RW fixed bin (5) static options (constant) init (01010b); 97 dcl NAME char (22) static options (constant) init ("xmail_send_stored_msg_"); 98 dcl NL char (1) aligned static options (constant) init (" 99 "); 100 dcl STOP char (1) static options (constant) init ("q"); 101 dcl TERM_FILE_BC bit (2) static options (constant) init ("01"b); 102 dcl WHITE_SPACE_COMMA char (6) aligned static options (constant) init (" 103 ,"); /* HT VT NL comma */ 104 /* EXTERNAL STATIC */ 105 106 dcl iox_$user_output ptr external static; 107 dcl (error_table_$namedup, error_table_$segknown) fixed bin (35) ext; 108 109 /* ENTRIES */ 110 111 dcl emacs_ entry (ptr, char (*), char (*), ptr, fixed bin (35)); 112 dcl get_pdir_ entry () returns (char (168)); 113 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 114 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 115 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 116 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 117 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); 118 dcl ioa_ entry () options (variable); 119 dcl mlsys_utils_$parse_address_list_text entry options(variable); 120 dcl mlsys_utils_$format_text_field entry options(variable); 121 dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); 122 dcl user_info_ entry (char(*)); 123 dcl xmail_error_$no_code entry options (variable); 124 dcl xmail_process_user_msg_ entry (); /* no parameter */ 125 dcl xmail_redisplay_$menu entry (); 126 dcl xmail_select_file_$caller_msg entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned, 127 char (168), char (32) var, char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); 128 dcl xmail_window_manager_$quit_handler entry () returns (bit (1) aligned); 129 dcl xmail_window_manager_$reconnect entry (); 130 dcl xmail_window_manager_$restore_menu entry (); 131 dcl xmail_window_manager_$suppress_menu entry (); 132 133 /* CONDITIONS */ 134 135 dcl quit condition; 136 137 /* BASED */ 138 139 dcl stored_string char (no_chars) based (stored_msg_ptr); 140 dcl emacs_seg_string char (no_chars) based (send_mail_info.emacs_seg_ptr); 141 142 143 /* BUILTINS */ 144 145 dcl (addr, after, before, codeptr, divide, index, length, null, rtrim, substr) builtin; 146 147 /* INCLUDE FILES */ 148 1 1 /* BEGIN INCLUDE FILE ... xmail_send_mail.incl.pl1 */ 1 2 1 3 /****^ HISTORY COMMENTS: 1 4* 1) change(87-08-10,Blair), approve(87-12-17,MCR7818), 1 5* audit(87-12-23,LJAdams), install(88-01-12,MR12.2-1013): 1 6* Add pointer for reply_to field. 1 7* END HISTORY COMMENTS */ 1 8 1 9 /* Created by R. Ignagni July 1981 */ 1 10 1 11 /* 84-08-06 JG Backs: Modified to add pointer for bcc. */ 1 12 1 13 dcl 1 send_mail_info aligned based (send_mail_info_ptr), 1 14 2 msg_exists bit (1), /* ON = new message exists */ 1 15 2 stored_seg_ptr ptr, /* ptr to stored msg seg */ 1 16 2 emacs_seg_ptr ptr, /* ptr to seg containing msg */ 1 17 2 new_msg_ptr ptr, /* ptr to new_msg structure */ 1 18 2 reply_to_list_ptr ptr, /* ptr to reply_to addr struct */ 1 19 2 to_list_ptr ptr, /* ptr to recipients addr struct */ 1 20 2 cc_list_ptr ptr, /* ptr to cc address structure */ 1 21 2 bcc_list_ptr ptr, /* ptr to bcc address structure */ 1 22 2 send_mail_area_ptr ptr, /* ptr to send_mail_area */ 1 23 2 emacs_seg_pathname char (168); 1 24 1 25 1 26 dcl send_mail_info_ptr ptr external static init (null); 1 27 1 28 /* END INCLUDE FILE xmail_send_mail.inl.pl1 */ 149 150 2 1 /* BEGIN INCLUDE FILE: xmail_data.incl.pl1 */ 2 2 2 3 2 4 /****^ HISTORY COMMENTS: 2 5* 1) change(85-12-20,Blair), approve(86-03-06,MCR7358), 2 6* audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 2 7* Modified 03/15/85 by Joanne Backs adding confirm_print flag. 2 8* 2) change(85-12-20,LJAdams), approve(86-03-06,MCR7358), 2 9* audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 2 10* Adding switch to indicate request for menu display came from general help. 2 11* This is so general help menu will be displayed in top screen. 2 12* 3) change(86-01-10,Blair), approve(86-03-06,MCR7358), 2 13* audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 2 14* Add switch to indicate whether or not it is permissible to process mail 2 15* in other users' mailboxes (foreign_mailbox). 2 16* 4) change(86-01-13,Blair), approve(86-03-06,MCR7358), 2 17* audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 2 18* Add bit to indicate whether or not this is a true cleanup condition. 2 19* 5) change(86-02-06,Blair), approve(86-03-06,MCR7358), 2 20* audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 2 21* Rearrange to group all the bit flags together in one word with a pad. 2 22* 6) change(86-03-05,Blair), approve(86-03-05,MCR7358), 2 23* audit(86-04-21,RBarstad), install(86-05-28,MR12.0-1062): 2 24* Change value_seg ptr to value_seg_pathname to avoid the situation where 2 25* you keep around a pointer to a structure which no longer exists. 2 26* 7) change(87-01-16,Blair), approve(87-02-05,MCR7618), 2 27* audit(87-04-15,RBarstad), install(87-04-26,MR12.1-1025): 2 28* Add a field to indicate whether or not we should process interactive msgs. 2 29* Increment version to 4.1 so default value will get set. 2 30* 8) change(87-02-13,Blair), approve(87-02-13,MCR7618), 2 31* audit(87-04-15,RBarstad), install(87-04-26,MR12.1-1025): 2 32* Add a field to indicate whether or not we're processing a reply so that we 2 33* will be able to rebuild the screens properly after a disconnect occurs. 2 34* Error_list #114. 2 35* 9) change(88-07-26,Blair), approve(88-07-26,MCR7959), 2 36* audit(88-08-25,RBarstad), install(88-09-02,MR12.2-1098): 2 37* Add a bit to indicate whether or not the error segment had to be created 2 38* in the pdir (because we didn't have sma access to the mlsys_dir). 2 39* END HISTORY COMMENTS */ 2 40 2 41 2 42 /* Written 5/13/81 by Paul H. Kyzivat */ 2 43 /* Modified 12/16/81 by S. Krupp to delete unused parts of structure 2 44* and to add n_fkeys_used */ 2 45 /* Modified 12/14/82 by Dave Schimke to make the xmail version a 10 character 2 46* varying string. */ 2 47 /* Modified 09/12/83 by Dave Schimke adding interactive_msgs flag */ 2 48 /* Modified 09/14/83 by Dave Schimke adding moved_user_io */ 2 49 /* Modified 09/06/84 by Joanne Backs adding lists_as_menus flag */ 2 50 /* Modified 09/21/84 by Joanne Backs adding remove_menus flag */ 2 51 2 52 dcl xmail_data_ptr external static ptr init (null); 2 53 2 54 dcl 1 xmail_data aligned based (xmail_data_ptr), 2 55 2 mail_dir char (168) varying, 2 56 2 first_label label, 2 57 2 quit_label label, 2 58 2 value_seg_pathname char (168) varying, 2 59 2 moved_user_io ptr, 2 60 2 normal_usage char (80) unal, 2 61 2 function_key_info, 2 62 3 function_key_data_ptr ptr, 2 63 3 n_fkeys_used fixed bin, 2 64 2 actee, 2 65 3 person char(32) varying, 2 66 3 project char(32) varying, 2 67 2 flags aligned, 2 68 3 mail_in_incoming bit (1) unal, 2 69 3 lists_as_menus bit (1) unal, /* personalization */ 2 70 3 remove_menus bit (1) unal, /* personalization */ 2 71 3 confirm_print bit (1) unal, /* personalization */ 2 72 3 multics_mode bit (1) unal, /* personalization */ 2 73 3 interactive_msgs bit (1) unal, /* personalization */ 2 74 3 foreign_mailbox bit (1) unal, /* read others' mailboxes */ 2 75 3 general_help bit (1) unal, /* indicated requesting gen help*/ 2 76 3 cleanup_signalled bit (1) unal, /* on when true cleanup condition */ 2 77 3 msgs_as_mail bit (1) unal, /* on for include_msgs */ 2 78 3 reply_request bit (1) unal, /* on if we're doing a reply */ 2 79 3 error_seg_in_pdir bit (1) unal, /* on if the error_seg is in the pdir */ 2 80 3 pad bit (24) unal; 2 81 2 82 2 83 2 84 dcl xmail_version char(10) var static options(constant) init("4.1"); 2 85 2 86 /* END INCLUDE FILE: xmail_data.incl.pl1 */ 151 152 3 1 /* BEGIN INCLUDE FILE ... mlsys_parse_txt_options.incl.pl1 */ 3 2 /* Created: June 1983 by G. Palter */ 3 3 3 4 /* Options for the mlsys_utils_$parse_address_list_text and mlsys_utils_$parse_message_text entrypoints */ 3 5 3 6 dcl 1 parse_text_options aligned based (parse_text_options_ptr), 3 7 2 version character (8) unaligned, 3 8 2 area_ptr pointer, /* -> area for following structures; null => system free */ 3 9 2 flags, 3 10 3 list_errors bit (1) unaligned, /* ON => return the list of errors in the input text */ 3 11 3 validate_addresses bit (1) unaligned, /* ON => validate the existence of the addresses in the 3 12* address list or message */ 3 13 3 include_invalid_addresses bit (1) unaligned, /* ON => create an invalid address for each unparseable 3 14* substring of the input text */ 3 15 3 mbz bit (33) unaligned; /* must be set to ""b by the caller */ 3 16 3 17 dcl PARSE_TEXT_OPTIONS_VERSION_1 character (8) static options (constant) initial ("mlsptxt1"); 3 18 3 19 dcl parse_text_options_ptr pointer; 3 20 3 21 3 22 /* Describes the errors detected while parsing the printed representation of an address list or message */ 3 23 3 24 dcl 1 parse_text_error_list aligned based (parse_text_error_list_ptr), 3 25 2 n_errors fixed binary, /* set to # of errors detected */ 3 26 2 errors (parse_text_error_list_n_errors refer (parse_text_error_list.n_errors)), 3 27 3 text_start fixed binary (21), /* ... set to index of first character in the substring */ 3 28 3 text_lth fixed binary (21), /* ... set to length of this invalid substring */ 3 29 3 code fixed binary (35), /* ... set to an error code which describes what is wrong with 3 30* this substring */ 3 31 3 additional_info character (128) varying; /* ... and extra information to clarify the error */ 3 32 3 33 dcl parse_text_error_list_ptr pointer; 3 34 3 35 dcl parse_text_error_list_n_errors fixed binary; /* used to allocate the above structure */ 3 36 3 37 /* END INCLUDE FILE ... mlsys_parse_txt_options.incl.pl1 */ 153 154 4 1 /* begin include fine window_dcls.incl.pl1 BIM June 1981 */ 4 2 /* Modified 9 October 1983 by Jon A. Rochlis to add window_$edit_line. */ 4 3 4 4 /* format: style3 */ 4 5 4 6 declare window_$bell entry (pointer, fixed binary (35)); 4 7 declare window_$clear_region 4 8 entry (pointer, fixed binary, fixed binary, fixed binary, fixed binary, fixed binary (35)); 4 9 declare window_$clear_to_end_of_line 4 10 entry (pointer, fixed binary (35)); 4 11 declare window_$clear_to_end_of_window 4 12 entry (pointer, fixed binary (35)); 4 13 declare window_$clear_window 4 14 entry (pointer, fixed binary (35)); 4 15 declare window_$delete_chars 4 16 entry (pointer, fixed binary, fixed binary (35)); 4 17 declare window_$get_cursor_position 4 18 entry (pointer, fixed binary, fixed binary, fixed binary (35)); 4 19 4 20 /* Call window_$get_echoed_chars (iocb_ptr, n_to_read, read_buffer, n_read, read_break, code); */ 4 21 4 22 declare window_$get_echoed_chars 4 23 entry (pointer, fixed binary (21), character (*), fixed binary (21), character (1) var, 4 24 fixed binary (35)); 4 25 declare window_$get_unechoed_chars 4 26 entry (pointer, fixed binary (21), character (*), fixed binary (21), character (1) var, 4 27 fixed binary (35)); 4 28 declare window_$insert_text entry (pointer, character (*), fixed binary (35)); 4 29 declare window_$overwrite_text 4 30 entry (pointer, character (*), fixed binary (35)); 4 31 declare window_$position_cursor 4 32 entry (pointer, fixed binary, fixed binary, fixed binary (35)); 4 33 4 34 /* Call window_$position_cursor_rel (iocb_ptr, delta_line, delta_column, code); */ 4 35 4 36 declare window_$position_cursor_rel 4 37 entry (pointer, fixed binary, fixed binary, fixed binary (35)); 4 38 4 39 /* Call window_$scroll_region (iocb_ptr, first_line_of_region, n_lines_of_region, distance_to_scroll_region_negative_is_up, 4 40* code); */ 4 41 4 42 declare window_$scroll_region 4 43 entry (pointer, fixed binary, fixed binary, fixed binary, fixed binary (35)); 4 44 declare window_$sync entry (pointer, fixed binary (35)); 4 45 4 46 /* Call window_$write_raw_text (iocb_ptr, text_string, code); */ 4 47 4 48 declare window_$write_raw_text 4 49 entry (pointer, character (*), fixed binary (35)); 4 50 4 51 /* Call window_$write_sync_read (iocb_ptr, prompt_string, n_to_read, read_buffer, n_read, break_char, code); */ 4 52 4 53 declare window_$write_sync_read 4 54 entry (pointer, character (*), fixed bin (21), character (*), fixed binary (21), 4 55 character (1) var, fixed binary (35)); 4 56 4 57 /* Call window_$change_line (iocb_ptr, new_line, code); */ 4 58 4 59 declare window_$change_line entry (pointer, fixed binary, fixed binary (35)); 4 60 4 61 /* Call window_$change_column (iocb_ptr, new_column, code); */ 4 62 4 63 declare window_$change_column 4 64 entry (pointer, fixed binary, fixed binary (35)); 4 65 4 66 /* Call window_$get_one_unechoed (iocb_ptr, char_or_len_0, block_flag, code); */ 4 67 declare ( 4 68 window_$get_one_unechoed, 4 69 window_$get_one_unechoed_char 4 70 ) entry (pointer, character (1) var, bit (1) aligned, fixed binary (35)); 4 71 4 72 declare window_$create entry (pointer, pointer, pointer, fixed binary (35)); 4 73 4 74 declare window_$destroy entry (pointer, fixed binary (35)); 4 75 4 76 declare window_$edit_line entry (pointer, pointer, pointer, fixed bin(21), fixed bin(21), fixed bin(35)); 4 77 4 78 /* call window_$edit_line (iocb_ptr, window_edit_line_info_ptr, buffer_ptr, 4 79* buffer_len, n_returned, code); */ 4 80 4 81 4 82 /* end include file window_dcls.incl.pl1 */ 155 156 5 1 /* BEGIN INCLUDE FILE ... mlsys_address_list.incl.pl1 */ 5 2 /* Created: June 1983 by G. Palter */ 5 3 5 4 /* Definition of an address list -- a collection of addresses used as the value of certain message fields, etc. */ 5 5 5 6 dcl 1 address_list aligned based (address_list_ptr), 5 7 2 version character (8) unaligned, 5 8 2 reserved bit (144), /* ... exclusively for use by the mail system */ 5 9 2 n_addresses fixed binary, /* # of address in this list */ 5 10 2 addresses (address_list_n_addresses refer (address_list.n_addresses)) pointer; 5 11 5 12 dcl ADDRESS_LIST_VERSION_2 character (8) static options (constant) initial ("mlsals02"); 5 13 5 14 dcl address_list_ptr pointer; 5 15 5 16 dcl address_list_n_addresses fixed binary; /* reserved exclusively for use by the mail system */ 5 17 5 18 /* END INCLUDE FILE ... mlsys_address_list.incl.pl1 */ 157 158 6 1 /* BEGIN INCLUDE FILE ... mlsys_field_names.incl.pl1 */ 6 2 /* Created: June 1983 by G. Palter */ 6 3 6 4 /* Standard names for all message envelope, header, and redistributions list fields supported by the mail system */ 6 5 6 6 dcl (ACCESS_CLASS_FIELDNAME initial ("Access-Class"), 6 7 ACKNOWLEDGE_TO_FIELDNAME initial ("Acknowledge-To"), 6 8 BCC_FIELDNAME initial ("bcc"), 6 9 CC_FIELDNAME initial ("cc"), 6 10 DATE_TIME_CREATED_FIELDNAME initial ("Date"), 6 11 DATE_TIME_DELIVERED_FIELDNAME initial ("Delivery-Date"), 6 12 DATE_TIME_MAILED_FIELDNAME initial ("Posted-Date"), 6 13 DELIVERED_BY_FIELDNAME initial ("Delivery-By"), 6 14 FROM_FIELDNAME initial ("From"), 6 15 IMPLICIT_ROUTE_FIELDNAME initial ("Route"), 6 16 MESSAGE_ID_FIELDNAME initial ("Message-ID"), 6 17 RELAY_FIELDNAME initial ("Relayed"), 6 18 REPLY_REFERENCES_FIELDNAME initial ("In-Reply-To"), 6 19 REPLY_TO_FIELDNAME initial ("Reply-To"), 6 20 SENDER_FIELDNAME initial ("Sender"), 6 21 SUBJECT_FIELDNAME initial ("Subject"), 6 22 TO_FIELDNAME initial ("To"), 6 23 6 24 6 25 /* Prefix to apply to a field name to produce the field name of the equivalent field in the redistributions list. Ie: 6 26* 6 27* call mlsys_utils_$print_address_field 6 28* (REDISTRIBUTED_PREFIX || FROM_FIELDNAME, ...) */ 6 29 6 30 REDISTRIBUTED_PREFIX initial ("Redistributed-"), 6 31 6 32 6 33 /* Fields in a redistribution which do not have a corresponding non-redistributed field */ 6 34 6 35 REDISTRIBUTED_COMMENT_FIELDNAME initial ("Redistributed-Comment")) 6 36 6 37 character (32) varying static options (constant); 6 38 6 39 6 40 /* END INCLUDE FILE ... mlsys_field_names.incl.pl1 */ 159 160 161 /* BEGIN */ 162 163 restore_menu_needed = "0"b; 164 on condition (quit) 165 begin; 166 if xmail_window_manager_$quit_handler () 167 then do; 168 if restore_menu_needed 169 then do; 170 call xmail_window_manager_$restore_menu; 171 call xmail_redisplay_$menu; 172 end; 173 call window_$clear_window (iox_$user_output, (0)); /* ignore code */ 174 call ioa_ ("Sending ""deferred message"" terminated."); 175 go to EXIT; 176 end; 177 end; 178 179 call xmail_select_file_$caller_msg ("deferred message", "defer", "", ALLOW_OLD, DONT_ALLOW_NEW, store_dir, store_file, "Enter name of ""deferred message"" (or ?? for list)", unused_bit, unused_bit2, code); 180 if code ^= 0 then go to EXIT; 181 182 call hcs_$make_seg (store_dir, rtrim (store_file) || ".defer", "", MAKE_SEG_RW, stored_msg_ptr, code); 183 184 call hcs_$status_mins (stored_msg_ptr, type, bit_count, code); 185 if code ^= 0 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 186 /* Set up to add a Reply_To field if none exists */ 187 188 auto_parse_text_options.version = PARSE_TEXT_OPTIONS_VERSION_1; 189 auto_parse_text_options.area_ptr = null(); 190 auto_parse_text_options.flags.list_errors = "0"b; 191 auto_parse_text_options.flags.validate_addresses = "0"b; 192 auto_parse_text_options.flags.include_invalid_addresses = "0"b; 193 auto_parse_text_options.flags.mbz = "0"b; 194 195 call user_info_ (user_name); /* we might need this */ 196 197 /* Get number of chars in seg */ 198 199 if bit_count = 0 200 then do; 201 call ioa_ ("The specified ""deferred message"" is empty."); 202 go to EXIT; 203 end; 204 no_chars = divide (bit_count, 9, 17, 0); 205 reply_to_list_ptr = null; 206 if index(before(stored_string,NL || "To:"), "Reply-To:") > 0 then do; 207 call mlsys_utils_$parse_address_list_text (rtrim (after (before (stored_string, 208 "To:"), "Reply-To:"), WHITE_SPACE_COMMA), addr (auto_parse_text_options), 209 ADDRESS_LIST_VERSION_2, reply_to_list_ptr, parse_text_error_list_ptr, code); 210 if code ^= 0 then 211 call xmail_error_$no_code (code, NAME, LOG, ERROR_MESSAGE, message_num); 212 end; 213 else do; 214 format_reply = ""; 215 format_reply_length = length ("Reply-To: ") + length(user_name); 216 call mlsys_utils_$format_text_field (REPLY_TO_FIELDNAME, rtrim(user_name), ("0"b), 217 format_reply_length, addr(format_reply), format_reply_length, buffer_used, code); 218 if code ^= 0 then 219 call xmail_error_$no_code (code, NAME, LOG, ERROR_MESSAGE, message_num); 220 no_chars = format_reply_length + length(NL) + no_chars; 221 bit_count = no_chars * BITS_PER_BYTE; 222 length_first_part = index(stored_string,NL); 223 stored_string = substr(stored_string,1,length_first_part) || 224 rtrim(format_reply) || NL || substr(stored_string,length_first_part+1, no_chars - (length_first_part + length(NL) + format_reply_length)); 225 if code ^= 0 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 226 end; 227 call hcs_$make_seg ("", xmail_data.actee.person || "_sm", "", MAKE_SEG_RW, send_mail_info.emacs_seg_ptr, code); 228 if code ^= 0 & code ^= error_table_$namedup & code ^= error_table_$segknown then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 229 230 call terminate_file_ (send_mail_info.emacs_seg_ptr, bit_count, TERM_FILE_BC, code); 231 emacs_seg_string = stored_string; 232 if ext_ptr = null () 233 then do; 234 call hcs_$make_ptr (codeptr (ENTRY_NAME), EMACS_EXT, "", ext_ptr, code); 235 if code ^= 0 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 236 call hcs_$fs_get_path_name (ext_ptr, ext_dir, (0), ext_file, code); 237 if code ^= 0 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 238 ext_pname = rtrim (ext_dir) || ">" || EMACS_EXT; 239 end; 240 241 242 flavor = "edit"; 243 call ioa_ ("...Please wait for editor..."); 244 245 /* Check personalization option to remove and restore menus while editing */ 246 247 if xmail_data.remove_menus 248 then do; 249 call xmail_window_manager_$suppress_menu (); 250 restore_menu_needed = "1"b; 251 end; 252 253 call emacs_ (iox_$user_output, rtrim (get_pdir_ ()) || ">" || rtrim (actee.person) || "_sm", ext_pname, addr (flavor), status); 254 255 if restore_menu_needed 256 then do; 257 call xmail_window_manager_$restore_menu (); 258 call xmail_redisplay_$menu; 259 restore_menu_needed = "0"b; 260 end; 261 262 if status = 1 263 then do; 264 call hcs_$status_mins (send_mail_info.emacs_seg_ptr, 1, bit_count, code); 265 if code ^= 0 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 266 no_chars = divide (bit_count, 9, 17, 0); 267 stored_string = emacs_seg_string; 268 call hcs_$set_bc_seg (stored_msg_ptr, bit_count, code); 269 call ioa_ ("Deferred message ""^a"" saved.", store_file); 270 go to EXIT; 271 end; 272 if status ^= 0 273 then do; 274 call xmail_window_manager_$reconnect (); 275 call ioa_ ("Sending ""deferred message"" terminated."); 276 go to EXIT; 277 end; 278 else call xmail_process_user_msg_ (); /* no parameter */ 279 280 EXIT: return; 281 282 283 end xmail_send_stored_msg_; 284 285 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/02/88 0745.8 xmail_send_stored_msg_.pl1 >spec>install>MR12.2-1098>xmail_send_stored_msg_.pl1 149 1 01/14/88 2003.9 xmail_send_mail.incl.pl1 >ldd>include>xmail_send_mail.incl.pl1 151 2 09/02/88 0743.4 xmail_data.incl.pl1 >spec>install>MR12.2-1098>xmail_data.incl.pl1 153 3 10/27/83 2104.2 mlsys_parse_txt_options.incl.pl1 >ldd>include>mlsys_parse_txt_options.incl.pl1 155 4 09/12/84 0916.7 window_dcls.incl.pl1 >ldd>include>window_dcls.incl.pl1 157 5 10/27/83 2104.2 mlsys_address_list.incl.pl1 >ldd>include>mlsys_address_list.incl.pl1 159 6 10/27/83 2104.2 mlsys_field_names.incl.pl1 >ldd>include>mlsys_field_names.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. ADDRESS_LIST_VERSION_2 000012 constant char(8) initial packed unaligned dcl 5-12 set ref 207* ALLOW_OLD 000062 constant bit(1) initial dcl 89 set ref 179* BITS_PER_BYTE constant fixed bin(4,0) initial dcl 90 ref 221 DONT_ALLOW_NEW 000112 constant bit(1) initial dcl 91 set ref 179* EMACS_EXT 000053 constant char(21) initial packed unaligned dcl 92 set ref 234* 238 ENTRY_NAME 000236 automatic entry variable initial dcl 93 set ref 93* 234 234 ERROR_MESSAGE 000032 constant char(66) initial packed unaligned dcl 94 set ref 185* 210* 218* 225* 228* 235* 237* 265* LOG 000031 constant char(1) initial packed unaligned dcl 95 set ref 210* 218* MAKE_SEG_RW 000030 constant fixed bin(5,0) initial dcl 96 set ref 182* 227* NAME 000022 constant char(22) initial packed unaligned dcl 97 set ref 185* 210* 218* 225* 228* 235* 237* 265* NL 002464 constant char(1) initial dcl 98 ref 206 220 222 223 223 PARSE_TEXT_OPTIONS_VERSION_1 000014 constant char(8) initial packed unaligned dcl 3-17 ref 188 REPLY_TO_FIELDNAME 000000 constant varying char(32) initial dcl 6-6 set ref 216* STOP 000021 constant char(1) initial packed unaligned dcl 100 set ref 185* 225* 228* 235* 237* 265* TERM_FILE_BC 000020 constant bit(2) initial packed unaligned dcl 101 set ref 230* WHITE_SPACE_COMMA 000016 constant char(6) initial dcl 102 ref 207 207 actee 171 based structure level 2 dcl 2-54 addr builtin function dcl 145 ref 207 207 216 216 253 253 after builtin function dcl 145 ref 207 207 area_ptr 2 000230 automatic pointer level 2 dcl 78 set ref 189* auto_parse_text_options 000230 automatic structure level 1 unaligned dcl 78 set ref 207 207 before builtin function dcl 145 ref 206 207 207 bit_count 000100 automatic fixed bin(24,0) dcl 59 set ref 184* 199 204 221* 230* 264* 266 268* buffer_used 000101 automatic fixed bin(17,0) dcl 60 set ref 216* code 000102 automatic fixed bin(35,0) dcl 61 set ref 179* 180 182* 184* 185 185* 207* 210 210* 216* 218 218* 225 225* 227* 228 228 228 228* 230* 234* 235 235* 236* 237 237* 264* 265 265* 268* codeptr builtin function dcl 145 ref 234 234 divide builtin function dcl 145 ref 204 266 emacs_ 000154 constant entry external dcl 111 ref 253 emacs_seg_ptr 4 based pointer level 2 dcl 1-13 set ref 227* 230* 231 264* 267 emacs_seg_string based char packed unaligned dcl 140 set ref 231* 267 error_table_$namedup 000150 external static fixed bin(35,0) dcl 107 ref 228 error_table_$segknown 000152 external static fixed bin(35,0) dcl 107 ref 228 ext_dir 000010 internal static char(168) packed unaligned dcl 82 set ref 236* 238 ext_file 000062 internal static char(32) packed unaligned dcl 83 set ref 236* ext_pname 000072 internal static char(168) packed unaligned dcl 84 set ref 238* 253* ext_ptr 000144 internal static pointer initial dcl 85 set ref 232 234* 236* flags 213 based structure level 2 in structure "xmail_data" dcl 2-54 in procedure "xmail_send_stored_msg_" flags 4 000230 automatic structure level 2 in structure "auto_parse_text_options" packed packed unaligned dcl 78 in procedure "xmail_send_stored_msg_" flavor 000103 automatic char(32) packed unaligned dcl 62 set ref 242* 253 253 format_reply 000113 automatic char(32) packed unaligned dcl 63 set ref 214* 216 216 223 format_reply_length 000123 automatic fixed bin(17,0) dcl 64 set ref 215* 216* 216* 220 223 get_pdir_ 000156 constant entry external dcl 112 ref 253 hcs_$fs_get_path_name 000160 constant entry external dcl 113 ref 236 hcs_$make_ptr 000162 constant entry external dcl 114 ref 234 hcs_$make_seg 000164 constant entry external dcl 115 ref 182 227 hcs_$set_bc_seg 000166 constant entry external dcl 116 ref 268 hcs_$status_mins 000170 constant entry external dcl 117 ref 184 264 include_invalid_addresses 4(02) 000230 automatic bit(1) level 3 packed packed unaligned dcl 78 set ref 192* index builtin function dcl 145 ref 206 222 ioa_ 000172 constant entry external dcl 118 ref 174 201 243 269 275 iox_$user_output 000146 external static pointer dcl 106 set ref 173* 253* length builtin function dcl 145 ref 215 215 220 223 length_first_part 000124 automatic fixed bin(17,0) dcl 65 set ref 222* 223 223 223 list_errors 4 000230 automatic bit(1) level 3 packed packed unaligned dcl 78 set ref 190* mbz 4(03) 000230 automatic bit(33) level 3 packed packed unaligned dcl 78 set ref 193* message_num 000125 automatic fixed bin(17,0) dcl 66 set ref 210* 218* mlsys_utils_$format_text_field 000176 constant entry external dcl 120 ref 216 mlsys_utils_$parse_address_list_text 000174 constant entry external dcl 119 ref 207 no_chars 000126 automatic fixed bin(21,0) dcl 67 set ref 204* 206 207 207 220* 220 221 222 223 223 223 223 231 231 266* 267 267 null builtin function dcl 145 ref 189 205 232 parse_text_error_list_ptr 000250 automatic pointer dcl 3-33 set ref 207* parse_text_options based structure level 1 dcl 3-6 person 171 based varying char(32) level 3 dcl 2-54 ref 227 253 quit 000242 stack reference condition dcl 135 ref 164 remove_menus 213(02) based bit(1) level 3 packed packed unaligned dcl 2-54 ref 247 reply_to_list_ptr 10 based pointer level 2 dcl 1-13 set ref 205* 207* restore_menu_needed 000127 automatic bit(1) dcl 68 set ref 163* 168 250* 255 259* rtrim builtin function dcl 145 ref 182 207 207 216 216 223 238 253 253 send_mail_info based structure level 1 dcl 1-13 send_mail_info_ptr 000224 external static pointer initial dcl 1-26 ref 205 207 227 230 231 264 267 status 000130 automatic fixed bin(35,0) dcl 69 set ref 253* 262 272 store_dir 000131 automatic char(168) packed unaligned dcl 70 set ref 179* 182* store_file 000203 automatic varying char(32) dcl 71 set ref 179* 182 269* stored_msg_ptr 000214 automatic pointer dcl 72 set ref 182* 184* 206 207 207 222 223 223 223 231 267 268* stored_string based char packed unaligned dcl 139 set ref 206 207 207 222 223* 223 223 231 267* substr builtin function dcl 145 ref 223 223 terminate_file_ 000200 constant entry external dcl 121 ref 230 type 000216 automatic fixed bin(2,0) dcl 73 set ref 184* unused_bit 000217 automatic bit(1) dcl 74 set ref 179* unused_bit2 000220 automatic bit(1) dcl 75 set ref 179* user_info_ 000202 constant entry external dcl 122 ref 195 user_name 000221 automatic char(22) packed unaligned dcl 76 set ref 195* 215 216 216 validate_addresses 4(01) 000230 automatic bit(1) level 3 packed packed unaligned dcl 78 set ref 191* version 000230 automatic char(8) level 2 packed packed unaligned dcl 78 set ref 188* window_$clear_window 000230 constant entry external dcl 4-13 ref 173 xmail_data based structure level 1 dcl 2-54 xmail_data_ptr 000226 external static pointer initial dcl 2-52 ref 227 247 253 xmail_error_$no_code 000204 constant entry external dcl 123 ref 185 210 218 225 228 235 237 265 xmail_process_user_msg_ 000206 constant entry external dcl 124 ref 278 xmail_redisplay_$menu 000210 constant entry external dcl 125 ref 171 258 xmail_select_file_$caller_msg 000212 constant entry external dcl 126 ref 179 xmail_window_manager_$quit_handler 000214 constant entry external dcl 128 ref 166 xmail_window_manager_$reconnect 000216 constant entry external dcl 129 ref 274 xmail_window_manager_$restore_menu 000220 constant entry external dcl 130 ref 170 257 xmail_window_manager_$suppress_menu 000222 constant entry external dcl 131 ref 249 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACCESS_CLASS_FIELDNAME internal static varying char(32) initial dcl 6-6 ACKNOWLEDGE_TO_FIELDNAME internal static varying char(32) initial dcl 6-6 BCC_FIELDNAME internal static varying char(32) initial dcl 6-6 CC_FIELDNAME internal static varying char(32) initial dcl 6-6 DATE_TIME_CREATED_FIELDNAME internal static varying char(32) initial dcl 6-6 DATE_TIME_DELIVERED_FIELDNAME internal static varying char(32) initial dcl 6-6 DATE_TIME_MAILED_FIELDNAME internal static varying char(32) initial dcl 6-6 DELIVERED_BY_FIELDNAME internal static varying char(32) initial dcl 6-6 FROM_FIELDNAME internal static varying char(32) initial dcl 6-6 IMPLICIT_ROUTE_FIELDNAME internal static varying char(32) initial dcl 6-6 MESSAGE_ID_FIELDNAME internal static varying char(32) initial dcl 6-6 REDISTRIBUTED_COMMENT_FIELDNAME internal static varying char(32) initial dcl 6-6 REDISTRIBUTED_PREFIX internal static varying char(32) initial dcl 6-6 RELAY_FIELDNAME internal static varying char(32) initial dcl 6-6 REPLY_REFERENCES_FIELDNAME internal static varying char(32) initial dcl 6-6 SENDER_FIELDNAME internal static varying char(32) initial dcl 6-6 SUBJECT_FIELDNAME internal static varying char(32) initial dcl 6-6 TO_FIELDNAME internal static varying char(32) initial dcl 6-6 address_list based structure level 1 dcl 5-6 address_list_n_addresses automatic fixed bin(17,0) dcl 5-16 address_list_ptr automatic pointer dcl 5-14 parse_text_error_list based structure level 1 dcl 3-24 parse_text_error_list_n_errors automatic fixed bin(17,0) dcl 3-35 parse_text_options_ptr automatic pointer dcl 3-19 window_$bell 000000 constant entry external dcl 4-6 window_$change_column 000000 constant entry external dcl 4-63 window_$change_line 000000 constant entry external dcl 4-59 window_$clear_region 000000 constant entry external dcl 4-7 window_$clear_to_end_of_line 000000 constant entry external dcl 4-9 window_$clear_to_end_of_window 000000 constant entry external dcl 4-11 window_$create 000000 constant entry external dcl 4-72 window_$delete_chars 000000 constant entry external dcl 4-15 window_$destroy 000000 constant entry external dcl 4-74 window_$edit_line 000000 constant entry external dcl 4-76 window_$get_cursor_position 000000 constant entry external dcl 4-17 window_$get_echoed_chars 000000 constant entry external dcl 4-22 window_$get_one_unechoed 000000 constant entry external dcl 4-67 window_$get_one_unechoed_char 000000 constant entry external dcl 4-67 window_$get_unechoed_chars 000000 constant entry external dcl 4-25 window_$insert_text 000000 constant entry external dcl 4-28 window_$overwrite_text 000000 constant entry external dcl 4-29 window_$position_cursor 000000 constant entry external dcl 4-31 window_$position_cursor_rel 000000 constant entry external dcl 4-36 window_$scroll_region 000000 constant entry external dcl 4-42 window_$sync 000000 constant entry external dcl 4-44 window_$write_raw_text 000000 constant entry external dcl 4-48 window_$write_sync_read 000000 constant entry external dcl 4-53 xmail_version internal static varying char(10) initial dcl 2-84 NAMES DECLARED BY EXPLICIT CONTEXT. EXIT 002256 constant label dcl 280 ref 175 180 202 270 276 xmail_send_stored_msg_ 000217 constant entry external dcl 21 ref 93 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3046 3300 2466 3056 Length 3670 2466 232 354 357 136 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME xmail_send_stored_msg_ 243 external procedure is an external procedure. on unit on line 164 86 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 ext_dir xmail_send_stored_msg_ 000062 ext_file xmail_send_stored_msg_ 000072 ext_pname xmail_send_stored_msg_ 000144 ext_ptr xmail_send_stored_msg_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME xmail_send_stored_msg_ 000100 bit_count xmail_send_stored_msg_ 000101 buffer_used xmail_send_stored_msg_ 000102 code xmail_send_stored_msg_ 000103 flavor xmail_send_stored_msg_ 000113 format_reply xmail_send_stored_msg_ 000123 format_reply_length xmail_send_stored_msg_ 000124 length_first_part xmail_send_stored_msg_ 000125 message_num xmail_send_stored_msg_ 000126 no_chars xmail_send_stored_msg_ 000127 restore_menu_needed xmail_send_stored_msg_ 000130 status xmail_send_stored_msg_ 000131 store_dir xmail_send_stored_msg_ 000203 store_file xmail_send_stored_msg_ 000214 stored_msg_ptr xmail_send_stored_msg_ 000216 type xmail_send_stored_msg_ 000217 unused_bit xmail_send_stored_msg_ 000220 unused_bit2 xmail_send_stored_msg_ 000221 user_name xmail_send_stored_msg_ 000230 auto_parse_text_options xmail_send_stored_msg_ 000236 ENTRY_NAME xmail_send_stored_msg_ 000250 parse_text_error_list_ptr xmail_send_stored_msg_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry set_chars_eis index_chars_eis index_before_cs index_after_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. emacs_ get_pdir_ hcs_$fs_get_path_name hcs_$make_ptr hcs_$make_seg hcs_$set_bc_seg hcs_$status_mins ioa_ mlsys_utils_$format_text_field mlsys_utils_$parse_address_list_text terminate_file_ user_info_ window_$clear_window xmail_error_$no_code xmail_process_user_msg_ xmail_redisplay_$menu xmail_select_file_$caller_msg xmail_window_manager_$quit_handler xmail_window_manager_$reconnect xmail_window_manager_$restore_menu xmail_window_manager_$suppress_menu THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$namedup error_table_$segknown iox_$user_output send_mail_info_ptr xmail_data_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000216 93 000224 163 000230 164 000231 166 000245 168 000256 170 000261 171 000266 173 000273 174 000305 175 000321 177 000324 179 000325 180 000414 182 000416 184 000502 185 000520 188 000555 189 000557 190 000561 191 000563 192 000565 193 000567 195 000571 199 000602 201 000604 202 000620 204 000621 205 000623 206 000630 207 000650 210 000751 212 001005 214 001006 215 001011 216 001013 218 001101 220 001135 221 001140 222 001143 223 001156 225 001236 227 001274 228 001353 230 001415 231 001444 232 001455 234 001461 235 001512 236 001547 237 001601 238 001636 239 001676 242 001677 243 001702 247 001715 249 001723 250 001727 253 001731 255 002060 257 002063 258 002070 259 002075 262 002076 264 002101 265 002122 266 002157 267 002162 268 002172 269 002204 270 002224 272 002225 274 002227 275 002234 276 002250 278 002251 280 002256 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved