1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52 xmail:
53 executive_mail: proc ();
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140 ^L
141
142
143 dcl answer_yn char (3) var;
144 dcl arg_index fixed bin;
145 dcl arg_len fixed bin (21);
146 dcl arg_ptr ptr;
147 dcl bit_count fixed bin (35);
148 dcl code fixed bin (35);
149 dcl interactive_msgs_yn bit (1) aligned;
150 dcl lifetime_first_invocation char (3) var;
151 dcl messages_need_cleanup bit (1) aligned;
152 dcl multics_yn bit (1) aligned;
153 dcl no_of_args fixed bin;
154 dcl old_modes char (256);
155 dcl xmail_dir_opened bit (1) aligned;
156 dcl (total_message_count, ordinary_message_count ) fixed bin;
157 dcl person char (32);
158 dcl project char (32);
159 dcl prompt_string char (160) var;
160 dcl reason char (128);
161 dcl sci_ptr ptr;
162 dcl use_default_fkeys bit (1) aligned;
163 dcl video_needs_cleanup bit (1) aligned;
164 dcl video_was_on bit (1) aligned;
165 dcl yes_sw bit (1) aligned;
166
167 dcl 1 auto_xmail_data like xmail_data;
168 dcl 1 ti like terminal_info;
169
170
171
172 dcl arg char (arg_len) based (arg_ptr);
173
174
175
176 dcl (addr, bin, codeptr, index, null, rtrim) builtin;
177
178
179
180 dcl (cleanup, program_interrupt, quit) condition;
181
182
183
184 dcl adjust_bit_count_ entry (char(168), char(32), bit(1) aligned, fixed bin(35), fixed bin(35));
185 dcl com_err_ entry () options (variable);
186 dcl cu_$arg_count entry (fixed bin, fixed bin (35));
187 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
188 dcl get_pdir_ entry() returns(char(168));
189 dcl ioa_ entry () options (variable);
190 dcl ioa_$rsnnl entry () options (variable);
191 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35));
192 dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35));
193 dcl mail_system_$get_message_counts entry (char (*), char (*), bit (1) aligned, fixed bin, fixed bin, fixed bin, fixed bin (35));
194 dcl ssu_$destroy_invocation entry (ptr);
195 dcl ssu_$record_usage entry (ptr, ptr, fixed bin (35));
196 dcl ssu_$standalone_invocation entry (ptr, char (*), char (*), ptr, entry, fixed bin (35));
197 dcl timer_manager_$sleep entry (fixed bin (71), bit (2));
198 dcl ttt_info_$function_key_data entry (char (*), ptr, ptr, fixed bin (35));
199 dcl user_info_$whoami entry (char (*), char (*), char (*));
200 dcl video_utils_$turn_off_login_channel entry (fixed bin (35));
201 dcl video_utils_$turn_on_login_channel entry (fixed bin (35), char (*));
202 dcl window_$clear_window entry (ptr, fixed bin (35));
203 dcl xmail$ssu_exit entry ();
204 dcl xmail_Executive_Mail_ entry ();
205 dcl xmail_Getting_Started_ entry ();
206 dcl xmail_default_fkeys_ entry () returns (ptr);
207 dcl xmail_dir_manager_$close_dir entry options (variable);
208 dcl xmail_dir_manager_$open_dir entry (fixed bin (35));
209 dcl xmail_error_$no_print entry () options (variable);
210 dcl xmail_get_str_$yes_no entry (char (*) var, bit (1) aligned);
211 dcl xmail_im_mgr_$defer_messages entry ();
212 dcl xmail_im_mgr_$init entry ();
213 dcl xmail_im_mgr_$print_messages entry ();
214 dcl xmail_im_mgr_$restore_original entry ();
215 dcl xmail_review_defers_ entry (char (*), char (*), fixed bin);
216 dcl xmail_sw_$initialize entry ();
217 dcl xmail_value_$get_no_validate entry (char (*), char (*) var, fixed bin (35));
218 dcl xmail_value_$get_with_default entry (char (*), char (*) var, char (*) var, fixed bin (35));
219 dcl xmail_value_$set entry (char (*), char (*) var, char (*) var, fixed bin (35));
220 dcl xmail_window_manager_$create_windows entry (fixed bin (35));
221 dcl xmail_window_manager_$destroy_windows entry (bit (1));
222
223
224
225 dcl error_table_$badopt fixed bin (35) ext static;
226 dcl error_table_$invalid_device fixed bin (35) ext static;
227 dcl error_table_$no_table fixed bin (35) ext static;
228 dcl iox_$user_io ptr ext static;
229 dcl video_data_$terminal_iocb ptr ext static;
230 dcl xmail_err_$exit_now fixed bin (35) ext static;
231 dcl xmail_err_$insuff_room_for_xmail fixed bin (35) ext static;
232
233
234
235 dcl ALWAYS_ESCAPE char (21) init ("always_escape_keys_yn") int static options (constant);
236 dcl CONFIRM_PRINT char (16) init ("confirm_print_yn") int static options (constant);
237 dcl ERROR_LOG_SEGMENT char (11) init ("xmail.error") int static options (constant);
238 dcl FOLD_MODE char (14) init ("more_mode=fold") int static options (constant);
239 dcl HELP_LINE char (36) init ("If you need help, type ""help xmail"".") int static options (constant);
240 dcl INT_ERR char (38) init ("This is an internal programming error.") int static options (constant);
241 dcl INTERACTIVE_MSGS char (19) init ("interactive_msgs_yn") int static options (constant);
242 dcl LISTS_AS_MENUS char (17) init ("lists_as_menus_yn") int static options (constant);
243 dcl MIN_LINES_NEEDED fixed bin init (20) int static options (constant);
244 dcl MSGS_AS_MAIL char (15) init ("msgs_as_mail_yn") int static options (constant);
245 dcl MULTICS_MODE char (15) init ("multics_mode_yn") int static options (constant);
246 dcl NAME char (14) init ("executive_mail") int static options (constant);
247 dcl N_FKEYS_USED fixed bin init (7) int static options (constant);
248 dcl PERSONALIZE_STATEMENT char (139) init ("^/ It will be supported in the MR11 release.^/ The Personalize Executive Mail menu can be used to set this function.^/Continuing setup...") int static options (constant);
249 dcl REMOVE_MENUS char (15) init ("remove_menus_yn") int static options (constant);
250 dcl WRAP_MODE char (14) init ("more_mode=wrap") int static options (constant);
251 ^L
252
253
254 %include function_key_data;
255 %page;
256 %include terminal_info;
257 %page;
258 %include query_info;
259 %page;
260 %include xmail_data;
261 %page;
262 %include xmail_responses;
263 %page;
264 %include xmail_windows;
265 %page;
266 ^L
267
268
269
270
271 if xmail_data_ptr ^= null
272 then do;
273 call com_err_ (0, NAME, "Previous invocation still active.");
274 goto EXIT;
275 end;
276
277
278
279 xmail_data_ptr = null ();
280 sci_ptr = null ();
281 xmail_dir_opened = "0"b;
282 video_needs_cleanup = "0"b;
283 messages_need_cleanup = "0"b;
284 old_modes = "";
285 on condition (cleanup) call CLEANUP ("1"b);
286
287
288
289 call ssu_$standalone_invocation (sci_ptr, NAME, (xmail_version), null (), xmail$ssu_exit, code);
290 call ssu_$record_usage (sci_ptr, codeptr (xmail), code);
291 call ssu_$destroy_invocation (sci_ptr);
292
293
294
295 auto_xmail_data.mail_dir = "";
296 auto_xmail_data.first_label = MAIN_MENU;
297 auto_xmail_data.quit_label = QUIT;
298 auto_xmail_data.value_seg_pathname = "";
299 auto_xmail_data.function_key_data_ptr = null;
300
301
302
303 call user_info_$whoami (person, project, "");
304 auto_xmail_data.person = rtrim (person);
305 auto_xmail_data.project = rtrim (project);
306
307 xmail_data_ptr = addr (auto_xmail_data);
308
309
310 auto_xmail_data.error_seg_in_pdir = "0"b;
311 call xmail_dir_manager_$open_dir (code);
312 if code = xmail_err_$exit_now then do;
313 call xmail_dir_manager_$close_dir ();
314 xmail_data_ptr = null;
315 goto EXIT;
316 end;
317 else if code ^= 0
318 then goto COMPLAIN;
319 xmail_dir_opened = "1"b;
320
321
322
323 call xmail_value_$get_no_validate (ALWAYS_ESCAPE, answer_yn, code);
324 if code = 0 & answer_yn = YES
325 then use_default_fkeys = "1"b;
326 else use_default_fkeys = "0"b;
327
328 call xmail_value_$get_no_validate (MULTICS_MODE, answer_yn, code);
329 if code = 0 & answer_yn = YES
330 then multics_yn = "1"b;
331 else multics_yn = "0"b;
332
333 call xmail_value_$get_no_validate (LISTS_AS_MENUS, answer_yn, code);
334 if code = 0 & answer_yn = YES
335 then auto_xmail_data.lists_as_menus = "1"b;
336 else auto_xmail_data.lists_as_menus = "0"b;
337
338 call xmail_value_$get_no_validate (INTERACTIVE_MSGS, answer_yn, code);
339 if code = 0 & answer_yn = NO
340 then interactive_msgs_yn = "0"b;
341 else interactive_msgs_yn = "1"b;
342
343 call xmail_value_$get_no_validate (REMOVE_MENUS, answer_yn, code);
344 if code = 0 & answer_yn = YES
345 then auto_xmail_data.remove_menus = "1"b;
346 else auto_xmail_data.remove_menus = "0"b;
347
348 call xmail_value_$get_no_validate (CONFIRM_PRINT, answer_yn, code);
349 if code = 0 & answer_yn = NO
350 then auto_xmail_data.confirm_print = "0"b;
351 else auto_xmail_data.confirm_print = "1"b;
352
353 call xmail_value_$get_no_validate (MSGS_AS_MAIL, answer_yn, code);
354 if code = 0 & answer_yn = YES
355 then auto_xmail_data.msgs_as_mail = "1"b;
356 else auto_xmail_data.msgs_as_mail = "0"b;
357
358
359 auto_xmail_data.general_help, auto_xmail_data.foreign_mailbox = "0"b;
360
361
362
363
364 call cu_$arg_count (no_of_args, code);
365 if code ^= 0
366 then goto COMPLAIN;
367
368 if no_of_args > 0
369 then do arg_index = 1 to no_of_args;
370 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
371 if code ^= 0
372 then goto COMPLAIN;
373
374 if arg = "-mm" | arg = "-multics_mode"
375 then do;
376 multics_yn = "1"b;
377 call ioa_ ("Control argument ""-multics_mode"" is now obsolete." || PERSONALIZE_STATEMENT);
378 call timer_manager_$sleep (5, "11"b);
379 end;
380
381 else if arg = "-nim" | arg = "-no_interactive_messages"
382 then do;
383 interactive_msgs_yn = "0"b;
384 call ioa_ ("Control argument ""-no_interactive_messages"" is now obsolete." || PERSONALIZE_STATEMENT);
385 call timer_manager_$sleep (5, "11"b);
386 end;
387
388 else if arg = "-im" | arg = "-interactive_messages"
389 then do;
390 interactive_msgs_yn = "1"b;
391 call ioa_ ("Control argument ""-interactive_messages"" is now obsolete." || PERSONALIZE_STATEMENT);
392 call timer_manager_$sleep (5, "11"b);
393 end;
394
395 else if arg = "-esc" | arg = "-escape_sequences"
396 then do;
397 use_default_fkeys = "1"b;
398 call ioa_ ("Control argument ""-escape_sequences"" is now obsolete." || PERSONALIZE_STATEMENT);
399 call timer_manager_$sleep (5, "11"b);
400 end;
401 else do;
402 call com_err_ (error_table_$badopt, NAME, "^a^/^a", arg, HELP_LINE);
403 xmail_data_ptr = null;
404 goto EXIT;
405 end;
406 end;
407
408 auto_xmail_data.multics_mode = multics_yn;
409 auto_xmail_data.interactive_msgs = interactive_msgs_yn;
410
411
412
413 call mail_system_$get_message_counts ((xmail_data.mail_dir), "incoming", "1"b, total_message_count, ordinary_message_count, (0), code);
414 if total_message_count < 1
415 then do;
416 call ioa_$rsnnl ("^/You have no messages in the ""incoming"" mailbox.^/Do you still wish to enter executive_mail?", prompt_string, (0));
417 call xmail_get_str_$yes_no (prompt_string, yes_sw);
418 if ^yes_sw
419 then do;
420 call xmail_dir_manager_$close_dir ();
421 xmail_data_ptr = null;
422 goto EXIT;
423 end;
424 end;
425
426
427
428
429 auto_xmail_data.n_fkeys_used = N_FKEYS_USED + bin (auto_xmail_data.multics_mode, 1, 0);
430
431 ti.version = terminal_info_version;
432 call iox_$control (iox_$user_io, "terminal_info", addr (ti), code);
433 if code ^= 0
434 then goto COMPLAIN;
435
436 call ttt_info_$function_key_data (ti.term_type, null, function_key_data_ptr, code);
437 if code ^= 0
438 then use_default_fkeys = "1"b;
439 else if function_key_data.highest < auto_xmail_data.n_fkeys_used
440 then use_default_fkeys = "1"b;
441
442 if use_default_fkeys
443 then do;
444 if function_key_data_ptr ^= null ()
445 then free function_key_data_ptr -> function_key_data;
446 auto_xmail_data.function_key_data_ptr = xmail_default_fkeys_ ();
447 auto_xmail_data.normal_usage = "(For help, press ESC, then ""?"")";
448 end;
449 else do;
450 auto_xmail_data.function_key_data_ptr = function_key_data_ptr;
451 auto_xmail_data.normal_usage = "(For help, press F1)";
452 end;
453
454
455
456
457
458 xmail_windows.min_lines_needed = MIN_LINES_NEEDED;
459 xmail_windows.status.iocb,
460 xmail_windows.menu.iocb,
461 xmail_windows.bottom.iocb = null;
462
463 xmail_windows.status.position,
464 xmail_windows.menu.position,
465 xmail_windows.bottom.position = 0;
466
467 xmail_windows.initial_position = 0;
468
469
470
471 if video_data_$terminal_iocb ^= null
472 then video_was_on = "1"b;
473 else video_was_on = "0"b;
474
475
476
477
478
479 call xmail_im_mgr_$init;
480
481 if xmail_data.interactive_msgs then do;
482 messages_need_cleanup = "1"b;
483 call xmail_im_mgr_$defer_messages;
484 end;
485
486
487
488 call xmail_value_$get_with_default ("lifetime_first_invocation", (YES), lifetime_first_invocation, code);
489 if code ^= 0
490 then do;
491 call xmail_error_$no_print (code, NAME, "l", "^a", INT_ERR);
492 lifetime_first_invocation = YES;
493 end;
494
495
496
497 if ^video_was_on
498 then do;
499 call video_utils_$turn_on_login_channel (code, reason);
500 if code ^= 0
501 then do;
502 if code = error_table_$no_table
503 then call com_err_ (error_table_$invalid_device, NAME, "This command cannot operate with your current terminal type.");
504 else call com_err_ (code, NAME, "^a", reason);
505 goto ERROR_EXIT;
506 end;
507 end;
508
509
510
511 call xmail_window_manager_$create_windows (code);
512 if code = xmail_err_$insuff_room_for_xmail
513 then do;
514 call com_err_ (code, NAME, "^/The minimum number of lines needed is ^d.", xmail_windows.min_lines_needed);
515 goto ERROR_EXIT;
516 end;
517 else if code ^= 0
518 then goto COMPLAIN;
519 video_needs_cleanup = "1"b;
520
521 call iox_$modes (iox_$user_io, "", old_modes, code);
522 if code ^= 0
523 then call com_err_ (code, NAME, "Unable to get bottom window modes. ^a", INT_ERR);
524 else do;
525 if index (old_modes, FOLD_MODE) > 0
526 then do;
527 call iox_$modes (iox_$user_io, WRAP_MODE, old_modes, code);
528 if code ^= 0
529 then call com_err_ (code, NAME, "Unable to set wrap mode in bottom window. ^a", INT_ERR);
530 end;
531 end;
532
533 call xmail_sw_$initialize ();
534
535 on condition (program_interrupt) begin;
536 call window_$clear_window (iox_$user_io, code);
537 goto xmail_data.first_label;
538 end;
539
540 on condition (quit)
541 begin;
542 dcl xmail_window_manager_$reconnect entry ();
543 call xmail_window_manager_$reconnect ();
544 call window_$clear_window (iox_$user_io, code);
545 goto xmail_data.first_label;
546 end;
547
548 MAIN_MENU:
549
550 if lifetime_first_invocation = YES
551 then call xmail_Getting_Started_ ();
552 else call xmail_Executive_Mail_;
553
554 goto MAIN_MENU;
555
556 QUIT:
557 if lifetime_first_invocation = YES
558 then do;
559 call xmail_value_$set ("lifetime_first_invocation", (NO), "", code);
560 if code ^= 0
561 then call xmail_error_$no_print (code, NAME, "l", "^a", INT_ERR);
562 end;
563 call xmail_review_defers_ ("message", "defer", 30);
564 call xmail_review_defers_ ("reply", "reply", 30);
565 call CLEANUP ("0"b);
566 goto EXIT;
567
568 COMPLAIN:
569 call com_err_ (code, NAME, "^a", INT_ERR);
570
571 ERROR_EXIT:
572 call CLEANUP ("0"b);
573
574 EXIT:
575 return;
576 ^L
577 ssu_exit: entry;
578
579
580
581
582
583 return;
584 ^L
585
586
587 CLEANUP: proc (condition_signalled);
588
589
590
591 dcl condition_signalled bit (1);
592 dcl prompt char (46) init (" Press <RETURN> to continue") int static options (constant);
593 dcl 1 auto_query_info like query_info;
594 dcl been_thru_this_before bit (1) aligned;
595 dcl line char (80) var;
596 dcl iox_$user_output ptr ext static;
597 dcl command_query_ entry() options(variable);
598 dcl ENABLE_ESCAPE bit (2) aligned init ("11"b) int static options (constant);
599
600
601
602
603
604
605 if sci_ptr ^= null ()
606 then call ssu_$destroy_invocation (sci_ptr);
607 if xmail_data_ptr = null then return;
608 if xmail_data.error_seg_in_pdir & ^condition_signalled then do;
609
610 call adjust_bit_count_ ((get_pdir_()),(ERROR_LOG_SEGMENT), "0"b, bit_count, code);
611 if code = 0 & bit_count > 0 then do;
612 call ioa_ ("^/ Xmail is closing down.");
613 call ioa_ ("^/ An xmail error log was created in your process");
614 call ioa_ (" directory. It will only exist for the duration of your");
615 call ioa_ (" process. If you wish to save the error_messages that were");
616 call ioa_ (" written to the xmail.error segment, you should copy it from");
617 call ioa_ (" your process directory to another directory before");
618 call ioa_ (" you logout.");
619
620 auto_query_info.version = query_info_version_6;
621 auto_query_info.switches.yes_or_no_sw = "0"b;
622 auto_query_info.switches.suppress_name_sw = "1"b;
623 auto_query_info.switches.cp_escape_control = ENABLE_ESCAPE;
624 auto_query_info.switches.suppress_spacing = "1"b;
625 auto_query_info.switches.literal_sw = "0"b;
626 auto_query_info.switches.prompt_after_explanation = "0"b;
627 auto_query_info.switches.padding = "0"b;
628 auto_query_info.status_code = 0;
629 auto_query_info.query_code = 0;
630 auto_query_info.question_iocbp = null ();
631 auto_query_info.answer_iocbp = null ();
632 auto_query_info.repeat_time = 0;
633 auto_query_info.explanation_ptr = null ();
634 auto_query_info.explanation_len = 0;
635
636 been_thru_this_before = "0"b;
637 do while ("1"b);
638 call iox_$control (iox_$user_output, "reset_more", null, (0));
639
640 call command_query_ (addr (auto_query_info), line, "", "^[^/^]^a^2x", been_thru_this_before, prompt);
641 been_thru_this_before = "1"b;
642
643 if line = "" then goto CONTINUE;
644 end;
645 end;
646 end;
647 CONTINUE:
648 if xmail_dir_opened then call xmail_dir_manager_$close_dir ();
649
650 if video_needs_cleanup then do;
651
652
653
654
655 if index (old_modes, FOLD_MODE) > 0
656 then do;
657 call iox_$modes (iox_$user_io, FOLD_MODE, old_modes, code);
658 if code ^= 0 & ^condition_signalled
659 then call com_err_ (code, NAME, "Unable to reset fold mode in bottom window. ^a", INT_ERR);
660 end;
661
662
663
664 call xmail_window_manager_$destroy_windows (condition_signalled);
665 if ^video_was_on then call video_utils_$turn_off_login_channel (0);
666 end;
667
668 if messages_need_cleanup & xmail_data.interactive_msgs then do;
669 if ^condition_signalled
670 then call xmail_im_mgr_$print_messages;
671 call xmail_im_mgr_$restore_original;
672 end;
673
674 if xmail_data.function_key_data_ptr ^= null ()
675 then free xmail_data.function_key_data_ptr -> function_key_data;
676
677 xmail_data_ptr = null;
678
679
680 end CLEANUP;
681
682 end xmail;