1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1989                *
   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 /****^  HISTORY COMMENTS:
  14   1) change(1986-07-11,Rauschelbach), approve(1986-07-11,MCR7450),
  15      audit(1986-08-05,GJohnson), install(1986-08-08,MR12.0-1122):
  16      Changed argument processing to accept short name -dft for -default.
  17   2) change(1986-07-15,Rauschelbach), approve(1986-07-15,MCR7472),
  18      audit(1986-08-05,GJohnson), install(1986-08-08,MR12.0-1122):
  19      Write access checking and error handling were changed to fix an endless
  20      loop.  Argument processing was changed to handle null or zero secondary
  21      arguments.  The expiration_string variable was changed to a based type to
  22      accomodate long date strings. Changed default location of memo segment to
  23      user_info_$homedir, as is documented instead of
  24      static_project>static_person. Non error messages were changed to use ioa_
  25      instead of com_err_. Moved and added initialized of variables to
  26      initialize_memo.
  27   3) change(1986-08-25,Lippard), approve(1986-07-15,PBF7472),
  28      audit(1986-09-10,GWMay), install(1986-09-11,MR12.0-1152):
  29      Fix bug with checking write access.
  30   4) change(1988-09-20,Flegel), approve(1988-12-07,MCR8021),
  31      audit(1988-12-14,Lee), install(1989-01-23,MR12.3-1010):
  32      phx21142 - included "-match" in the option_count calculation so that an
  33                      action_arg is required.
  34   5) change(2016-01-15,Swenson), approve(2016-01-15,MCR10003):
  35      Fix to support 4-character time zone abbreviations.
  36                                                    END HISTORY COMMENTS */
  37 
  38 
  39 memo: procedure () options (variable);
  40 
  41 /* *      This is a command procedure for maintaining a list of memos, with differing maturity dates,
  42    *      and various options for processing.
  43    *
  44    *      Completely rewritten, June, 1979, W. Olin Sibert
  45    *      Changed iox_$order to iox_$control, 2/12/82 R. Holmstedt
  46    */
  47 
  48 dcl  code fixed bin (35);
  49 dcl  nargs fixed bin;           /* Moved out of process_args to global                                        */
  50 dcl  rsp pointer;
  51 dcl  rsl fixed bin (21);
  52 dcl  rs char (rsl) varying based (rsp);
  53 dcl  P_arg_list ptr;        /* for use with the new argument routine cu_$arg_ptr_rel                          */
  54 dcl  P_expiration_string ptr;        /* pointer for based expiration_string                                   */
  55 dcl  L_expiration_string fixed bin (21);    /* length for based expiration_string                             */
  56 dcl  complain entry variable options (variable);
  57 
  58 dcl  temp1 fixed bin;
  59 dcl  idx fixed bin;
  60 dcl  temp_date fixed bin (71);
  61 dcl (month_value, day_of_month, year_value) fixed bin;
  62 dcl  zone_value char (4) aligned;
  63 dcl  fs_mode fixed bin (5);
  64 
  65 
  66 dcl (list_sw, print_sw, delete_sw, postpone_sw) bit (1) aligned;
  67 dcl (set_memo_sw, set_pathname_sw) bit (1) aligned;
  68 dcl (alarm_sw, invisible_sw, call_sw, per_process_sw, repeat_sw,
  69      expires_sw, remains_sw, single_sw, repeat_count_sw) bit (1) aligned;
  70 dcl (mature_sw, immature_sw) bit (1) aligned;
  71 dcl (turn_timer_on_sw, turn_timer_off_sw) bit (1) aligned;
  72 dcl  status_sw bit (1) aligned;
  73 dcl (brief_sw, totals_sw, force_sw) bit (1) aligned;
  74 dcl  process_memos_sw bit (1) aligned;
  75 dcl  select_options_specified_sw bit (1) aligned;
  76 dcl  af_sw bit (1) aligned;
  77 dcl  memo_segment_modified bit (1) aligned;                 /* set if we do something likely to change the bitcount */
  78 dcl (have_read_access, have_write_access) bit (1) aligned;
  79 dcl  complained bit (1) aligned init("0"b);                 /* set if we gave a benign complaint              */
  80 
  81 dcl  default_memo_directory char (64) internal static init("");
  82 dcl  time_now fixed bin (71);
  83 dcl  memo_time_now fixed bin (35);
  84 
  85 dcl 1 term_switch aligned like terminate_file_switches;      /* switches for terminate_file_ functions        */
  86 dcl 1 arg_flags aligned like memo_segment_entry.flags;
  87 dcl 1 set_flags aligned like memo_segment_entry.flags;
  88 dcl 1 select_flags aligned like memo_segment_entry.flags;
  89 
  90 dcl  maturity_time fixed bin (71);
  91 dcl (from_time, to_time) fixed bin (71);
  92 dcl  postpone_time fixed bin (71);
  93 dcl  repeat_string char (32);
  94 dcl  repeat_count fixed bin;
  95 dcl  expiration_string char (L_expiration_string) based (P_expiration_string); /* based to accomodate very long expiration time descriptions */
  96 dcl  expiration_time fixed bin (71);
  97 dcl  expiration_delta fixed bin (35);
  98 
  99 dcl  memo_text char (132) varying;                          /* text of memo to set */
 100 
 101 dcl  dname char (168);
 102 dcl  ename char (32);
 103 
 104 dcl  n_match_strings fixed bin;                             /* number of slots actually used in the array */
 105 dcl  match_string (40) char (32) varying;                   /* strings to match against memo text */
 106 dcl  n_memo_numbers fixed bin;                              /* number of slots used in array */
 107 dcl 1 memo_number (200) aligned,                            /* ranges of memo numbers to list/print/delete/postpone */
 108     2 start fixed bin (17) unaligned,
 109     2 finish fixed bin (17) unaligned;
 110 dcl  n_class_names fixed bin;                               /* number of class names specified */
 111 dcl  class_name (20) char (32);                             /* and the array containing their names */
 112 
 113 dcl  memo_match_count fixed bin;
 114 
 115 dcl  memo_bits (MAX_NUMBER_MEMOS) bit (1) unaligned;
 116 
 117 dcl  static_initialized bit (1) aligned internal static init ("0"b);
 118                                                             /* initialized flag */
 119 dcl  static_pointer pointer internal static init (null ()); /* static pointer to default memo segment */
 120 dcl  static_dname char (168) internal static init ("");     /* pathname of default memo segment */
 121 dcl  static_ename char (32) internal static init ("");      /* pathname of default memo segment */
 122 dcl  static_uid bit (36) aligned internal static init (""b); /* static UID of segment, for validity checking */
 123 dcl  memo_timers_enabled bit (1) aligned internal static init ("0"b);
 124 dcl  memo_invocation_count fixed bin internal static init (0);
 125 dcl  end_of_time fixed bin (71) internal static init (-1);
 126 dcl  end_of_memo_time fixed bin (35) internal static init (-1);
 127 dcl  static_person char (32) varying internal static init ("");
 128 dcl  static_project char (32) varying internal static init ("");
 129 
 130 
 131 dcl  active_fnc_err_ entry options (variable);
 132 dcl  com_err_ entry options (variable);
 133 dcl  command_query_$yes_no entry options (variable);
 134 dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
 135 dcl  convert_date_to_binary_$relative entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35));
 136 dcl  cu_$arg_list_ptr entry (ptr);
 137 dcl  cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr);
 138 dcl  cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr);
 139 dcl  decode_clock_value_ entry (fixed bin (71), fixed bin, fixed bin, fixed bin,
 140      fixed bin (71), fixed bin, char (4) aligned);
 141 dcl  encode_clock_value_ entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
 142      fixed bin (71), fixed bin, char (4) aligned, fixed bin (71), fixed bin (35));
 143 dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
 144 dcl  hcs_$fs_get_mode entry (pointer, fixed bin (5), fixed bin (35));
 145 dcl  hcs_$get_uid_seg entry (pointer, bit (36) aligned, fixed bin (35));
 146 dcl  hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), pointer, fixed bin (35));
 147 dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), pointer, fixed bin (35));
 148 dcl  hcs_$set_bc_seg entry (pointer, fixed bin (24), fixed bin (35));
 149 dcl  ioa_ entry options (variable);
 150 dcl  ioa_$ioa_switch entry options (variable);
 151 dcl  iox_$control entry (ptr, char(*), ptr, fixed bin(35));
 152 dcl  memo_delete_ entry (pointer, fixed bin, bit (1) aligned);
 153 dcl  memo_list_ entry (pointer, fixed bin, bit (*));
 154 dcl  memo_list_$format_time entry (fixed bin (71)) returns (char (40) varying);
 155 dcl  memo_process_memos_ entry (pointer, (*) bit (1) unaligned, fixed bin (35), bit(1) aligned);
 156 dcl  memo_set_ entry (pointer, char (*), bit (36) aligned, fixed bin (35), fixed bin (35), char (*)) returns (fixed bin);
 157 dcl  memo_timer_set_ entry (pointer, entry);
 158 dcl  memo_upgrade_memo_segment_ entry (pointer);
 159 dcl  memo_util_$end_of_time entry () returns (fixed bin (71));
 160 dcl  timer_manager_$reset_alarm_call entry (entry);
 161 dcl  terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35));
 162 dcl  user_info_ entry (char (*), char (*), char (*));
 163 dcl  user_info_$homedir entry (char (*));
 164 
 165 dcl  iox_$user_io pointer external static;
 166 dcl  iox_$error_output pointer external static;
 167 dcl  sys_info$time_correction_constant fixed bin (71) external static;
 168 
 169 dcl (error_table_$badopt,
 170      error_table_$bad_conversion,
 171      error_table_$inconsistent,
 172      error_table_$noarg,
 173      error_table_$noentry,
 174      error_table_$no_r_permission,
 175      error_table_$no_w_permission,
 176      error_table_$not_act_fnc) fixed bin (35) external static;
 177 
 178 dcl  SPACE char (1) aligned init (" ") internal static options (constant);
 179 dcl  WHOAMI char (32) internal static options (constant) init ("memo");
 180 
 181 dcl  (cleanup, conversion, size) condition;
 182 
 183 dcl (null, substr, length, maxlength, binary, min, divide, multiply, ltrim, rtrim, convert, char, clock, hbound, index, string, verify) builtin;
 184 
 185 %page;
 186 
 187 
 188           call initialize_memo ();                          /* set things up */
 189 
 190           memo_segment_modified = "0"b;
 191 
 192           on condition (cleanup) call clean_things_up ();   /* set up to restart the timers */
 193 
 194           memo_invocation_count = memo_invocation_count + 1; /* Remember that there is an active invocation */
 195           call cu_$arg_list_ptr (P_arg_list);
 196 
 197           call process_args ();                             /* find out about our arguments */
 198 
 199           if dname = "" then do;                            /* no pathname explicitly specified, use default. */
 200                call get_default_memo_seg ();
 201                memo_segment_ptr = static_pointer;           /* set our pointer */
 202                end;
 203 
 204           else if set_pathname_sw then do;                  /* otherwise, perhaps set it in static */
 205                static_pointer = null ();                    /* new memo seg */
 206                static_dname = dname;
 207                static_ename = ename;
 208                static_uid = ""b;
 209 
 210                call get_default_memo_seg ();                /* get the new default one */
 211                memo_segment_ptr = static_pointer;
 212                end;
 213 
 214           else do;                                          /* otherwise, just use it for now */
 215                call hcs_$initiate_count (dname, ename, "", 0, 0, memo_segment_ptr, code);
 216                if memo_segment_ptr = null () then do;
 217                     call complain (code, WHOAMI,"^/memo segment ^a>^a does not exist.", dname, ename);
 218                     complained = "1"b;
 219                     goto MAIN_RETURN;
 220                     end;
 221 
 222                /* handling for this temporarily known memo segment must be handled seperately */
 223                call hcs_$fs_get_mode (memo_segment_ptr, fs_mode, code); /* now, see if we have access */
 224                if code ^= 0 then do;                        /* seems unlikely */
 225                   call complain (code, WHOAMI, "^a>^a", dname, ename);
 226                   complained = "1"b;
 227                   goto MAIN_RETURN;
 228                   end;
 229 
 230                if fs_mode = (R_ACCESS_BIN + W_ACCESS_BIN) | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN + W_ACCESS_BIN) then
 231                   have_write_access, have_read_access = "1"b;
 232                else if fs_mode = R_ACCESS_BIN | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN) then
 233                   have_read_access = "1"b;
 234 
 235                if ^have_read_access then do;                          /* sorry, can't do anything at all with it */
 236                   call complain (error_table_$no_r_permission, WHOAMI,
 237 "^/memo segment: ^a>^a", dname, ename);
 238                   complained = "1"b;
 239                   goto MAIN_RETURN;
 240                   end;
 241 
 242                if memo_segment.version ^= MEMO_SEGMENT_VERSION_3 then do;
 243                     call complain (0, WHOAMI, "Memo segment ^a>^a is not compatible with current version of memo.",
 244                          dname, ename);
 245                     complained = "1"b;
 246                     goto MAIN_RETURN;
 247                     end;
 248                end;                                         /* of getting memo segment pointer */
 249 
 250 %page;
 251 
 252           if status_sw then do;                             /* report status of default memo segment */
 253                call ioa_ ("Default memo segment is ^[^a>^a (^p), UID = ^w^;<<Unset>>^]",
 254                     (static_pointer ^= null ()), static_dname, static_ename, static_pointer, static_uid);
 255                if static_pointer ^= null () then
 256                     call ioa_ ("Default memo segment is version ^d, ^d slots max used.",
 257                          static_pointer -> memo_segment.version, static_pointer -> memo_segment.max_number_used);
 258 
 259                call ioa_ ("Memo timers are ^[en^;dis^]abled.", memo_timers_enabled);
 260                complained = "1"b;
 261                goto MAIN_RETURN;                            /* all done, since we know -status was only operation */
 262                end;
 263 
 264 
 265           if process_memos_sw then do;                      /* select the memos, and process them. Selection defaults to */
 266                call select_memos ();                        /* mature, nonalarm memos, if user did not specify otherwise */
 267 
 268                if memo_match_count > 0 then do;
 269                     memo_segment_modified = "1"b;           /* assume this will modify it */
 270                     call memo_process_memos_ (memo_segment_ptr, memo_bits, memo_time_now, have_write_access);
 271                     end;
 272 
 273                else if ^brief_sw then                       /* only print silly message if user wants it, of course */
 274                     call ioa_$ioa_switch (iox_$error_output, "No memos.");
 275                end;                                         /* of case for no explicitly specified options */
 276 
 277 %page;
 278 
 279           else if print_sw then do;                         /* print selected memos */
 280                call select_memos ();
 281 
 282                if memo_match_count = 0 then do;             /* nothing there */
 283 NO_MEMOS_SELECTED:  if ^brief_sw then call ioa_$ioa_switch (iox_$error_output, "No memos selected.");
 284                     complained = "1"b;
 285                     goto MAIN_RETURN;
 286                     end;
 287 
 288                do idx = 1 to memo_segment.max_number_used;
 289                     if memo_bits (idx) = "1"b then do;
 290                          call ioa_ ("^3d)^2x^a", idx, memo_entry (idx).data);
 291                          end;
 292                     end;                                    /* of loop through memos */
 293                end;                                         /* of case for deletion */
 294 
 295 
 296           else if list_sw then do;                          /* produce formatted memo listing */
 297                call select_memos ();
 298 
 299                if (memo_match_count = 0) & ^af_sw then      /* nothing there */
 300                     goto NO_MEMOS_SELECTED;
 301 
 302                if totals_sw then do;                        /* just print (or return) total count */
 303                     if af_sw then rs = ltrim (char (memo_match_count));
 304                     else call ioa_ ("^d memos selected.", memo_match_count);
 305                     end;
 306 
 307                else do idx = 1 to memo_segment.max_number_used;
 308                     if memo_bits (idx) = "1"b then do;
 309                          if af_sw then do;                  /* list as an AF returns a list of memo numbers */
 310                               if length (rs) > 0 then rs = rs || " "; /* separated, natch, by spaces */
 311                               rs = rs || ltrim (char (idx));
 312                               end;                          /* of AF case */
 313                          else call memo_list_ (memo_segment_ptr, idx, ""b);
 314                          end;
 315                     end;                                    /* of loop through memos */
 316                end;                                         /* of case for listing */
 317 
 318 %page;
 319 
 320 
 321           else if delete_sw then do;                        /* delete selected memos */
 322                call select_memos ();                        /* find out about the ones to delete */
 323 
 324                if memo_match_count = 0 then goto NO_MEMOS_SELECTED; /* nothing there */
 325 
 326                if ^have_write_access then do;
 327                     call complain (0, WHOAMI, "Must have w access to ^a>^a to delete memos.", dname, ename);
 328                     goto MAIN_RETURN;
 329                     end;
 330 
 331                memo_segment_modified = "1"b;                /* remember that it has been modified */
 332 
 333                do idx = 1 to memo_segment.max_number_used;  /* loop through them all */
 334                     if memo_bits (idx) = "1"b then do;      /* this one was selected */
 335                          call memo_delete_ (memo_segment_ptr, idx, force_sw);
 336                          end;
 337                     end;                                    /* of loop through memos */
 338                end;                                         /* of case for deletion */
 339 
 340 
 341           else if postpone_sw then do;                      /* postpone some until later */
 342                call select_memos ();
 343 
 344                if memo_match_count = 0 then goto NO_MEMOS_SELECTED; /* nothing there */
 345 
 346                if ^have_write_access then do;
 347                     call complain (0, WHOAMI, "Must have w access to ^a>^a to postpone memos.", dname, ename);
 348                     goto MAIN_RETURN;
 349                     end;
 350 
 351                memo_segment_modified = "1"b;                /* remember that it has been modified */
 352 
 353                do idx = 1 to memo_segment.max_number_used;
 354                     if memo_bits (idx) = "1"b then do;
 355                          memo_entry (idx).time = from_gmt (postpone_time);
 356                          end;
 357                     end;
 358                end;                                         /* of case for postponement */
 359 
 360 %page;
 361 
 362           else if set_memo_sw then do;                      /* we are to set one */
 363                set_flags = arg_flags;                       /* copy flags from whatever was specified earlier */
 364                set_flags.print = "1"b;
 365 
 366                if call_sw then do;
 367                     set_flags.execute = "1"b;
 368                     set_flags.print = "0"b;
 369                     end;
 370 
 371                if invisible_sw then maturity_time = end_of_time; /* kludgy way of indicating invisibility */
 372 
 373                if maturity_time = -1 then maturity_time = time_now;
 374 
 375                if expires_sw then do;                       /* must calculate "expiration delta" here, since there isn't */
 376                     call convert_date_to_binary_$relative   /* room to store the actual string. Thus, values like "1month" */
 377                          (expiration_string, expiration_time, maturity_time, code); /* may behave strangely */
 378 
 379                     if code ^= 0 then do;
 380                          call complain (code, WHOAMI, "Expiration time ^a. Memo not set.", expiration_string);
 381                          complained = "1"b;
 382                          goto MAIN_RETURN;
 383                          end;
 384 
 385                     if expiration_time <= maturity_time then do; /* can't expire before set, dummy. */
 386                          call complain (0, WHOAMI, "Expiration time ^a happens before maturity (^a). Memo not set.",
 387                               expiration_string, memo_list_$format_time (maturity_time));
 388                          complained = "1"b;
 389                          goto MAIN_RETURN;
 390                          end;
 391 
 392                     expiration_delta = divide ((expiration_time - maturity_time), 1000000, 35, 0); /* change to seconds */
 393                     end;
 394 
 395                else expiration_delta = 0;                   /* otherwise, doesn't expire */
 396 
 397                if ^have_write_access then do;
 398                     call complain (0, WHOAMI, "Must have w access to ^a>^a to set a memo. Memo not set.", dname, ename);
 399                     goto MAIN_RETURN;
 400                     end;
 401 
 402                memo_segment_modified = "1"b;
 403 
 404                temp1 = memo_set_ (memo_segment_ptr, (memo_text), string (arg_flags),
 405                     from_gmt (maturity_time), expiration_delta, repeat_string);
 406 
 407                if af_sw then rs = ltrim (char (temp1));     /* return index of memo which just got set */
 408                end;                                         /* of case for setting a memo */
 409 
 410 %page;
 411 
 412           if turn_timer_off_sw then                         /* now, turn timers on and off, and set them */
 413                memo_timers_enabled = "0"b;
 414           if turn_timer_on_sw then
 415                memo_timers_enabled = "1"b;
 416 
 417 MAIN_RETURN:                                                /* all done here */
 418           call clean_things_up ();                          /* turn timers on & clean up, if necessary */
 419 
 420           return;
 421 
 422 %page;
 423 
 424 
 425 memo$alarm_entry: entry ();
 426 
 427 /* *      This entry is invoked by the alarm timer which goes off to make alarm memos work */
 428 
 429           call initialize_memo ();
 430 
 431           complain = com_err_;    /* moved in front of on unit to avoid window                                */
 432 
 433           call hcs_$fs_get_mode (static_pointer, fs_mode, code); /* now, see if we have access */
 434           if code ^= 0 then do;                             /* seems unlikely */
 435              call complain (code, WHOAMI, "^a>^a", dname, ename);
 436              return;
 437              end;
 438 
 439           if fs_mode = (R_ACCESS_BIN + W_ACCESS_BIN) | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN + W_ACCESS_BIN) then
 440              have_write_access = "1"b;
 441 
 442           on condition (cleanup) call clean_things_up ();   /* turn timers back on, etc. */
 443 
 444           memo_invocation_count = memo_invocation_count + 1;
 445 
 446           memo_segment_ptr = static_pointer;
 447           if memo_segment_ptr = null () then do;
 448                call complain (0, WHOAMI, "No memo segment is active. Please type ""memo"" to reset.");
 449                return;
 450                end;
 451 
 452           call select_mature_memos ("1"b);                  /* select all mature alarm memos */
 453 
 454           if memo_match_count > 0 then do;
 455                memo_segment_modified = "1"b;                /* assume it will get modified */
 456                call memo_process_memos_ (memo_segment_ptr, memo_bits, memo_time_now, have_write_access);
 457                end;
 458           else call complain (0, WHOAMI, "Warning: Alarm received with no memos mature.");
 459 
 460           call iox_$control (iox_$user_io, "start", (null ()), (0));
 461 
 462           call clean_things_up ();                          /* exit in an orderly fashion */
 463 
 464           return;                                           /* done with alarm_entry */
 465 
 466 %page;
 467 
 468 select_all_memos: proc ();
 469 
 470 /* *      This procedure selects all existing memos. */
 471 
 472 dcl  idx fixed bin;
 473 
 474           memo_match_count = 0;
 475           string (memo_bits) = ""b;                         /* start out with none */
 476 
 477           do idx = 1 to memo_segment.max_number_used;
 478                if memo_entry (idx).taken ^= ""b then do;
 479                     memo_match_count = memo_match_count + 1;
 480                     memo_bits (idx) = "1"b;
 481                     end;
 482                end;                                         /* of loop through memos */
 483 
 484           return;
 485           end select_all_memos;
 486 
 487 
 488 
 489 select_mature_memos: proc (P_alarm);
 490 
 491 /* *      This procedure selects all the mature memos which are either alarm or non-alarm */
 492 
 493 dcl  P_alarm bit (1) aligned;
 494 
 495 dcl  idx fixed bin;
 496 
 497           memo_match_count = 0;
 498           string (memo_bits) = ""b;                         /* start out with none */
 499 
 500           do idx = 1 to memo_segment.max_number_used;
 501                if memo_entry (idx).taken ^= ""b then
 502                     if memo_entry (idx).flags.alarm = P_alarm then /* perform filtering on alarmedness */
 503                          if memo_entry (idx).time <= memo_time_now then do; /* got one */
 504                               memo_match_count = memo_match_count + 1;
 505                               memo_bits (idx) = "1"b;
 506                               end;
 507                end;                                         /* of loop through memos */
 508 
 509           return;
 510           end select_mature_memos;
 511 
 512 %page;
 513 
 514 select_memos: proc () options (non_quick);
 515 
 516 /* *      This procedure sets bits in the memo_bits array to indicate which memos have been selected.
 517    *      It has knowledge of the type of operation being performed; that is, it behaves differently
 518    *      when printing, listing, deleting, or postponing. */
 519 
 520 dcl  string_match_bits (memo_segment.max_number_used) bit (1) unaligned;
 521 dcl  range_match_bits (memo_segment.max_number_used) bit (1) unaligned;
 522 dcl  type_match_bits (memo_segment.max_number_used) bit (1) unaligned;
 523 dcl  range_match_count (n_memo_numbers) fixed bin;
 524 
 525 dcl  total_string_match_count fixed bin;
 526 dcl (idx, jdx) fixed bin;
 527 dcl  matched bit (1) aligned;
 528 dcl (start, finish) fixed bin;
 529 
 530 
 531           string (string_match_bits) = ""b;                 /* start out with none */
 532           string (range_match_bits) = ""b;
 533           string (type_match_bits) = ""b;
 534           range_match_count (*) = 0;
 535 
 536           if delete_sw | postpone_sw then do;               /* special checking, since otherwise no args would mean "all" */
 537                if n_match_strings = 0 & n_memo_numbers = 0 then do; /* can't delete just "invisible", etc. memos, either. */
 538                     call complain (0, WHOAMI, "At least one memo specifier must be used for deletion or postponement.");
 539                     complained = "1"b;
 540                     goto MAIN_RETURN;
 541                     end;
 542                end;
 543 
 544           if n_memo_numbers = 0 & n_match_strings = 0 & ^select_options_specified_sw then do;
 545                if print_sw | process_memos_sw then          /* mark only the mature ones, if -print or -process specified */
 546                     call select_mature_memos ("0"b);        /* select mature, non-alarm memos */
 547                else call select_all_memos ();               /* select all existing memos */
 548                return;
 549                end;
 550 
 551           if n_match_strings > 0 then do;
 552                total_string_match_count = 0;
 553                do idx = 1 to memo_segment.max_number_used;  /* try to match against strings */
 554                     if memo_entry (idx).taken ^= ""b then do;
 555                          do jdx = 1 to n_match_strings while (^string_match_bits (idx));
 556                               if index (memo_entry (idx).data, match_string (jdx)) > 0 then do;
 557                                    string_match_bits (idx) = "1"b;
 558                                    total_string_match_count = total_string_match_count + 1;
 559                                    end;
 560                               end;
 561                          end;
 562                     end;
 563                end;
 564 
 565           if n_memo_numbers > 0 then do;
 566                do idx = 1 to n_memo_numbers;                /* loop through all the ranges */
 567                     start = min (memo_segment.max_number_used + 1, memo_number (idx).start);
 568                     finish = min (memo_segment.max_number_used, memo_number (idx).finish);
 569                     do jdx = start to finish;
 570                          if memo_entry (jdx).taken ^= ""b then do;
 571                               range_match_bits (jdx) = "1"b;
 572                               range_match_count (idx) = range_match_count (idx) + 1;
 573                               end;
 574                          end;
 575                     end;
 576                end;
 577 
 578           if select_options_specified_sw then do;           /* only select certain types of memos */
 579                select_flags = arg_flags;
 580                if ^invisible_sw & string (select_flags) = ""b then do; /* no explicitly specified options */
 581                     string (select_flags) = "777777777777"b3; /* turn them all on */
 582                     select_flags.pad1 = ""b;                /* except for the padding */
 583                     end;
 584 
 585                do idx = 1 to memo_segment.max_number_used;
 586                     if memo_entry (idx).taken ^= ""b then do;
 587                          matched = "0"b;
 588                          if (string (memo_entry (idx).flags) & string (select_flags)) ^= ""b then
 589                               matched = "1"b;               /* got it by selecting on flags */
 590 
 591                          if from_time ^= -1 then do;        /* see if it's in the right time range */
 592                               matched = "1"b;
 593                               if memo_entry (idx).time >= end_of_memo_time then matched = "0"b; /* discard invisibles */
 594                               else if memo_entry (idx).time < from_gmt (from_time) then matched = "0"b;
 595                               else if memo_entry (idx).time > from_gmt (to_time) then matched = "0"b;
 596                               end;
 597 
 598                          if invisible_sw then               /* kludge mechanism to select invisible memos because it's */
 599                               if memo_entry (idx).time >= end_of_memo_time then /* done by date, rather than having a flag */
 600                                    matched = "1"b;
 601 
 602                          if string_match_bits (idx) then    /* phx21142 - another kludge to pass match strings */
 603                               matched = "1"b;               /* ... as a match is a select_option */
 604 
 605                          type_match_bits (idx) = matched;
 606                          end;
 607                     end;                                    /* of loop through memos */
 608                end;
 609 
 610           if n_memo_numbers > 0 then do;                    /* see if any of the numbers or ranges lost */
 611                do idx = 1 to n_memo_numbers;
 612                     if range_match_count (idx) = 0 then do; /* yup... */
 613                          if memo_number (idx).start = memo_number (idx).finish then
 614                               call complain (0, WHOAMI, "No memos selected by specifier ^d.", memo_number (idx).start);
 615                          else call complain (0, WHOAMI, "No memos selected by range ^d:^d.",
 616                               memo_number (idx).start, memo_number (idx).finish);
 617                          complained = "1"b;
 618                          goto MAIN_RETURN;
 619                          end;
 620                     end;
 621                end;
 622 
 623           if n_memo_numbers > 0 then do;
 624                string (memo_bits) = string (range_match_bits);
 625                if n_match_strings > 0 then
 626                     string (memo_bits) = string (memo_bits) & string (string_match_bits);
 627                if select_options_specified_sw then
 628                     string (memo_bits) = string (memo_bits) & string (type_match_bits);
 629                end;
 630 
 631           else if n_match_strings > 0 then do;
 632                string (memo_bits) = string (string_match_bits);
 633                if select_options_specified_sw then
 634                     string (memo_bits) = string (memo_bits) & string (type_match_bits);
 635                end;
 636 
 637           else string (memo_bits) = string (type_match_bits);
 638 
 639           memo_match_count = 0;
 640           do idx = 1 to memo_segment.max_number_used;       /* now count the total number of matches */
 641                if memo_bits (idx) = "1"b then
 642                     memo_match_count = memo_match_count + 1;
 643                end;
 644 
 645           return;
 646           end select_memos;
 647 
 648 %page;
 649 
 650 process_args: proc ();
 651 
 652 /* *      This procedure processes command arguments for the memo command. */
 653 
 654 dcl  argno fixed bin;
 655 dcl (al, al1) fixed bin (21);
 656 dcl (ap, ap1) pointer;
 657 dcl  arg char (al) based (ap);
 658 dcl  arg1 char (al1) based (ap1);
 659 dcl (n1, n2, n3) fixed bin (35);
 660 dcl (collecting_memo_sw, collecting_numbers_sw) bit (1) aligned;
 661 dcl (action_count, real_action_count, option_count) fixed bin;
 662 dcl  might_set_sw bit (1) aligned;
 663 dcl  answer bit (1) aligned;
 664 dcl  repeat_time fixed bin (71);
 665 
 666 
 667 
 668 
 669           call cu_$af_return_arg_rel (nargs, rsp, rsl, code, P_arg_list);
 670           if code = 0 then do;
 671                af_sw = "1"b;
 672                complain = active_fnc_err_;
 673                rs = "";
 674                end;
 675 
 676           else if code = error_table_$not_act_fnc then do;
 677                af_sw = "0"b;
 678                complain = com_err_;
 679                end;
 680 
 681           else do;
 682                call com_err_ (code, WHOAMI);
 683                complained = "1"b;
 684                goto MAIN_RETURN;
 685                end;
 686 
 687 %page;
 688           might_set_sw = "1"b;                              /* assume memo is gonna get set until we learn otherwise */
 689           collecting_memo_sw = "0"b;                        /* true as soon as we encounter first apparent memo text */
 690           collecting_numbers_sw = "0"b;                     /* true if we are collecting numbers, rather than text. */
 691 
 692 
 693 %page;
 694 
 695 LOOP_THROUGH_ARGUMENTS:
 696 
 697           do argno = 1 to nargs;
 698                call cu_$arg_ptr_rel (argno, ap, al, (0), P_arg_list);
 699                if list_sw | print_sw | postpone_sw | delete_sw | process_memos_sw then do;
 700                     might_set_sw = "0"b;
 701                     collecting_numbers_sw = "1"b;
 702                     end;
 703 
 704                if substr (arg, 1, 1) ^= "-" | collecting_memo_sw then do; /* not a control arg, see what to do */
 705                     if ^collecting_memo_sw & ^collecting_numbers_sw then /* if not numbers, time to start with text */
 706                          collecting_memo_sw = "1"b;
 707 
 708                     if collecting_numbers_sw then do;       /* try it out as a number */
 709                          might_set_sw = "0"b;               /* we're doing some sort of list/print/whatever, so no memo */
 710                          n1 = verify (arg, "0123456789:");  /* is it a number or a range ? */
 711                          if n1 ^= 0 then do;
 712 BAD_MEMO_NUMBER:              code = error_table_$bad_conversion;
 713                               call complain (code, WHOAMI,
 714                                    "Memo number must be a positive integer or a range, not ""^a"".", arg);
 715                               complained = "1"b;
 716                               goto MAIN_RETURN;
 717                               end;
 718 
 719                          n1 = index (arg, ":");             /* get index of range delimiter */
 720                          if n1 = 0 then do;                 /* no colon, just a single integer */
 721                               on conversion, size goto BAD_MEMO_NUMBER;
 722                               n2 = convert (n2, arg);
 723                               revert conversion, size;
 724                               n3 = n2;                      /* range start and end are the same */
 725                               end;
 726 
 727                          else do;                           /* otherwise, it's a range */
 728                               if n1 = 1 | n1 = al then      /* colon at start or end */
 729                                    goto BAD_MEMO_NUMBER;
 730 
 731                               on conversion, size goto BAD_MEMO_NUMBER;
 732                               n2 = convert (n2, substr (arg, 1, n1 -1)); /* start of range */
 733                               n3 = convert (n3, substr (arg, n1 + 1));   /* end of range */
 734                               revert conversion, size;
 735 
 736                               if n3 < n2 then do;           /* can't list 12 through 10, y'know.... */
 737                                    call complain (0, WHOAMI,
 738                                         "The upper bound of a range must be greater than the lower bound: ^a", arg);
 739                                    complained = "1"b;
 740                                    goto MAIN_RETURN;
 741                                    end;
 742                               end;
 743 
 744                          if n2 = 0 then do;     /* null second argument check */
 745                             call complain (0, WHOAMI,
 746 "0 is not an acceptable memo number.");
 747                             complained = "1"b;
 748                             goto MAIN_RETURN;
 749                             end;
 750 
 751                          if n_memo_numbers >= hbound (memo_number, 1) then do;
 752                               call complain (0, WHOAMI, "Too many memo numbers specified. Max is ^d.",
 753                                    hbound (memo_number, 1));
 754                               complained = "1"b;
 755                               goto MAIN_RETURN;
 756                               end;
 757 
 758                          n_memo_numbers = n_memo_numbers + 1; /* remember this one in our list */
 759                          memo_number (n_memo_numbers).start = n2;
 760                          memo_number (n_memo_numbers).finish = n3;
 761                          end;                               /* of case for a number */
 762 
 763                     else if collecting_memo_sw then do;     /* otherwise, add it to the memo text string */
 764                          if al + 1 + length (memo_text) > maxlength (memo_text) then do;
 765                               call complain (0, WHOAMI, "Memo text is too long. Max is ^d characters. Memo not set.",
 766                                    maxlength (memo_text));
 767                               complained = "1"b;
 768                               goto MAIN_RETURN;
 769                               end;
 770 
 771                          if length (memo_text) > 0 then     /* add a space if not first word */
 772                               memo_text = memo_text || SPACE;
 773                          memo_text = memo_text || arg;      /* and add the argument as well */
 774                          might_set_sw = "1"b;               /* all further error messages should say Memo not set */
 775                          set_memo_sw = "1"b;                /* we know we're supposed to set it, now */
 776                          end;                               /* of case for adding memo text */
 777 
 778                     end;                                    /* of case for non control argument */
 779 
 780                else if arg = "-memo" then do;               /* means next arg is memo text */
 781                     if collecting_numbers_sw then do;
 782                          call complain (error_table_$inconsistent, WHOAMI,
 783                               "Memo setting (with -memo) may not be combined with any other operations. Memo not set.");
 784                          complained = "1"b;
 785                          goto MAIN_RETURN;
 786                          end;
 787 
 788                     if argno = nargs then do;
 789                          call complain (error_table_$noarg, WHOAMI, "Some memo text must follow -memo.^2xMemo not set.");
 790                          complained = "1"b;
 791                          goto MAIN_RETURN;
 792                          end;
 793 
 794                     collecting_memo_sw = "1"b;
 795                     end;
 796 
 797                else if arg = "-brief" | arg = "-bf" then brief_sw = "1"b;
 798                else if arg = "-long" | arg = "-lg" then brief_sw = "0"b;
 799                else if arg = "-totals" | arg = "-total" | arg = "-tt" then totals_sw = "1"b;
 800                else if arg = "-on" then turn_timer_on_sw = "1"b;
 801                else if arg = "-off" then turn_timer_off_sw = "1"b;
 802                else if arg = "-force" | arg = "-fc" then force_sw = "1"b;
 803                else if arg = "-status" | arg = "-st" then status_sw = "1"b;
 804 
 805                else if arg = "-invisible" | arg = "-iv" then invisible_sw = "1"b;
 806                else if arg = "-alarm" | arg = "-al" then alarm_sw = "1"b;
 807                else if arg = "-call" then call_sw = "1"b;
 808                else if arg = "-repeat_when_processed" | arg = "-rwp" then per_process_sw = "1"b;
 809                else if arg = "-retain" | arg = "-ret" then remains_sw = "1"b;
 810                else if arg = "-no_retain" | arg = "-nret" then single_sw = "1"b;
 811 
 812                else if arg = "-postpone" | arg = "-pp" then do; /* postpone all the memos specified */
 813                     postpone_time = get_next_date_arg ();   /* get the date to postpone to */
 814 
 815                     collecting_numbers_sw = "1"b;           /* and get ready to collect memo numbers */
 816                     postpone_sw = "1"b;
 817                     end;
 818 
 819                else if arg = "-list" | arg = "-ls" then list_sw = "1"b;
 820                else if arg = "-print" | arg = "-pr" then print_sw = "1"b;
 821                else if arg = "-delete" | arg = "-dl" then delete_sw = "1"b;
 822                else if arg = "-process" then process_memos_sw = "1"b;
 823 
 824                else if arg = "-date" | arg = "-dt" then do; /* midnight of this particular date */
 825                     if maturity_time ^= -1 then do;         /* already have one */
 826 ALREADY_HAVE_DATE:       call complain (0, WHOAMI,
 827                               "Only one value may be specified with -date or -time.^[^2xMemo not set.^]", might_set_sw);
 828                          complained = "1"b;
 829                          goto MAIN_RETURN;
 830                          end;
 831 
 832                     maturity_time = get_next_date_arg ();
 833 
 834                     call decode_clock_value_ (maturity_time, month_value, day_of_month, year_value, (0), (0), zone_value);
 835                     call encode_clock_value_ (month_value,
 836                          day_of_month, year_value, 0, 0, 0, 0, 0, zone_value, maturity_time, code);
 837 
 838                     if code ^= 0 then do;
 839                          call complain (code, WHOAMI, "^a^[.^2xMemo not set.^]", arg, might_set_sw);
 840                          complained = "1"b;
 841                          goto MAIN_RETURN;
 842                          end;
 843                     end;                                    /* of processing for -date */
 844 
 845                else if arg = "-time" | arg = "-tm" then do;
 846                     if maturity_time ^= -1 then goto ALREADY_HAVE_DATE;
 847 
 848                     maturity_time = get_next_date_arg ();
 849                     end;                                    /* of processing for -time */
 850 
 851                else if arg = "-from" | arg = "-fm" then do; /* list memos maturing at or after this time */
 852                     if from_time ^= -1 then do;             /* already have one */
 853                          call complain (0, WHOAMI, "Only one value may be specified for -from.");
 854                          complained = "1"b;
 855                          goto MAIN_RETURN;
 856                          end;
 857 
 858                     from_time = get_next_date_arg ();
 859                     end;                                    /* of processing for -from */
 860 
 861                else if arg = "-to" then do;                 /* list memos maturing at or before this time */
 862                     if to_time ^= -1 then do;               /* already have one */
 863                          call complain (0, WHOAMI, "Only one value may be specified for -to.");
 864                          complained = "1"b;
 865                          goto MAIN_RETURN;
 866                          end;
 867 
 868                     to_time = get_next_date_arg ();
 869                     end;                                    /* of processing for -to */
 870 
 871                else if arg = "-repeat" | arg = "-rp" | arg = "-rpt" then do;
 872                     if repeat_sw then do;                   /* we already have one */
 873                          call complain (0, WHOAMI,
 874                               "Only one value may be specified for -repeat.^[^2xMemo not set.^]", might_set_sw);
 875                          complained = "1"b;
 876                          goto MAIN_RETURN;
 877                          end;
 878 
 879                     repeat_sw = "1"b;                       /* remember that we have a repeat specification */
 880 
 881                     if argno = nargs then                   /* if last argument, and listing, printing, etc., */
 882                          if list_sw | print_sw | postpone_sw | delete_sw then /* accept it as an option specification */
 883                               goto END_ARGUMENT_LOOP;
 884 
 885                     call get_next_string_arg ();            /* puts it in arg1 */
 886 
 887                     if al1 > maxlength (repeat_string) then do; /* too long */
 888                          call complain (0, WHOAMI, "The repeat string may only be ^d characters.^[^2xMemo not set.^]",
 889                               maxlength (repeat_string), might_set_sw);
 890                          complained = "1"b;
 891                          goto MAIN_RETURN;
 892                          end;
 893 
 894                     repeat_string = arg1;
 895                     end;                                    /* of processing for -repeat */
 896 
 897 
 898                else if arg = "-times" then do;              /* limit on how many times we can repeat */
 899                     if "1"b then goto BADOPT;               /* for now, it's unimplemented */
 900                     repeat_count_sw = "1"b;                 /* remember that we have one */
 901 
 902                     if argno = nargs then                   /* if last argument, and listing, printing, etc., */
 903                          if list_sw | print_sw | postpone_sw | delete_sw then /* accept it as an option specification */
 904                               goto END_ARGUMENT_LOOP;
 905 
 906                     call get_next_string_arg ();            /* put it in arg1 */
 907 
 908                     on conversion, size goto BAD_CONVERSION;
 909                     repeat_count = convert (repeat_count, arg1);
 910                     revert conversion, size;
 911 
 912                     if repeat_count < 1 then goto BAD_REPEAT_COUNT; /* must be positive, ninny (code will be zero) */
 913                     end;                                    /* of processing for -times */
 914 
 915                else if arg = "-expires" | arg = "-expire" | arg = "-exp" | arg = "-ex" then do;
 916                     if expires_sw then do;
 917                          call complain (0, WHOAMI,
 918                               "Only one value may be specified for expiration time.^[^2xMemo not set.^], might_set_sw");
 919                          complained = "1"b;
 920                          goto MAIN_RETURN;
 921                          end;
 922 
 923                     expires_sw = "1"b;                      /* remember that we have an expiration specification */
 924 
 925                     if argno = nargs then                   /* if last argument, and listing, printing, etc., */
 926                          if list_sw | print_sw | postpone_sw | delete_sw then /* accept it as an option specification */
 927                               goto END_ARGUMENT_LOOP;
 928 
 929                     call get_next_string_arg ();            /* puts it in arg1 */
 930 
 931                     call convert_date_to_binary_ (arg1, temp_date, code);
 932                     if code ^= 0 then do;
 933                          call complain (code, WHOAMI,
 934                               "^a must be followed by a valid time value not ""^a"".^[^2xMemo not set.^]",
 935                               arg, arg1, might_set_sw);
 936                          complained = "1"b;
 937                          goto MAIN_RETURN;
 938                          end;
 939 
 940                     L_expiration_string = al1;
 941                     P_expiration_string = ap1;
 942                     end;                                    /* of processing for -expires */
 943 
 944                else if arg = "-class" then do;              /* memos in this class or classes */
 945                     if "1"b then goto BADOPT;               /* for now, it's unimplemented */
 946                     call get_next_string_arg ();            /* puts it in arg1 */
 947 
 948                     if al1 > maxlength (class_name (1)) then do; /* too long */
 949                          call complain (0, WHOAMI, "A class name may only be ^d characters.", maxlength (class_name (1)));
 950                          complained = "1"b;
 951                          goto MAIN_RETURN;
 952                          end;
 953 
 954                     if n_class_names >= hbound (class_name, 1) then do;
 955                          call complain (0, WHOAMI, "Too many class names specified. Max is ^d.", hbound (class_name, 1));
 956                          complained = "1"b;
 957                          goto MAIN_RETURN;
 958                          end;
 959 
 960                     n_class_names = n_class_names + 1;
 961                     class_name (n_class_names) = arg1;
 962                     end;                                    /* of processing for -class */
 963 
 964                else if arg = "-match" then do;              /* memos matching this string */
 965                     call get_next_string_arg ();            /* puts it in arg1 */
 966 
 967                     if al1 > maxlength (match_string (1)) then do; /* too long */
 968                          call complain (0, WHOAMI, "The match string may only be ^d characters.",
 969                               maxlength (match_string (1)));
 970                          complained = "1"b;
 971                          goto MAIN_RETURN;
 972                          end;
 973 
 974                     if n_match_strings >= hbound (match_string, 1) then do;
 975                          call complain (0, WHOAMI, "Too many match strings specified. Max is ^d.", hbound (match_string, 1));
 976                          complained = "1"b;
 977                          goto MAIN_RETURN;
 978                          end;
 979 
 980                     n_match_strings = n_match_strings + 1;
 981                     match_string (n_match_strings) = arg1;
 982                     end;                                    /* of processing for -match */
 983 
 984                else if arg = "-path_name" | arg = "-pathname" | arg = "-path" | arg = "-pn" then do;
 985                     if dname ^= "" then do;                 /* already have one */
 986                          call complain (0, WHOAMI, "Only one pathname may be specified.^[^2xMemo not set.^]", might_set_sw);
 987                          complained = "1"b;
 988                          goto MAIN_RETURN;
 989                          end;
 990 
 991                     call get_next_string_arg ();            /* puts it in arg1 */
 992 
 993                     if arg1 = "-default" | arg1 = "-dft" then do; /* construct default pathname */
 994                          call user_info_$homedir (dname);
 995                          ename = static_person || ".memo";
 996                          end;
 997 
 998                     else do;                                /* otherwise, a real pathname */
 999                          call expand_pathname_$add_suffix (arg1, "memo", dname, ename, code);
1000                          if code ^= 0 then do;
1001                               call complain (code, WHOAMI, "^a^[.^2xMemo not set.^]", arg1, might_set_sw);
1002                               complained = "1"b;
1003                               goto MAIN_RETURN;
1004                               end;
1005                          end;
1006                     end;                                    /* of processing for -pathname */
1007 
1008                else do;                                     /* not one of ours, Jack. */
1009 BADOPT:             call complain (error_table_$badopt, WHOAMI, "^a^[.^2xMemo not set.^]", arg, might_set_sw);
1010                     complained = "1"b;
1011                     goto MAIN_RETURN;
1012                     end;
1013 
1014 END_ARGUMENT_LOOP:
1015 end LOOP_THROUGH_ARGUMENTS;
1016 
1017 
1018 %page;
1019 
1020           if (^set_memo_sw) & (maturity_time > 0) & (to_time = -1) & (from_time = -1) then do;
1021                to_time = maturity_time;                     /* Kludge to make memo -print -time 2359.9 work like it */
1022                maturity_time = -1;                          /* used to work. */
1023                end;
1024 
1025           if to_time > 0 & from_time = -1 then              /* to without from, list all from beginning */
1026                from_time = 0;
1027 
1028           if from_time > 0 & to_time = -1 then              /* from without to, list all until the end of time */
1029                to_time = end_of_time;
1030 
1031           action_count = binary (set_memo_sw, 1)
1032                + binary (process_memos_sw, 1)
1033                + binary (postpone_sw, 1)
1034                + binary (delete_sw, 1)
1035                + binary (list_sw, 1)
1036                + binary (print_sw, 1);
1037 
1038           string (arg_flags) = ""b;                         /* copy the flags into a copy of the structure */
1039           arg_flags.repeatsw = repeat_sw;
1040           arg_flags.single = single_sw;
1041           arg_flags.remains = remains_sw;
1042           arg_flags.expires = expires_sw;
1043           arg_flags.execute = call_sw;
1044           arg_flags.alarm = alarm_sw;
1045           arg_flags.per_process = per_process_sw;
1046 
1047           option_count = binary (invisible_sw, 1)           /* whether any memo options were specified */
1048                + binary ((string (arg_flags) ^= ""b), 1)    /* assorted options here */
1049                + binary (mature_sw, 1)
1050                + binary (immature_sw, 1)
1051                + binary ((maturity_time ^= -1), 1)
1052                + binary ((repeat_count ^= -1), 1)
1053                + binary ((from_time ^= -1), 1)
1054                + binary ((n_match_strings ^= 0), 1);        /* MF - phx21142 - -match needs to be included */
1055 
1056           select_options_specified_sw = (option_count > 0); /* flag for use in select_memos */
1057 
1058 /* *      Now check for various illegal combinations. An example is provided for most of these,
1059    *      which illustrates the type of error that might cause the illegal combination. */
1060 
1061           if turn_timer_on_sw & turn_timer_off_sw then      /* memo -on -off */
1062                call inconsistent ("-on and -off.");
1063 
1064           real_action_count = action_count;                 /* to detect those options which may be combined */
1065 
1066           if action_count = 0 & (turn_timer_on_sw | turn_timer_off_sw) then do; /* allow timer to be turned on and off */
1067                if option_count > 0 then                     /* along with other actions, as well as alone */
1068                     call inconsistent ("No memo options may be specified when turning the timers on and off.");
1069                real_action_count = 1;                       /* memo -invisible -off */
1070                end;
1071 
1072           if action_count = 0 & dname ^= "" then do;        /* memo -invisible -pathname >frobboz */
1073                if option_count > 0 then
1074                     call inconsistent ("No memo options may be specified when setting the default pathname.");
1075                set_pathname_sw = "1"b;                      /* we are to set the static pathname */
1076                memo_timers_enabled = "0"b;                  /* turn this off, so switching segs won't blow us out */
1077                real_action_count = 1;                       /* turn it into an "action", so succeeding tests will work */
1078                end;
1079 
1080           if real_action_count = 0 & option_count = 0 then do; /* if no other options specified, we're just to process */
1081                turn_timer_on_sw = "1"b;           /* mature memos and turn on the timers */
1082                process_memos_sw = "1"b;                     /* so indicate that */
1083                end;
1084 
1085           else if real_action_count = 0 then do;            /* nothing specified */
1086                call complain (error_table_$noarg, WHOAMI,   /* memo -invisible */
1087                     "Some action must be specified when memo options are specified.^2xMemo not set.");
1088                complained = "1"b;
1089                goto MAIN_RETURN;
1090                end;                                         /* of case for no explicit actions */
1091 
1092           if repeat_sw then do;                             /* check the repeat time for validity */
1093                call convert_date_to_binary_$relative (repeat_string, repeat_time, time_now, code);
1094                if code ^= 0 then do;
1095                     call complain (code, WHOAMI,
1096                          "-repeat must be followed by a valid time offset, not ""^a"".^[^2xMemo not set.^]",
1097                          repeat_string, set_memo_sw);
1098                     complained = "1"b;
1099                     goto MAIN_RETURN;
1100                     end;
1101 
1102                if repeat_time <= time_now then do;
1103                     call complain (0, WHOAMI, "The repeat string ^a yields a time in the past.^[^2xMemo not set.^]",
1104                          repeat_string, set_memo_sw);
1105                     complained = "1"b;
1106                     goto MAIN_RETURN;
1107                     end;
1108 
1109                if set_memo_sw & ^force_sw & ((repeat_time - time_now) < (60 * 1000000)) then do; /* allow forcing */
1110                                                             /* if setting a memo, not supposed to say -repeat 1second */
1111                     call command_query_$yes_no (answer, 0, WHOAMI, "", /* but give the user a chance anyway */
1112                          "The repeat interval ^a is less than one minute. Do you still wish to use it?", repeat_string);
1113                     if answer = "0"b then do;
1114                          call complain (0, WHOAMI, "Memo not set.");
1115                          complained = "1"b;
1116                          goto MAIN_RETURN;
1117                          end;
1118                     end;
1119                end;                                         /* of testing for -repeat */
1120 
1121 %page;
1122 
1123           if action_count > 1 then call inconsistent        /* memo -delete -print */
1124                ("Only one action (printing, listing, deletion, postponement or memo setting) may be specified.");
1125 
1126           if force_sw & ^(delete_sw | postpone_sw | set_memo_sw) then /* memo -force -list */
1127                call inconsistent ("-force may only be specified with -delete or -postpone.");
1128 
1129           if set_memo_sw & (from_time ^= -1 | mature_sw | immature_sw) then
1130                call inconsistent                            /* memo -from 3days Shoot first, ask questions later. */
1131                     ("The -from, -to, -mature and -immature control arguments may not be combined with memo setting.");
1132 
1133           if af_sw & ^(set_memo_sw | list_sw) then          /* ps [memo -delete 10] */
1134                call inconsistent ("Only memo setting and listing are allowed as an active function.");
1135 
1136           if (from_time ^= -1) & (maturity_time ^= -1) then /* memo -ls -date Monday -from Tuesday */
1137                call inconsistent ("The -from and -to arguments may not be combined with -date or -time.");
1138 
1139           if set_memo_sw & ^alarm_sw & remains_sw then      /* memo -remains Buy new aardvark leash. */
1140                call inconsistent ("-remains may only be used when setting an alarm memo.");
1141 
1142           if set_memo_sw & ^repeat_sw & per_process_sw then /* memo -per_process Check for elephants in the basement. */
1143                call inconsistent ("-repeat_when_processed may only be used when setting a repeating memo.");
1144 
1145           if set_memo_sw & brief_sw then                    /* memo -brief Buy 3 cans of frog propellant tomorrow! */
1146                call inconsistent ("-brief not allowed when setting a memo.");
1147 
1148           if set_memo_sw & (n_memo_numbers > 0 | n_match_strings > 0) then /* memo -match EGGs Win 20 free dance lessons */
1149                call inconsistent ("No memo numbers or match strings may be specified when setting a memo.");
1150 
1151           if set_memo_sw & (n_class_names > 1) then         /* memo -class C1 -class C2 This is a ring 1 multi-class memo */
1152                call inconsistent ("At most one memo class may be specified when setting a memo.");
1153 
1154           if status_sw & nargs > 1 then                     /* This is cheating, but I really want it only for debugging */
1155                call inconsistent ("-status must be the only argument if it is specified.");
1156 
1157           if totals_sw & ^list_sw then                      /* memo -delete -tt */
1158                call inconsistent ("-totals may only be used with -list.");
1159 
1160           return;
1161 
1162 BAD_CONVERSION:          code = error_table_$bad_conversion;
1163 BAD_REPEAT_COUNT:        call complain (code, WHOAMI,
1164                               "-times must be followed by a positive number, not ""^a"".^[^2xMemo not set.^]",
1165                               arg1, might_set_sw);
1166                          complained = "1"b;
1167                          goto MAIN_RETURN;
1168 %page;
1169 
1170 get_next_date_arg: proc () returns (fixed bin (71));
1171 
1172 /* *      This procedure extracts the next argument in the string, and returns it as a clock value */
1173 
1174 dcl  temp_time fixed bin (71);
1175 
1176                if argno = nargs then do;
1177                     call complain (error_table_$noarg, WHOAMI,
1178                          "Date/Time after ^a.^[^2xMemo not set.^]", arg, might_set_sw);
1179                     complained = "1"b;
1180                     goto MAIN_RETURN;
1181                     end;
1182 
1183                argno = argno + 1;
1184                call cu_$arg_ptr_rel (argno, ap1, al1, (0), P_arg_list);
1185 
1186                call convert_date_to_binary_ (arg1, temp_time, code);
1187                if code ^= 0 then do;
1188                     call complain (code, WHOAMI, "^a ^a^[.^2xMemo not set.^]", arg, arg1, might_set_sw);
1189                     complained = "1"b;
1190                     goto MAIN_RETURN;
1191                     end;
1192 
1193                return (temp_time);
1194                end get_next_date_arg;
1195 
1196 
1197 get_next_string_arg: proc ();
1198 
1199 /* *      This procedure extracts the next argument in the string, and returns it as a clock value */
1200 
1201                if argno = nargs then do;
1202                     call complain (error_table_$noarg, WHOAMI, "After ^a.^[^2xMemo not set^]", arg, might_set_sw);
1203                     complained = "1"b;
1204                     goto MAIN_RETURN;
1205                     end;
1206 
1207                argno = argno + 1;
1208                call cu_$arg_ptr_rel (argno, ap1, al1, (0), P_arg_list);
1209 
1210                return;
1211                end get_next_string_arg;
1212 
1213 
1214 
1215 inconsistent: proc (P_message);
1216 
1217 /* *      This procedure just calls complain with the message and punts. */
1218 
1219 dcl  P_message char (*) parameter;
1220 
1221                call complain (error_table_$inconsistent, WHOAMI, "^a^[^2xMemo not set.^]", P_message, set_memo_sw);
1222                complained = "1"b;
1223                goto MAIN_RETURN;
1224 
1225                end inconsistent;
1226 
1227 
1228           end process_args;
1229 
1230 
1231 %page;
1232 
1233 get_default_memo_seg: proc ();
1234 
1235 /* *      This procedure tries to set the static_pointer to point to the right default memo segment */
1236 
1237 dcl  temp_uid bit (36) aligned;
1238 
1239           if static_pointer ^= null () then do;             /* it claims we have one, so let's check.... */
1240                call hcs_$get_uid_seg (static_pointer, temp_uid, code);
1241                if code ^= 0 then do;
1242 MEMO_SEG_ERROR:     call complain (code, WHOAMI, "^a>^a", static_dname, static_ename);
1243                     complained = "1"b;
1244                     goto MAIN_RETURN;
1245                     end;
1246 
1247                if temp_uid ^= static_uid then do;           /* Oh dear. Reused segment number.... */
1248                     call com_err_ (0, WHOAMI, "Warning: ^a>^a has been terminated since last invocation of memo command.",
1249                          static_dname, static_ename);
1250                     static_pointer = null ();               /* flag it as invalid */
1251                     end;
1252                end;
1253 
1254           if static_pointer = null () then do;              /* the segment isn't there. Let's see if we can find it */
1255                if static_dname = "" then do;                /* first call, so set the pathname to the right default. */
1256                     static_dname = default_memo_directory;
1257                     static_ename = static_person || ".memo";
1258                     dname = static_dname;
1259                     ename = static_ename;
1260                     end;
1261 
1262                call hcs_$initiate_count (static_dname, static_ename, "", (0), 0, static_pointer, code);
1263 
1264                if static_pointer = null () & code = error_table_$noentry then do; /* create if not there ? */
1265                     call hcs_$make_seg (static_dname, static_ename, "", R_ACCESS_BIN + W_ACCESS_BIN, static_pointer, code);
1266 
1267                     if static_pointer = null () then goto MEMO_SEG_ERROR; /* couldn't create, give up. */
1268                     else call ioa_ ("^a: Creating ^a>^a.", WHOAMI, static_dname, static_ename);
1269 
1270                     static_pointer -> memo_segment.version = MEMO_SEGMENT_VERSION_3; /* start out right.... */
1271                     end;                                    /* of attempt to create memo segment */
1272 
1273                if static_pointer = null () then             /* still?? we lost, then */
1274                     goto MEMO_SEG_ERROR;
1275 
1276                call hcs_$get_uid_seg (static_pointer, static_uid, code); /* remember its identifier, for good measure */
1277                if code ^= 0 then goto MEMO_SEG_ERROR;
1278                end;                                         /* of nonexistent memo seg case */
1279 
1280           call hcs_$fs_get_mode (static_pointer, fs_mode, code); /* now, see if we have access */
1281           if code ^= 0 then do;                             /* seems unlikely */
1282                call complain (code, WHOAMI, "^a>^a", dname, ename);
1283                complained = "1"b;
1284                goto MAIN_RETURN;
1285                end;
1286 
1287           if fs_mode = (R_ACCESS_BIN + W_ACCESS_BIN) | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN + W_ACCESS_BIN) then
1288                have_write_access, have_read_access = "1"b;
1289           else if fs_mode = R_ACCESS_BIN | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN) then
1290                have_read_access = "1"b;
1291 
1292           if ^have_read_access then do;                     /* sorry, can't do anything at all with it */
1293                call complain (error_table_$no_r_permission, WHOAMI, "
1294 memo segment: ^a>^a", static_dname, static_ename);
1295 
1296                goto MAIN_RETURN;
1297                end;
1298 
1299           if static_pointer -> memo_segment.version < MEMO_SEGMENT_VERSION_3 then /* try to covert */
1300                call memo_upgrade_memo_segment_ (static_pointer); /* before testing again */
1301 
1302           if static_pointer -> memo_segment.version ^= MEMO_SEGMENT_VERSION_3 then do;
1303                call complain (0, WHOAMI, "Memo segment ^a>^a is is not the correct version.", static_dname, static_ename);
1304                complained = "1"b;
1305                goto MAIN_RETURN;
1306                end;
1307 
1308           return;
1309           end get_default_memo_seg;
1310 
1311 %page;
1312 
1313 initialize_memo: proc ();
1314 
1315 /* *      This procedure initializes various variables for an invocation of memo. */
1316 
1317 dcl (person, project) char (32);
1318 
1319           if ^static_initialized then do;
1320                end_of_time = memo_util_$end_of_time ();     /* call and find out */
1321                end_of_memo_time = from_gmt (end_of_time);
1322                call user_info_ (person, project, (""));
1323                static_person = rtrim (person);
1324                static_project = rtrim (project);
1325                call user_info_$homedir (default_memo_directory);
1326                static_initialized = "1"b;
1327                end;
1328 
1329           P_expiration_string = null;
1330           L_expiration_string = 0;
1331           P_arg_list = null;
1332           call timer_manager_$reset_alarm_call (memo$alarm_entry);
1333 
1334           complained = "0"b;
1335           memo_bits (*) = ""b;
1336           time_now = clock ();
1337           memo_time_now = from_gmt (time_now);
1338 /* variable initializations moved here from process_args so they will be initialized from both entry points   */
1339           memo_segment_modified = "0"b;                     /* start out assuming that it wasn't modified */
1340           memo_segment_ptr = null ();                       /* and with a null pointer to it */
1341           memo_text = "";                                   /* the collected text of the memo being set */
1342           n_match_strings, n_memo_numbers = 0;              /* how many match strings/memo numbers have been collected */
1343           n_class_names = 0;                                /* how many memo classes to process */
1344           list_sw, print_sw, delete_sw, postpone_sw = "0"b; /* one per action, other than setting */
1345           process_memos_sw = "0"b;                          /* this is done if nothing else is specified */
1346           set_memo_sw = "0"b;
1347           set_pathname_sw = "0"b;                           /* whether to use the specified pathname permanently */
1348           select_options_specified_sw = "0"b;
1349           maturity_time = -1;                               /* the date we are interested in */
1350           repeat_string = "";                               /* how often to repeat the memo */
1351           repeat_count = -1;                                /* max number of times it gets repeated before exploding */
1352           repeat_sw, expires_sw, remains_sw, single_sw,     /* set if the option in question is to be used */
1353                per_process_sw, alarm_sw, call_sw, repeat_count_sw, invisible_sw = "0"b;
1354           dname, ename = "";                                /* pathname of specified memo segment */
1355           brief_sw = "0"b;                                  /* controls noisiness of messages */
1356           force_sw = "0"b;                                  /* whether or not to force deletion */
1357           totals_sw = "0"b;                                 /* for listing only, print total count rather than memos */
1358           turn_timer_on_sw, turn_timer_off_sw = "0"b;       /* timer control flags */
1359           af_sw = "0"b;
1360           fs_mode = 0;
1361           status_sw = "0"b;                                 /* whether to report status of default memo segment */
1362           from_time, to_time = -1;                          /* time to list from/to */
1363           mature_sw, immature_sw = "0"b;                    /* select only mature/immature memos */
1364           have_write_access = "0"b;
1365           have_read_access = "0"b;
1366           complained ="0"b;
1367           nargs = 0;
1368 
1369           return;
1370           end initialize_memo;
1371 
1372 
1373 
1374 from_gmt: proc (clock_value) returns (fixed bin (35));
1375 
1376 dcl  clock_value fixed bin (71) parameter;
1377 dcl  memo_time fixed bin (35);
1378 
1379           memo_time = divide ((clock_value - sys_info$time_correction_constant), 1000000, 35, 0);
1380 
1381           return (memo_time);
1382           end from_gmt;
1383 
1384 
1385 clean_things_up: proc ();
1386 
1387 /* *      This is the cleanup handler procedure; actually, all it does is turn timers back on if needed. */
1388 dcl  size builtin;
1389 
1390      if static_pointer = null then     /* check if we got here before static variables were set */
1391         return;                        /* if so, no need to clean them up */
1392      if have_write_access | complained then do; /* do we need to clean up the static variables? */
1393           if memo_segment_modified then                     /* set the bitcount, maybe? */
1394                if memo_segment_ptr ^= null () then
1395                     call hcs_$set_bc_seg (memo_segment_ptr, multiply ((size (memo_segment_header)
1396                          + memo_segment.max_number_used * size (memo_segment_entry)), 36, 24, 0), (0));
1397 
1398           memo_invocation_count = memo_invocation_count - 1; /* "unstack" */
1399           if memo_invocation_count < 0 then memo_invocation_count = 0;
1400 
1401           if static_pointer ^= null () then                 /* only if we have one, of course */
1402                if memo_timers_enabled then
1403                     if memo_invocation_count = 0 then       /* Only outermost invocation diddles timers */
1404                          call memo_timer_set_ (static_pointer, memo$alarm_entry);
1405            end;
1406 
1407         else do; /* terminate the file we can't use, and clear the static variables that describe it */
1408            term_switch.truncate = "0"b;
1409            term_switch.set_bc = "0"b;
1410            term_switch.terminate = "1"b;  /* set switch for terminate_file_ to terminate a null reference name*/
1411            term_switch.force_write = "1"b; /* set switch to remove modified memo segment from main memory     */
1412            term_switch.delete = "0"b;
1413            call terminate_file_ (memo_segment_ptr, 0, string (term_switch),
1414               code);
1415            if code ^= 0 then
1416               call complain (code, WHOAMI,
1417 "Unable to terminate memo segment. ^/memo segment: ^a>^a.", dname, ename);
1418            else do;
1419               static_pointer = null;   /* reset static variables                                              */
1420               static_initialized = "0"b;
1421               static_uid = ""b;
1422               memo_timers_enabled = "0"b;
1423               memo_invocation_count = 0;
1424               end_of_time = -1;
1425               end_of_memo_time = -1;
1426               static_person = "";
1427               static_project = "";
1428               if list_sw | print_sw | (list_sw & set_pathname_sw & nargs = 3) | (print_sw & set_pathname_sw & nargs = 3) then;
1429               else
1430                  call complain (error_table_$no_w_permission,WHOAMI,"^a>^a.
1431 Unable to delete or reschedule memos. Memos disabled.",static_dname,static_ename);
1432               static_dname = "";
1433               static_ename = "";
1434               end;
1435            end;
1436         return;
1437         end clean_things_up;
1438 %page; %include memo_segment;
1439 %page; %include access_mode_values;
1440 %page; %include terminate_file;
1441 
1442 
1443           end memo;                                         /* external procedure memo */