COMPILATION LISTING OF SEGMENT xmail_prepare_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 0748.1 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(86-01-17,Blair), approve(86-02-26,MCR7358), 16* audit(86-04-18,RBarstad), install(86-05-28,MR12.0-1062): 17* Set off the flag that indicates that the message no longer exists in the 18* on units rather than as part of normal cleanup. This will ensure that a 19* message is still available for filing even after the user has answered no 20* to creating a new file when none exists. TR 20028. 21* 2) change(87-08-10,Blair), approve(87-12-10,MCR7818), 22* audit(87-12-23,LJAdams), install(88-01-12,MR12.2-1013): 23* Add reply-to handling for new messages. 24* END HISTORY COMMENTS */ 25 26 27 xmail_prepare_msg_: procedure (P_store); 28 29 /* BEGIN DESCRIPTION 30* 31*function: 32* 33* This procedure is used to process an existing message or a new one. 34* In cases where a new message is being created, this procedure calls 35* a modified version of Emacs to collect the user's message, i.e., the 36* "subject", the "recipients" list, the "cc" list, the "bcc" list, and 37* finally the "message text". In cases of an existing message it allows 38* one to modify and/or enter new text, recipient list, or subject. 39* The message is then passed to mail_system_. The mail_system creates 40* standard message. It is then sent to the recipients. It may then be 41* filed, edited, etc.. The extensions to Emacs that are used to do 42* this are in segment xmail_emacs_ext_main_. 43* 44*history: 45* 46* 81-06-11 Written by R. Ignagni 47* 48* 83-10-20 DJ Schimke: Changed call to xmail_window_manager_$reconnect to a 49* call to xmail_window_manager_$quit_handler so the quit condition handler 50* can special-case the reconnect condition which should NOT interrupt 51* processing after the quit. phx 13227 This entry also prompts when not at 52* a reconnect condition so that unintentionally hitting the BREAK won't 53* throw away any pending work. phx 13018 54* 55* 83-11-01 DJ Schimke: Changed the calling sequence of xmail_select_file_. 56* 57* 84-08-08 JG Backs: Modified for the addition of blind carbon copies (bcc). 58* 59* 84-09-24 JG Backs: Added code before and after the call to emacs_ to test 60* if menus should be removed before editing (personalization option Remove 61* Menus While Editing). If option is in effect, calls to new entrypoints, 62* $suppress_menu and $restore_menu in xmail_window_manager_ are made. Also 63* added test in quit handler to make sure restore menus is done if quit in 64* editor. 65* 66* 84-11-07 JG Backs: Modified the name of the input parameter from P_caller 67* to P_store for clarity. Changed the call and declaration statement of 68* xmail_process_user_msg_ to eliminate the parameter which was not needed 69* or used, and was eliminated from that module. Audit change. 70* 71*END DESCRIPTION 72**/ 73 74 /* PARAMETERS */ 75 76 dcl P_store bit (1) parameter; /* input; "1"b = prepare & store msg; 77* "0"b = prepare & send msg */ 78 79 /* CONDITIONS */ 80 81 dcl (quit, cleanup) condition; 82 83 /* CONSTANTS */ 84 85 dcl ALLOW_NEW bit (1) aligned int static options (constant) init ("1"b); 86 dcl ALLOW_OLD bit (1) aligned int static options (constant) init ("1"b); 87 dcl DELETE_SEG_FORCE_CHASE bit (6) int static options (constant) init ("100101"b); 88 dcl EMACS_EXT char (21) options (constant) init ("xmail_emacs_ext_main_") int static; 89 dcl ENTRY_NAME entry variable init (xmail_prepare_msg_); 90 dcl ERROR_MESSAGE char (67) static options (constant) init ("Sending of message not completed, due to an internal program error."); 91 dcl HIT_QUIT_KEY char (19) static options (constant) init ("Sending terminated."); 92 dcl NAME char (18) static options (constant) init ("xmail_prepare_msg_"); 93 dcl STOP char (1) static options (constant) init ("q"); 94 dcl TERM_FILE_BC bit (2) int static options (constant) init ("01"b); 95 96 /* EXTERNAL STATIC */ 97 98 dcl error_table_$namedup fixed bin (35) ext; 99 dcl error_table_$segknown fixed bin (35) ext; 100 dcl iox_$user_output ptr external static; 101 102 /* INTERNAL STATIC */ 103 104 dcl ext_dir char (168) int static; 105 dcl ext_file char (32) int static; 106 dcl ext_ptr ptr init (null) int static; 107 dcl ext_pname char (168) int static; 108 109 /* AUTOMATIC */ 110 111 dcl bit_count fixed bin (24); 112 dcl code fixed bin (35); 113 dcl emacs_flavor char (32); 114 dcl no_chars fixed bin (24); 115 dcl restore_menu_needed bit (1) aligned; /* if remove menu */ 116 dcl status fixed bin (35); 117 dcl store_dir char (168); 118 dcl store_file char (32) var; 119 dcl stored_msg_ptr ptr; 120 dcl suffix char (4); 121 dcl temp_seg_ptr ptr; 122 dcl type fixed bin (2); 123 dcl unused_bit bit (1) aligned; 124 dcl unused_bit2 bit (1) aligned; 125 dcl user_msg_seg_entry_name char (32); 126 127 /* ENTRIES */ 128 129 dcl delete_$ptr entry (ptr, bit (6), char (*), fixed bin (35)); 130 dcl emacs_ entry (ptr, char (*), char (*), ptr, fixed bin (35)); 131 dcl get_pdir_ entry () returns (char (168)); 132 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 133 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 134 dcl hcs_$make_seg entry options (variable); 135 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); 136 dcl ioa_ entry options (variable); 137 dcl ioa_$nnl entry () options (variable); 138 dcl mail_system_$free_address_list entry (ptr, fixed bin (35)); 139 dcl mail_system_$free_message entry (ptr, fixed bin (35)); 140 dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); 141 dcl xmail_error_$no_code entry options (variable); 142 dcl xmail_process_user_msg_ entry (); /* no parameter */ 143 dcl xmail_redisplay_$menu entry (); 144 dcl xmail_sw_$redisplay entry (); 145 dcl xmail_sw_$update_usage entry (char (*)); 146 dcl xmail_window_manager_$quit_handler entry () returns (bit (1) aligned); 147 dcl xmail_window_manager_$reconnect entry (); 148 dcl xmail_window_manager_$suppress_menu entry (); 149 dcl xmail_window_manager_$restore_menu entry (); 150 151 /* BUILTINS */ 152 153 dcl (addr, codeptr, divide, null, rtrim) builtin; 154 155 /* BASED */ 156 157 dcl based_string char (no_chars) based (temp_seg_ptr); 158 159 /* INCLUDE FILES */ 160 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 161 162 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 */ 163 164 3 1 /* BEGIN INCLUDE FILE ... xmail_send_mail.incl.pl1 */ 3 2 3 3 /****^ HISTORY COMMENTS: 3 4* 1) change(87-08-10,Blair), approve(87-12-17,MCR7818), 3 5* audit(87-12-23,LJAdams), install(88-01-12,MR12.2-1013): 3 6* Add pointer for reply_to field. 3 7* END HISTORY COMMENTS */ 3 8 3 9 /* Created by R. Ignagni July 1981 */ 3 10 3 11 /* 84-08-06 JG Backs: Modified to add pointer for bcc. */ 3 12 3 13 dcl 1 send_mail_info aligned based (send_mail_info_ptr), 3 14 2 msg_exists bit (1), /* ON = new message exists */ 3 15 2 stored_seg_ptr ptr, /* ptr to stored msg seg */ 3 16 2 emacs_seg_ptr ptr, /* ptr to seg containing msg */ 3 17 2 new_msg_ptr ptr, /* ptr to new_msg structure */ 3 18 2 reply_to_list_ptr ptr, /* ptr to reply_to addr struct */ 3 19 2 to_list_ptr ptr, /* ptr to recipients addr struct */ 3 20 2 cc_list_ptr ptr, /* ptr to cc address structure */ 3 21 2 bcc_list_ptr ptr, /* ptr to bcc address structure */ 3 22 2 send_mail_area_ptr ptr, /* ptr to send_mail_area */ 3 23 2 emacs_seg_pathname char (168); 3 24 3 25 3 26 dcl send_mail_info_ptr ptr external static init (null); 3 27 3 28 /* END INCLUDE FILE xmail_send_mail.inl.pl1 */ 165 166 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 */ 167 168 169 /* BEGIN */ 170 171 restore_menu_needed = "0"b; 172 send_mail_info.stored_seg_ptr = null (); 173 temp_seg_ptr = null (); 174 stored_msg_ptr = null (); 175 176 177 /* Update status window */ 178 179 call xmail_sw_$update_usage (" "); 180 call xmail_sw_$redisplay (); 181 call ioa_$nnl (" "); 182 183 /* Free any current address list(s), msg ptr, and create seg for Emacs to 184* place new message in */ 185 186 if P_store 187 then suffix = "_ssm"; 188 189 else do; 190 suffix = "_sm "; 191 if send_mail_info.new_msg_ptr ^= null () 192 then do; 193 call mail_system_$free_message (send_mail_info.new_msg_ptr, code); 194 if code ^= 0 then send_mail_info.new_msg_ptr = null (); 195 end; 196 if send_mail_info.to_list_ptr ^= null () 197 then do; 198 call mail_system_$free_address_list (send_mail_info.to_list_ptr, 199 code); 200 if code ^= 0 then send_mail_info.to_list_ptr = null (); 201 end; 202 if send_mail_info.cc_list_ptr ^= null () 203 then do; 204 call mail_system_$free_address_list (send_mail_info.cc_list_ptr, code); 205 if code ^= 0 then send_mail_info.cc_list_ptr = null (); 206 end; 207 208 /* Add reply-to handling */ 209 if send_mail_info.reply_to_list_ptr ^= null () 210 then do; 211 call mail_system_$free_address_list (send_mail_info.reply_to_list_ptr, code); 212 if code ^= 0 then send_mail_info.reply_to_list_ptr = null (); 213 end; 214 215 /* Add bcc handling */ 216 217 if send_mail_info.bcc_list_ptr ^= null () 218 then do; 219 call mail_system_$free_address_list (send_mail_info.bcc_list_ptr, code); 220 if code ^= 0 then send_mail_info.bcc_list_ptr = null (); 221 end; 222 223 224 /* Initialize the status of the message */ 225 226 send_mail_info.msg_exists = "0"b; 227 end; 228 229 /* Set up quit and clean up conditions */ 230 231 on condition (cleanup) begin; 232 send_mail_info.msg_exists = "0"b; 233 call CLEAN_UP; 234 end; 235 on condition (quit) 236 begin; 237 send_mail_info.msg_exists = "0"b; 238 if xmail_window_manager_$quit_handler () 239 then do; 240 if restore_menu_needed 241 242 243 244 245 246 247 then do; 248 call xmail_window_manager_$restore_menu; 249 call xmail_redisplay_$menu; 250 end; 251 call window_$clear_window (iox_$user_output, (0)); /* ignore code */ 252 call ioa_ (HIT_QUIT_KEY); 253 call CLEAN_UP; 254 go to EXIT; 255 end; 256 end; 257 258 /* Create seg (or trim existing seg) to be used by emacs for the user msg */ 259 260 user_msg_seg_entry_name = xmail_data.actee.person || suffix; 261 call hcs_$make_seg ("", user_msg_seg_entry_name, "", RW_ACCESS_BIN, temp_seg_ptr, code); 262 if code = error_table_$namedup | code = error_table_$segknown 263 then do; 264 bit_count = 0; 265 call terminate_file_ (temp_seg_ptr, bit_count, TERM_FILE_BC, code); 266 end; 267 if code ^= 0 268 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 269 270 send_mail_info.emacs_seg_pathname = get_pdir_ (); 271 if P_store 272 then send_mail_info.stored_seg_ptr = temp_seg_ptr; 273 else send_mail_info.emacs_seg_ptr = temp_seg_ptr; 274 send_mail_info.emacs_seg_pathname = rtrim (send_mail_info.emacs_seg_pathname) || ">" || user_msg_seg_entry_name; 275 276 /* Call emacs_ for preparing message. */ 277 278 if ext_ptr = null () 279 then do; 280 call hcs_$make_ptr (codeptr (ENTRY_NAME), EMACS_EXT, "", 281 ext_ptr, code); 282 if code ^= 0 then call xmail_error_$no_code 283 (code, NAME, STOP, "^a", ERROR_MESSAGE); 284 call hcs_$fs_get_path_name (ext_ptr, ext_dir, (0), 285 ext_file, code); 286 if code ^= 0 then call xmail_error_$no_code 287 (code, NAME, STOP, "^a", ERROR_MESSAGE); 288 ext_pname = rtrim (ext_dir) || ">" || EMACS_EXT; 289 end; 290 291 292 emacs_flavor = "send"; 293 bit_count = 0; 294 call ioa_ ("... Please wait for editor ..."); 295 296 /* Check personalization option to remove and restore menus while editing */ 297 298 if xmail_data.remove_menus 299 then do; 300 call xmail_window_manager_$suppress_menu (); 301 restore_menu_needed = "1"b; 302 end; 303 304 call emacs_ (iox_$user_output, (send_mail_info.emacs_seg_pathname), 305 ext_pname, addr (emacs_flavor), status); 306 307 if restore_menu_needed 308 then do; 309 call xmail_window_manager_$restore_menu (); 310 call xmail_redisplay_$menu; 311 restore_menu_needed = "0"b; 312 end; 313 314 call hcs_$status_mins (temp_seg_ptr, type, bit_count, code); 315 if code ^= 0 then call xmail_error_$no_code (code, NAME, STOP, "^a", ERROR_MESSAGE); 316 if bit_count = 0 317 then do; 318 call xmail_window_manager_$reconnect (); 319 call ioa_ (HIT_QUIT_KEY); 320 call CLEAN_UP; 321 goto EXIT; 322 end; 323 324 if status = 1 325 then do; 326 call store_msg (); 327 goto EXIT; 328 end; 329 330 /* If forwarding message now then call proc for extracting the "subject", 331*"text", and determining the primary and secondary (if any) recipients 332* address list structures */ 333 334 335 call xmail_process_user_msg_ (); /* no parameter */ 336 EXIT: 337 return; 338 339 /* INTERNAL PROCEDURES */ 340 341 store_msg: proc (); 342 343 344 /* ENTRIES */ 345 346 dcl xmail_select_file_$caller_msg entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned, 347 char (168), char (32) var, char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); 348 349 /* BASED */ 350 351 dcl stored_string char (no_chars) based (stored_msg_ptr); 352 353 /* BEGIN */ 354 355 356 call xmail_select_file_$caller_msg ("deferred message", "defer", "", ALLOW_OLD, ALLOW_NEW, store_dir, store_file, "Type name you wish to give the ""deferred message"" (or ?? for list)", unused_bit, unused_bit2, code); 357 if code ^= 0 358 then do; 359 call ioa_ ("Sorry, ""deferred message"" not saved."); 360 call CLEAN_UP; 361 return; 362 end; 363 364 stored_msg_ptr = null (); 365 call hcs_$make_seg (store_dir, rtrim (store_file) || ".defer", "", RW_ACCESS_BIN, stored_msg_ptr, code); 366 367 if code ^= 0 & code ^= error_table_$namedup & code ^= error_table_$segknown then do; 368 call ioa_ ("Sorry, unable to save ""deferred message"". This is an internal error."); 369 call CLEAN_UP; 370 return; 371 end; 372 373 call terminate_file_ (stored_msg_ptr, bit_count, TERM_FILE_BC, code); 374 375 /* Get number of chars in seg */ 376 377 no_chars = divide (bit_count, 9, 17, 0); 378 379 stored_string = based_string; 380 call ioa_ ("Deferred message ""^a"" saved.", store_file); 381 382 return; 383 end store_msg; 384 385 CLEAN_UP: proc (); 386 387 if temp_seg_ptr ^= null () 388 then call delete_$ptr (temp_seg_ptr, DELETE_SEG_FORCE_CHASE, NAME, code); 389 send_mail_info.stored_seg_ptr = null (); 390 /* send_mail_info.msg_exists = "0"b; 391* * the above line was moved to the on unit so that the message will only * 392* * be marked as non_existant on a true cleanup condition, but will other-* 393* * wise still be available. */ 394 send_mail_info.emacs_seg_pathname = ""; 395 return; 396 end CLEAN_UP; 397 398 end xmail_prepare_msg_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/02/88 0748.1 xmail_prepare_msg_.pl1 >spec>install>MR12.2-1098>xmail_prepare_msg_.pl1 161 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 163 2 09/02/88 0743.4 xmail_data.incl.pl1 >spec>install>MR12.2-1098>xmail_data.incl.pl1 165 3 01/14/88 2003.9 xmail_send_mail.incl.pl1 >ldd>include>xmail_send_mail.incl.pl1 167 4 09/12/84 0916.7 window_dcls.incl.pl1 >ldd>include>window_dcls.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. ALLOW_NEW 000057 constant bit(1) initial dcl 85 set ref 356* ALLOW_OLD 000057 constant bit(1) initial dcl 86 set ref 356* DELETE_SEG_FORCE_CHASE 000044 constant bit(6) initial packed unaligned dcl 87 set ref 387* EMACS_EXT 000036 constant char(21) initial packed unaligned dcl 88 set ref 280* 288 ENTRY_NAME 000114 automatic entry variable initial dcl 89 set ref 89* 280 280 ERROR_MESSAGE 000015 constant char(67) initial packed unaligned dcl 90 set ref 267* 282* 286* 315* HIT_QUIT_KEY 000010 constant char(19) initial packed unaligned dcl 91 set ref 252* 319* NAME 000003 constant char(18) initial packed unaligned dcl 92 set ref 267* 282* 286* 315* 387* P_store parameter bit(1) packed unaligned dcl 76 ref 27 186 271 RW_ACCESS_BIN 000000 constant fixed bin(5,0) initial dcl 1-36 set ref 261* 365* STOP 000002 constant char(1) initial packed unaligned dcl 93 set ref 267* 282* 286* 315* TERM_FILE_BC 000001 constant bit(2) initial packed unaligned dcl 94 set ref 265* 373* actee 171 based structure level 2 dcl 2-54 addr builtin function dcl 153 ref 304 304 based_string based char packed unaligned dcl 157 ref 379 bcc_list_ptr 16 based pointer level 2 dcl 3-13 set ref 217 219* 220* bit_count 000120 automatic fixed bin(24,0) dcl 111 set ref 264* 265* 293* 314* 316 373* 377 cc_list_ptr 14 based pointer level 2 dcl 3-13 set ref 202 204* 205* cleanup 000106 stack reference condition dcl 81 ref 231 code 000121 automatic fixed bin(35,0) dcl 112 set ref 193* 194 198* 200 204* 205 211* 212 219* 220 261* 262 262 265* 267 267* 280* 282 282* 284* 286 286* 314* 315 315* 356* 357 365* 367 367 367 373* 387* codeptr builtin function dcl 153 ref 280 280 delete_$ptr 000154 constant entry external dcl 129 ref 387 divide builtin function dcl 153 ref 377 emacs_ 000156 constant entry external dcl 130 ref 304 emacs_flavor 000122 automatic char(32) packed unaligned dcl 113 set ref 292* 304 304 emacs_seg_pathname 22 based char(168) level 2 dcl 3-13 set ref 270* 274* 274 304 394* emacs_seg_ptr 4 based pointer level 2 dcl 3-13 set ref 273* error_table_$namedup 000146 external static fixed bin(35,0) dcl 98 ref 262 367 error_table_$segknown 000150 external static fixed bin(35,0) dcl 99 ref 262 367 ext_dir 000010 internal static char(168) packed unaligned dcl 104 set ref 284* 288 ext_file 000062 internal static char(32) packed unaligned dcl 105 set ref 284* ext_pname 000074 internal static char(168) packed unaligned dcl 107 set ref 288* 304* ext_ptr 000072 internal static pointer initial dcl 106 set ref 278 280* 284* flags 213 based structure level 2 dcl 2-54 get_pdir_ 000160 constant entry external dcl 131 ref 270 hcs_$fs_get_path_name 000162 constant entry external dcl 132 ref 284 hcs_$make_ptr 000164 constant entry external dcl 133 ref 280 hcs_$make_seg 000166 constant entry external dcl 134 ref 261 365 hcs_$status_mins 000170 constant entry external dcl 135 ref 314 ioa_ 000172 constant entry external dcl 136 ref 252 294 319 359 368 380 ioa_$nnl 000174 constant entry external dcl 137 ref 181 iox_$user_output 000152 external static pointer dcl 100 set ref 251* 304* mail_system_$free_address_list 000176 constant entry external dcl 138 ref 198 204 211 219 mail_system_$free_message 000200 constant entry external dcl 139 ref 193 msg_exists based bit(1) level 2 dcl 3-13 set ref 226* 232* 237* new_msg_ptr 6 based pointer level 2 dcl 3-13 set ref 191 193* 194* no_chars 000132 automatic fixed bin(24,0) dcl 114 set ref 377* 379 379 null builtin function dcl 153 ref 172 173 174 191 194 196 200 202 205 209 212 217 220 278 364 387 389 person 171 based varying char(32) level 3 dcl 2-54 ref 260 quit 000100 stack reference condition dcl 81 ref 235 remove_menus 213(02) based bit(1) level 3 packed packed unaligned dcl 2-54 ref 298 reply_to_list_ptr 10 based pointer level 2 dcl 3-13 set ref 209 211* 212* restore_menu_needed 000133 automatic bit(1) dcl 115 set ref 171* 240 301* 307 311* rtrim builtin function dcl 153 ref 274 288 365 send_mail_info based structure level 1 dcl 3-13 send_mail_info_ptr 000230 external static pointer initial dcl 3-26 ref 172 191 193 194 196 198 200 202 204 205 209 211 212 217 219 220 226 232 237 270 271 273 274 274 304 389 394 status 000134 automatic fixed bin(35,0) dcl 116 set ref 304* 324 store_dir 000135 automatic char(168) packed unaligned dcl 117 set ref 356* 365* store_file 000207 automatic varying char(32) dcl 118 set ref 356* 365 380* stored_msg_ptr 000220 automatic pointer dcl 119 set ref 174* 364* 365* 373* 379 stored_seg_ptr 2 based pointer level 2 dcl 3-13 set ref 172* 271* 389* stored_string based char packed unaligned dcl 351 set ref 379* suffix 000222 automatic char(4) packed unaligned dcl 120 set ref 186* 190* 260 temp_seg_ptr 000224 automatic pointer dcl 121 set ref 173* 261* 265* 271 273 314* 379 387 387* terminate_file_ 000202 constant entry external dcl 140 ref 265 373 to_list_ptr 12 based pointer level 2 dcl 3-13 set ref 196 198* 200* type 000226 automatic fixed bin(2,0) dcl 122 set ref 314* unused_bit 000227 automatic bit(1) dcl 123 set ref 356* unused_bit2 000230 automatic bit(1) dcl 124 set ref 356* user_msg_seg_entry_name 000231 automatic char(32) packed unaligned dcl 125 set ref 260* 261* 274 window_$clear_window 000232 constant entry external dcl 4-13 ref 251 xmail_data based structure level 1 dcl 2-54 xmail_data_ptr 000226 external static pointer initial dcl 2-52 ref 260 298 xmail_error_$no_code 000204 constant entry external dcl 141 ref 267 282 286 315 xmail_process_user_msg_ 000206 constant entry external dcl 142 ref 335 xmail_redisplay_$menu 000210 constant entry external dcl 143 ref 249 310 xmail_select_file_$caller_msg 000234 constant entry external dcl 346 ref 356 xmail_sw_$redisplay 000212 constant entry external dcl 144 ref 180 xmail_sw_$update_usage 000214 constant entry external dcl 145 ref 179 xmail_window_manager_$quit_handler 000216 constant entry external dcl 146 ref 238 xmail_window_manager_$reconnect 000220 constant entry external dcl 147 ref 318 xmail_window_manager_$restore_menu 000224 constant entry external dcl 149 ref 248 309 xmail_window_manager_$suppress_menu 000222 constant entry external dcl 148 ref 300 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 M_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 REW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 R_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 S_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 W_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 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. CLEAN_UP 002024 constant entry internal dcl 385 ref 233 253 320 360 369 EXIT 001513 constant label dcl 336 ref 254 321 327 store_msg 001514 constant entry internal dcl 341 ref 326 xmail_prepare_msg_ 000220 constant entry external dcl 27 ref 89 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2510 2746 2101 2520 Length 3310 2101 236 326 407 136 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME xmail_prepare_msg_ 318 external procedure is an external procedure. on unit on line 231 64 on unit on unit on line 235 76 on unit store_msg internal procedure shares stack frame of external procedure xmail_prepare_msg_. CLEAN_UP 82 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 ext_dir xmail_prepare_msg_ 000062 ext_file xmail_prepare_msg_ 000072 ext_ptr xmail_prepare_msg_ 000074 ext_pname xmail_prepare_msg_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME xmail_prepare_msg_ 000114 ENTRY_NAME xmail_prepare_msg_ 000120 bit_count xmail_prepare_msg_ 000121 code xmail_prepare_msg_ 000122 emacs_flavor xmail_prepare_msg_ 000132 no_chars xmail_prepare_msg_ 000133 restore_menu_needed xmail_prepare_msg_ 000134 status xmail_prepare_msg_ 000135 store_dir xmail_prepare_msg_ 000207 store_file xmail_prepare_msg_ 000220 stored_msg_ptr xmail_prepare_msg_ 000222 suffix xmail_prepare_msg_ 000224 temp_seg_ptr xmail_prepare_msg_ 000226 type xmail_prepare_msg_ 000227 unused_bit xmail_prepare_msg_ 000230 unused_bit2 xmail_prepare_msg_ 000231 user_msg_seg_entry_name xmail_prepare_msg_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. delete_$ptr emacs_ get_pdir_ hcs_$fs_get_path_name hcs_$make_ptr hcs_$make_seg hcs_$status_mins ioa_ ioa_$nnl mail_system_$free_address_list mail_system_$free_message terminate_file_ window_$clear_window xmail_error_$no_code xmail_process_user_msg_ xmail_redisplay_$menu xmail_select_file_$caller_msg xmail_sw_$redisplay xmail_sw_$update_usage 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 27 000215 89 000225 171 000231 172 000232 173 000236 174 000237 179 000240 180 000252 181 000257 186 000272 190 000303 191 000305 193 000314 194 000324 196 000333 198 000342 200 000352 202 000361 204 000370 205 000400 209 000407 211 000416 212 000426 217 000435 219 000444 220 000454 226 000463 231 000466 232 000502 233 000504 234 000511 235 000512 237 000526 238 000530 240 000541 248 000544 249 000551 251 000556 252 000570 253 000601 254 000606 256 000611 260 000612 261 000633 262 000667 264 000675 265 000676 267 000722 270 000757 271 000774 273 001005 274 001007 278 001050 280 001055 282 001106 284 001143 286 001175 288 001232 289 001272 292 001273 293 001276 294 001277 298 001312 300 001320 301 001324 304 001326 307 001365 309 001367 310 001374 311 001401 314 001402 315 001417 316 001454 318 001456 319 001463 320 001474 321 001500 324 001501 326 001504 327 001505 335 001506 336 001513 341 001514 356 001515 357 001604 359 001606 360 001622 361 001626 364 001627 365 001631 367 001715 368 001725 369 001740 370 001744 373 001745 377 001772 379 001775 380 002002 382 002022 385 002023 387 002031 389 002062 394 002067 395 002074 ----------------------------------------------------------- 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