


		    PNOTICE_forum.alm               10/27/88  1508.7r w 10/27/88  1508.6        3222


	dec	1			"version 1 structure
	dec	2			"no. of pnotices
	dec	3			"no. of STIs
	dec	119			"lgth of all pnotices + no. of pnotices
          acc       "Copyright (c) 1988 by Massachusetts Institute of Technology"
          acc       "Copyright, (C) Massachusetts Institute of Technology, 1988"

	aci	"C1FRMM0E0000"
	aci	"C2FRMM0E0000"
	aci	"C3FRMM0E0000"
	end
  



		    convert_forum.pl1               10/30/84  1243.8r w 10/30/84  1201.1       16056


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1984 *
   *                                                            *
   ************************************************************** */
convert_forum:
	proc ();

/* Converts version 1 forum to version 2 forum
    Jay Pattin 1/8/83 */

declare	arg			char (arg_len) based (arg_ptr),
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	directory			char (168),
	name			char (32),
	status			fixed bin (35),
	whoami			char (32) static options (constant) init ("convert_forum");

declare	(com_err_, com_err_$suppress_name)
				entry options (variable),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
	expand_pathname_$add_suffix	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_$convert		entry (char (*), char (*), fixed bin (35));

	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
ERR:	     call com_err_ (status, whoami);
	     return;
	end;

	if arg_count = 0 then do;
	     call com_err_$suppress_name (0, whoami, "Usage:  convert_forum meeting_path");
	     return;
	end;

	call cu_$arg_ptr (1, arg_ptr, arg_len, status);
	if status ^= 0 then goto ERR;
	call expand_pathname_$add_suffix (arg, "control", directory, name, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "Finding ""^a"".", arg);
	     return;
	end;

	call forum_$convert (directory, rtrim (name), status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "Converting ""^a"".", arg);
	     return;
	end;

	return;
     end convert_forum;



		    forum.pl1                       08/16/86  1414.1rew 08/16/86  1354.0      139059


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added -tfmt control argument, changed handling of area to make it
     non-extensible.  Use goto request to enter initial meeting.
                                                   END HISTORY COMMENTS */


forum:
     procedure ();

/* Jay Pattin modified from continuum 1/82
   Jay Pattin 03/07/82 added enter_first_trans
   Jay Pattin 9/29/82 added -start_up */

dcl	(substr, addr, codeptr, null, maxlength, min, string)
				builtin;

declare	cleanup			condition;

declare   abbrev_switch		bit (1) aligned,
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	argmap_ptr		ptr,
	first_trans		bit (1) aligned,
	list			bit (1) aligned,
	list_arg			fixed bin,
	profile_dir		char (168),
	profile_entry		char (32),
	profile_ptr		ptr,
	prompt			char (64) varying,
	quit_switch		bit (1) aligned,
	request			char (256),
	request_arg		fixed bin,
	saved_state		fixed bin,
	start_up_switch		bit (1) aligned,
	state			fixed bin,
	status			fixed bin (35);

declare	PROMPT_			fixed bin static options (constant) initial (1),	/* avoid name conflict with ssu_prompt_modes */
	REQUEST_LINE		fixed bin static options (constant) initial (2),
	LINE_LENGTH		fixed bin static options (constant) initial (3),
	MEETING			fixed bin static options (constant) initial (4),
	DONE			fixed bin static options (constant) initial (5),
	PROFILE			fixed bin static options (constant) initial (6),
	LIST			fixed bin static options (constant) initial (7),
	INPUT_LENGTH		fixed bin static options (constant) initial (8),
	OUTPUT_LENGTH		fixed bin static options (constant) initial (9),
	TRAILER_FORMAT		fixed bin static options (constant) init (10),
	whoami			char (32) static options (constant) initial ("forum");

declare	1 auto_area_info		aligned like area_info;
declare	arg			char (arg_len) based (arg_ptr),
	argmap			bit (arg_count) based (argmap_ptr),
	system_free_area		area based (get_system_free_area_ ());

declare	iox_$user_input		ptr external;

declare	(
	forum_request_tables_$user_requests,
	error_table_$bad_arg,
	error_table_$badopt,
	error_table_$bad_conversion,
	error_table_$noarg,
	error_table_$noentry,
	ssu_request_tables_$standard_requests,
	ssu_et_$exec_com_aborted,
	ssu_et_$program_interrupt,
	ssu_et_$request_line_aborted,
	ssu_et_$subsystem_aborted
	)			fixed binary (35) external;

declare	com_err_			entry () options (variable),
	com_err_$suppress_name	entry () options (variable),
	forum_requests_$add_passport	entry (ptr),
	forum_requests_$remove_passport
				entry (ptr),
	forum_requests_$set_forum
				entry (ptr, char (*), fixed bin (35)),
	forum_$close_forum	entry (fixed bin, fixed bin (35)),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	cu_$arg_list_ptr		entry () returns (ptr),
	cu_$arg_ptr		entry (fixed bin, pointer, fixed bin (21), fixed binary (35)),
	cu_$generate_call		entry (entry, ptr),
	cv_dec_check_		entry (char (*), fixed bin (35)) returns (fixed bin (35)),
	expand_pathname_$add_suffix	entry (char(*), char(*), char(*), char(*), fixed bin(35)),
	get_system_free_area_	entry () returns (ptr),
	hcs_$initiate		entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35)),
	requote_string_		entry (char (*)) returns (char (*)),
	ssu_$add_request_table	entry (ptr, ptr, fixed bin, fixed bin (35)),
	ssu_$create_invocation	entry (char (*), char (*), ptr, ptr, char (*), ptr, fixed binary (35)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$execute_line		entry (ptr, ptr, fixed bin (21), fixed bin (35)),
	ssu_$execute_start_up	entry options (variable),
	ssu_$execute_string		entry (ptr, char (*), fixed bin (35)),
	ssu_$get_area		entry (ptr, ptr, char (*), ptr),
	ssu_$listen		entry (ptr, ptr, fixed bin (35)),
	ssu_$print_message		entry options (variable),
	ssu_$record_usage		entry (ptr, ptr, fixed bin (35)),
	ssu_$set_abbrev_info	entry (ptr, ptr, ptr, bit (1) aligned),
	ssu_$set_ec_search_list	entry (ptr, char (32)),
     	ssu_$set_ec_suffix		entry (ptr, char (32)),
	ssu_$set_prompt		entry (ptr, char (64) varying),
	ssu_$set_prompt_mode	entry (ptr, bit (*));
%page;
%include forum_passport;
%page;
%include ssu_prompt_modes;
%page;
%include area_info;
%page;
	passport_info_ptr = null ();
	on cleanup call clean_things_up ();

	first_trans = "0"b;
	start_up_switch = "1"b;
	call allocate_passport ();

	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami);
	     return;
	end;

	allocate argmap in (system_free_area);

	state = MEETING;
	do arg_idx = 1 to arg_count;
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, status);

	     if state = LIST then do;
		if substr (arg, 1, 1) = "-" then goto CTL_ARG;
		list_arg = arg_idx;
		state = saved_state;
	     end;

	     else if state = PROMPT_
	     then do;
		     if arg_len > maxlength (prompt)
		     then call error (0, whoami, "The prompt may be a maximum of ^d characters.",
			     maxlength (prompt));
		     prompt = arg;
		     state = saved_state;
		end;

	     else if state = PROFILE then do;
		     call get_profile (arg);
		     abbrev_switch = "1"b;
		     state = saved_state;
		end;

	     else if state = REQUEST_LINE then do;
		     request_arg = arg_idx;
		     state = saved_state;
		end;

 	     else if state = LINE_LENGTH
	     then do;
		     passport.input_fill_width, passport.output_fill_width = cv_dec_check_ (arg, status);
		     if status ^= 0 then call error (error_table_$bad_conversion, whoami, "^a", arg);
		     state = saved_state;
		end;

	     else if state = INPUT_LENGTH
	     then do;
		     passport.input_fill_width = cv_dec_check_ (arg, status);
		     if status ^= 0 then call error (error_table_$bad_conversion, whoami, "^a", arg);
		     state = saved_state;
		end;

 	     else if state = OUTPUT_LENGTH
	     then do;
		     passport.output_fill_width = cv_dec_check_ (arg, status);
		     if status ^= 0 then call error (error_table_$bad_conversion, whoami, "^a", arg);
		     state = saved_state;
		end;

	     else if state = TRAILER_FORMAT then do;
		if arg = "none" then passport.trailer_format = TFMT_none;
		else if arg = "number" | arg = "nb" then passport.trailer_format = TFMT_number;
		else if arg = "more" then passport.trailer_format = TFMT_more;
		else if arg = "references" | arg = "refs" then passport.trailer_format = TFMT_reference;
		else call error (error_table_$bad_arg, whoami, "Invalid trailer format: ^a.", arg);
		state = saved_state;
	     end;

	     else if substr (arg, 1, min (1, arg_count)) = "-" then
CTL_ARG:		if arg = "-abbrev" | arg = "-ab" then abbrev_switch = "1"b;
		else if arg = "-no_abbrev" | arg = "-nab" then abbrev_switch = "0"b;
		else if arg = "-auto_write" then passport.auto_write = "1"b;
		else if arg = "-no_auto_write" then passport.auto_write = "0"b;
		else if arg = "-brief" | arg = "-bf" then passport.brief_sw = "1"b;
		else if arg = "-list" | arg = "-ls" then do;
		     call want_arg (LIST);
		     list = "1"b;
		end;
		else if arg = "-long" | arg = "-lg" then passport.brief_sw = "0"b;
		else if arg = "-meeting" | arg = "-mtg" then do;
		     if argmap ^= ""b then call error (0, whoami, "Only one meeting may be specified.");
		     call want_arg (MEETING);
		end;
		else if arg = "-no_start_up" | arg = "-ns" | arg = "-nsu" then start_up_switch = "0"b;
		else if arg = "-start_up" | arg = "-su" then start_up_switch = "1"b;
		else if arg = "-profile" | arg = "-pf" then call want_arg (PROFILE);
		else if arg = "-prompt" then call want_arg (PROMPT_);
		else if arg = "-no_prompt" then prompt = "";
		else if arg = "-quit" then quit_switch = "1"b;
		else if arg = "-rq" | arg = "-request" then call want_arg (REQUEST_LINE);
		else if arg = "-ll" | arg = "-line_length" then call want_arg (LINE_LENGTH);
		else if arg = "-ill" | arg = "-input_line_length" then call want_arg (INPUT_LENGTH);
		else if arg = "-oll" | arg = "-output_line_length" then call want_arg (OUTPUT_LENGTH);
		else if arg = "-output_fill" | arg = "-ofi" then passport.print_fill = "1"b;
		else if arg = "-no_output_fill" | arg = "-nof" then passport.print_fill = "0"b;
		else if arg = "-input_fill" | arg = "-ifi" then passport.talk_fill = "1"b;
		else if arg = "-no_input_fill" | arg = "-nif" then passport.talk_fill = "0"b;
		else if arg = "-trailer_format" | arg = "-tfmt" then call want_arg (TRAILER_FORMAT);

		else call error (error_table_$badopt, whoami, "^a", arg);

	     else if state = MEETING
	     then do;
		     substr (argmap, arg_idx, 1) = "1"b;
		     state = DONE;
		end;

	     else do;
		     call com_err_$suppress_name (0, whoami, "Usage:  forum {meeting_name} {-control_args}");
		     return;
		end;
	end;

	if state ^= LIST & state ^= MEETING & state ^= DONE then
	     call error (error_table_$noarg, whoami, "Following ""^a"".", arg);

	if argmap = ""b & list then call error (0, whoami, "-list may not be specified if no meeting_name is given.");
	goto CREATE_SUBSYSTEM;
%page;
forum$enter_first_trans:
     entry (P_forum);

declare	P_forum			char (*);

	first_trans = "1"b;
	start_up_switch = "0"b;

	passport_info_ptr = null ();
	on cleanup call clean_things_up ();

	call allocate_passport ();

CREATE_SUBSYSTEM:
	call ssu_$create_invocation (whoami, forum_data_$version_string, passport_info_ptr,
	     addr (forum_request_tables_$user_requests), forum_data_$info_directory, passport.ssu_ptr, status);
	if status ^= 0 then call error (status, whoami, "Creating subsystem invocation.");

	call ssu_$add_request_table (passport.ssu_ptr, addr (ssu_request_tables_$standard_requests), 2, status);
	if status ^= 0 then call error (status, whoami, "Adding standard request table.");

	call ssu_$record_usage (passport.ssu_ptr, codeptr (forum), (0));

	call ssu_$set_prompt (passport.ssu_ptr, prompt);

	call ssu_$set_prompt_mode (passport.ssu_ptr, PROMPT);
	call ssu_$set_abbrev_info (passport.ssu_ptr, profile_ptr, profile_ptr, abbrev_switch);
	call ssu_$set_ec_suffix (passport.ssu_ptr, "fmec");
	call ssu_$set_ec_search_list (passport.ssu_ptr, "exec_com");

	unspec (auto_area_info) = ""b;
	auto_area_info.version = area_info_version_1;
	auto_area_info.zero_on_free = "1"b;

	call ssu_$get_area (passport.ssu_ptr, addr (auto_area_info), "forum_area", passport.area_ptr);

	if start_up_switch then do;
	     call ssu_$execute_start_up (passport.ssu_ptr, status);
	     if status ^= 0 then
		if status ^= error_table_$noentry & status ^= ssu_et_$exec_com_aborted then do;
		     if status = ssu_et_$subsystem_aborted then goto MAIN_RETURN;
		     else call ssu_$print_message (ssu_ptr, status, "Executing start_up.");
		end;
	end;

	if ^first_trans then do;
	     do arg_idx = 1 to arg_count;
		if substr (argmap, arg_idx, 1) then do;
		     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, (0));
		     request = "goto " || requote_string_ (arg);
		     call ssu_$execute_line (ssu_ptr, addr (request), length (rtrim (request)), status);
		     if status = ssu_et_$request_line_aborted | status = ssu_et_$subsystem_aborted then goto MAIN_RETURN;
		     else if status ^= 0 & status ^= ssu_et_$program_interrupt then
			call error (status, whoami, "Going to the ^a meeting.", arg);
		end;
	     end;
	     free argmap;

	     if list then do;
		if list_arg > 0 then do;
		     call cu_$arg_ptr (list_arg, arg_ptr, arg_len, (0));
		     call ssu_$execute_string (passport.ssu_ptr, "list " || arg, status);
		end;
		else call ssu_$execute_string (passport.ssu_ptr, "list", status);
		if status ^= 0 then
		     if status ^= ssu_et_$request_line_aborted  & status ^= ssu_et_$program_interrupt then
			call error (status, whoami, "Listing transactions.");
	     end;
	     
	     if request_arg > 0 then do;
		call cu_$arg_ptr (request_arg, arg_ptr, arg_len, (0));
		call ssu_$execute_string (passport.ssu_ptr, arg, status);
		if status = ssu_et_$subsystem_aborted then goto MAIN_RETURN;
		if status = ssu_et_$request_line_aborted | status = ssu_et_$program_interrupt then;
		else if status ^= 0 then
		     call error (status, whoami, "Executing initial request.");
	     end;
	end;

	else do;
	     passport.brief_sw = "1"b;
	     call forum_requests_$set_forum (passport_info_ptr, P_forum, status);
	     if status ^= 0 then call error (status, whoami, "Unable to access the ""^a"" meeting.", P_forum);
	     passport.print_message = "0"b;
	     call ssu_$execute_string (passport.ssu_ptr, "talk -sj ""Reason for this meeting""", (0));
	     if passport.unprocessed_trans_ptr = null () then goto MAIN_RETURN;
	end;


	if ^quit_switch then do;
	     call ssu_$listen (passport.ssu_ptr, iox_$user_input, status);
	     if status ^= 0 & status ^= ssu_et_$subsystem_aborted then
		call error (status, whoami, "Unable to call listener.");
	end;

MAIN_RETURN:
	call clean_things_up ();

	return;
%page;
want_arg:
     procedure (new_state);

declare	new_state			fixed bin;

	saved_state = state;
	state = new_state;

	return;

     end want_arg;

get_profile:
     procedure (path);

dcl path				char (*);

	call expand_pathname_$add_suffix (path, "profile", profile_dir, profile_entry, status);
	if status ^= 0 then do;
BAD_PROFILE:
	     call com_err_ (status, whoami, "^a", path);
	     goto MAIN_RETURN;
	end;

	call hcs_$initiate (profile_dir, profile_entry, "", 0, 0, profile_ptr, status);
	if profile_ptr = null () then do;
	     if status = error_table_$noentry then do;
		call com_err_ (status, whoami, "^a>^a does not exist.", profile_dir, profile_entry);
		goto MAIN_RETURN;
	     end;
	     else goto BAD_PROFILE;
	end;
	return;
     end get_profile;
%page;
allocate_passport:
     procedure ();

	abbrev_switch, list, quit_switch = "0"b;
	request_arg, list_arg = 0;
	prompt = "^/forum^[ (^d)^]:^2x";
	argmap_ptr, profile_ptr = null ();

	allocate passport in (system_free_area);
	passport.version = passport_version_2;
	passport.forum_dir = "";
	passport.forum_name = "";
	passport.input_fill_width = 0;
	passport.output_fill_width = 0;
	string (passport.flags) = "0"b;
	passport.talk_fill = "1"b;
	passport.public_channel = 0;
	passport.first_trans_ptr, passport.last_trans_ptr = null ();
	passport.unprocessed_trans_ptr = null ();
	passport.ssu_ptr = null ();
	passport.trailer_format = TFMT_reference;

	call forum_requests_$add_passport (passport_info_ptr);
	return;
     end allocate_passport;
%page;
clean_things_up:
     procedure ();

     if argmap_ptr ^= null () then free argmap;

     if passport_info_ptr ^= null () then do;
	if passport.forum_idx ^= 0 then call forum_$close_forum (passport.forum_idx, (0));
	call forum_requests_$remove_passport (passport_info_ptr);

	if passport.ssu_ptr ^= null () then call ssu_$destroy_invocation (passport.ssu_ptr);
	free passport;
      end;

      return;

     end clean_things_up;


error:
     procedure () options (variable);

	call cu_$generate_call (com_err_, cu_$arg_list_ptr ());

	go to MAIN_RETURN;

     end error;

end forum;
 



		    forum_accept_notifications.pl1  10/31/84  0924.9rew 10/31/84  0924.1       13680


/* ***************************************************************
   *						     *
   *						     *
   * Copyright (c) 1982 by Massachusetts Institute of Technology *
   *						     *
   *						     *
   *************************************************************** */

forum_accept_notifications:
fant:	proc ();

/* Jay Pattin 03/26/82 turns forum notifications on and off */

declare	arg_count			fixed bin,
	status			fixed bin (35);

declare	(com_err_, com_err_$suppress_name)
				entry options (variable),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	forum_$accept_notifications	entry (fixed bin (35)),
	forum_$refuse_notifications	entry (fixed bin (35));

	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, "forum_accept_notifications");
	     return;
	end;

	if arg_count > 0 then do;
	     call com_err_$suppress_name (0, "", "Usage:  fant");
	     return;
	end;

	call forum_$accept_notifications (status);
	if status ^= 0 then call com_err_ (status, "forum_accept_notifications");

	return;

forum_refuse_notifications:
frnt:	entry ();


	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, "forum_refuse_notifications");
	     return;
	end;

	if arg_count > 0 then do;
	     call com_err_$suppress_name (0, "", "Usage:  frnt");
	     return;
	end;

	call forum_$refuse_notifications (status);
	if status ^= 0 then call com_err_ (status, "forum_refuse_notifications");

	return;
     end forum_accept_notifications;



		    forum_add_meeting.pl1           08/16/86  1414.1rew 08/16/86  1354.0      257418


/****^  **************************************************************
        *                                                            *
        * Copyright, (C) Massachusetts Institute of Technology, 1983 *
        *                                                            *
        ************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added -brief and -long to (add remove)_meeting.  Added -cmtg to
     remove_meeting.   Fixed some error messages.
                                                   END HISTORY COMMENTS */


forum_add_meeting:
fam:	proc ();

/* Adds and removes links in the user's forum search list.

   Jay Pattin 6/2/83 */

declare	(P_passport_info_ptr	ptr,
	P_ssu_ptr			ptr)
				parameter;

declare	active_function		bit (1) aligned,
	absolute_path		bit (1) aligned,
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	arg			char (arg_len) based (arg_ptr),
	brief			bit (1) aligned,
	chair			char (32),
	chairman			bit (1) aligned,
	check_switch		bit (1) aligned,
	cleanup_switch		bit (1) aligned,
	cmtg_switch		bit (1) aligned,
	directory			char (168),
	entry_name		bit (1) aligned,
	force			bit (1) aligned,
	forum_name		char (32),
	idx			fixed bin,
	link_dir			char (168),
	no_match			bit (1) aligned,
	path			char (168),
	ret_len			fixed bin (21),
	ret_ptr			ptr,
	ret_string		char (ret_len) based (ret_ptr) varying,
	ssu_ptr			ptr,
	start			fixed bin,
	status			fixed bin (35),
	subsystem			bit (1) aligned,
	type			fixed bin (2),
	update			bit (1) aligned,
	whoami			char (32);

declare	1 sb			aligned like status_branch,
	1 sl			aligned like status_link;
declare	NL			char (1) static options (constant) init ("
");

declare	(addr, after, before, index, ltrim, null, pointer, reverse, rtrim, search, substr, sum)
				builtin;
declare	cleanup			condition;

declare	(error_table_$badopt,
	error_table_$inconsistent,
	error_table_$namedup,
	error_table_$noarg,
	error_table_$no_s_permission,
	error_table_$noentry,
	error_table_$nomatch,
	error_table_$segnamedup,
	forum_et_$no_forum,
	forum_et_$no_such_forum,
	forum_et_$not_eligible)	fixed bin (35) external;

declare	active_fnc_err_		entry options (variable),
	check_star_name_$entry	entry (char (*), fixed bin (35)),
	com_err_			entry options (variable),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin (21)) returns (fixed bin (35)),
	cu_$arg_list_ptr		entry returns (ptr),
	expand_pathname_		entry (char (*), char (*), char (*), fixed bin (35)),
	expand_pathname_$add_suffix	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$get_forum_path	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_$get_forum_path_idx	entry (fixed bin, char (*), char (*), fixed bin (35)),
	forum_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	forum_requests_$open_forum	entry (char (*), fixed bin, char (*), char (*), fixed bin (35)),
	forum_trans_specs_$parse_specs
				entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*),
				ptr),
	forum_trans_util_$read_trans	entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	get_system_free_area_	entry returns (ptr),
	get_wdir_			entry returns (char (168)),
	hcs_$append_link		entry (char (*), char (*), char (*), fixed bin (35)),
	hcs_$chname_file		entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	hcs_$delentry_file		entry (char (*), char (*), fixed bin (35)),
	hcs_$get_link_target	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	hcs_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	hcs_$star_		entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)),
	hcs_$status_		entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)),
	hcs_$status_minf		entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)),
	ioa_			entry options (variable),
	nd_handler_		entry (char (*), char (*), char (*), fixed bin (35)),
	pathname_			entry (char (*), char (*)) returns (char (168)),
	ssu_$abort_line		entry options (variable),
	ssu_$arg_count		entry (ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin (21)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$get_subsystem_and_request_name
				entry (ptr) returns (char (72) var),
	ssu_$print_message		entry options(variable),
	ssu_$return_arg		entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)),
	ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)),
	user_info_$whoami		entry (char (*), char (*), char (*));
%page;
%include status_structures;
%page;
%include star_structures;
%page;
%include forum_passport;
%page;
%include forum_trans_list;
%page;
%include forum_user_trans;
%page;
	subsystem = "0"b;
	whoami = "forum_add_meeting";
	on cleanup call ssu_$destroy_invocation (ssu_ptr);
	call create_subsystem ();

	goto ADD_COMMON;

add_meeting:
	entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	subsystem = "1"b;
	whoami = ssu_$get_subsystem_and_request_name (ssu_ptr);

	forum_trans_list_ptr = null ();
	on cleanup begin;
	     if forum_trans_list_ptr ^= null () then free forum_trans_list;
	end;

	goto ADD_COMMON;

ADD_COMMON:
	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: ^[am {trans_specs}^;fam^] meeting_paths {-control_args}", subsystem);
	status_area_ptr = get_system_free_area_ ();

	link_dir = "";
	brief, cmtg_switch, force, update = "0"b;
	no_match = "1"b;
	start = 1;

	if subsystem then
	     if  passport.forum_idx ^= 0 then do;
		arg_idx = 0;
		parse_flags_word = DISALLOW_MTG | DISALLOW_CMSG | CALL_ON_BAD_ARGS | DEFAULT_TO_NONE;

		call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, args, (0), (""), (""),
		     forum_trans_list_ptr);
		do idx = 1 to forum_trans_list.size;
		     call add_from_trans (forum_trans_list.trans_num (idx));
		end;
		free forum_trans_list;
		if arg_idx = 0 then start = arg_count + 1;
		else start = arg_idx;
	     end;

	do arg_idx = start to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-brief" | arg = "-bf" then brief = "1"b;
		else if subsystem & (arg = "-current_meeting" | arg = "-cmtg") then cmtg_switch = "1"b;
		else if arg = "-directory" | arg = "-dr" then call get_link_dir_arg (arg_idx);
		else if arg = "-force" | arg = "-fc" then force = "1"b;
		else if arg = "-long" | arg = "-lg" then brief = "0"b;
		else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
		else if arg = "-update" | arg = "-ud" then update = "1"b;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;

	if cmtg_switch then do;
	     if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	     path = rtrim (passport.forum_dir) || ">" || no_suffix_name;
	     call add_the_link ();
	end;

	do arg_idx = start to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-directory" | arg = "-dr" then arg_idx = arg_idx + 1;
		else;
	     else do;
		if search (arg, "<>") = 0 & arg_len > 0 then
		     path = pathname_ (get_wdir_ (), arg);
		else path = arg;
		call add_the_link ();
	     end;
	end;

	if update then do;
	     force = "1"b;				/* so it can update not_eligible links */
	     no_match = "1"b;
	     if link_dir = "" then call get_link_dir ("1"b);

	     call update_links ("**.control");
	     call update_links ("**.forum");
	     if ^brief & no_match then call ssu_$print_message (ssu_ptr, 0, "There were no meetings to update.");
	end;
	else if no_match then call ssu_$abort_line (ssu_ptr, 0, "No meeting names were given.");

EGRESS:	if ^subsystem then call ssu_$destroy_invocation (ssu_ptr);
	return;
%page;	
forum_remove_meeting:
frm:
     entry ();

	subsystem = "0"b;
	whoami = "forum_remove_meeting";

	on cleanup call ssu_$destroy_invocation (ssu_ptr);
	call create_subsystem ();

	goto REMOVE_COMMON;

remove_meeting:
	entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	subsystem = "1"b;
	whoami = ssu_$get_subsystem_and_request_name (ssu_ptr);

	goto REMOVE_COMMON;

REMOVE_COMMON:
	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: ^[f^]rm meeting_names {-control_args}", ^subsystem);

	brief, check_switch, cleanup_switch, cmtg_switch, update = "0"b;
	status_area_ptr = get_system_free_area_ ();
	link_dir = "";

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-brief" | arg = "-bf" then brief = "1"b;
		else if arg = "-check" | arg = "-ck" then check_switch = "1"b;
		else if arg = "-cleanup" then cleanup_switch = "1"b;
		else if subsystem & (arg = "-current_meeting" | arg = "-cmtg") then cmtg_switch = "1"b;
		else if arg = "-directory" | arg = "-dr" then call get_link_dir_arg (arg_idx);
		else if arg = "-long" | arg = "-lg" then brief = "0"b;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;

	if link_dir = "" then call get_link_dir ("0"b);
	if cmtg_switch then do;
	     if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	     forum_name = passport.forum_name;
	     call remove_link ("1"b);
	end;

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-directory" | arg = "-dr" then arg_idx = arg_idx + 1;
		else;
	     else do;
		if search (arg, "<>") > 0 then
		     call ssu_$abort_line (ssu_ptr, 0, "Meeting names may not contain "">"" or ""<"". ^a""", arg);

		call expand_pathname_$add_suffix (arg, "forum", "", forum_name, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Expanding ^a.", arg);

		call check_star_name_$entry (arg, status);
		if status = 0 then call remove_link ("0"b);
		else if (status = 1) | (status = 2) then call remove_links ("0"b);
		else call ssu_$abort_line (ssu_ptr, status, "^a", arg);
	     end;
	end;

	if check_switch & cleanup_switch then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-check"" and ""-cleanup""");

	if check_switch | cleanup_switch then call remove_links ("1"b);

	goto EGRESS;
%page;
create_subsystem:
     procedure ();

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, status);
	if status ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (status, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (status, whoami, "Unable to create subsystem invocation.");
	     goto EGRESS;
	end;

	return;
     end create_subsystem;


punt:
     proc ();

	goto EGRESS;

	end punt;

args:
     proc (P_arg_idx);

declare	P_arg_idx			fixed bin;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if index (arg, "-") = 1 then
	     if arg = "-brief" | arg = "-bf" then brief = "1"b;
	     else if (arg = "-current_meeting" | arg = "-cmtg") then cmtg_switch = "1"b;
	     else if arg = "-directory" | arg = "-dr" then call get_link_dir_arg (P_arg_idx);
	     else if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-long" | arg = "-lg" then brief = "0"b;
	     else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
	     else if arg = "-update" | arg = "-ud" then update = "1"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	else do;
	     arg_idx = P_arg_idx;
	     P_arg_idx = arg_count + 1;
	end;

	return;
     end args;
%page;
get_link_dir:
     proc (create_switch);

declare	create_switch		bit (1) aligned,
	home_dir			char (40),
     	person			char (22),
	project			char (9);

	call user_info_$whoami (person, project, "");
	home_dir = ">udd>" || rtrim (project) || ">" || person;
	call hcs_$status_minf (home_dir, "meetings", 1, type, (0), status);

	if status = error_table_$noentry then do;	/* no meetings dir - create a link pointing at homedir */
	     if ^create_switch then
		call ssu_$abort_line (ssu_ptr, 0, "^a>meetings not found. There are no meetings to remove.",
		     home_dir);
	     call ssu_$print_message (ssu_ptr, 0, "Creating ^a>meetings.", home_dir);
	     call hcs_$append_link (home_dir, "meetings", home_dir, status);
	     if status ^= 0 then
		call ssu_$abort_line (ssu_ptr, status, "Unable to create meeting directory.");
	end;
	else if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Unable to access meeting directory.");
	else if type ^= Directory then
	     call ssu_$abort_line (ssu_ptr, 0, "^a>meetings is not a directory.", home_dir);

	link_dir = rtrim (home_dir) || ">meetings";

	return;
     end get_link_dir;


get_link_dir_arg:
     proc (P_arg_idx);

declare	name			char (32);
declare	P_arg_idx			fixed bin;

	if P_arg_idx = arg_count then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following -directory");
	P_arg_idx = P_arg_idx + 1;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	call expand_pathname_ (arg, link_dir, name, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);

	call hcs_$status_minf (link_dir, name, 1, type, (0), status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);
	if type ^= Directory then call ssu_$abort_line (ssu_ptr, 0, "^a is not a directory.", arg);

	link_dir = pathname_ (link_dir, name);
	return;
     end get_link_dir_arg;
%page;
dissect_trans:
     proc (trans_idx, dir, name, chairman, error_proc);

declare	trans_idx			fixed bin parameter,
	(dir, name, chairman)	char (*) parameter,
	error_proc		entry variable options (variable) parameter,
	(idx, jdx)		fixed bin;

	call forum_trans_util_$read_trans (passport_info_ptr, 0, trans_idx, forum_user_trans_ptr, status);
	if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Reading transaction ^d.", trans_idx);

	if index (forum_user_trans.subject,  " meeting") = 0 then do;
BAD:	     call error_proc (ssu_ptr, 0, "Transaction ^d is not a meeting announcement.", trans_idx);
	     dir = "";				/* for error return */
	     return;
	end;

	name = reverse (after (reverse (forum_user_trans.subject), "gniteem "));

	idx = index (forum_user_trans.text, "Location:	") + 10;
	if idx = 10 then goto BAD;
	jdx = index (substr (forum_user_trans.text, idx), NL) - 1;
	dir = substr (forum_user_trans.text, idx, jdx);

	idx = index (forum_user_trans.text, "Chairman:	") + 10;
	if idx = 10 then goto BAD;
	jdx = index (substr (forum_user_trans.text, idx), NL) - 1;
	chairman = substr (forum_user_trans.text, idx, jdx);

	return;
     end dissect_trans;

add_from_trans:
     proc (trans_idx);

declare	trans_idx			fixed bin,
	name			char (32),
	dir			char (168),
	chairman			char (32);

	call dissect_trans (trans_idx, dir, name, chairman, ssu_$print_message);
	if dir = "" then return;

	path = pathname_ (dir, name);
	call add_the_link ();

	return;
     end add_from_trans;
%page;
add_the_link:
     proc ();

declare	forum_idx			fixed bin,
	idx			fixed bin,
	link_path			char (168),
	(uid1, uid2)		bit (36) aligned;

	no_match = "0"b;
	forum_idx = 0;
	if link_dir = "" then call get_link_dir ("1"b);

	on cleanup call forum_$close_forum (forum_idx, 0);

     	call forum_requests_$open_forum (path, forum_idx, "", "", status);
	if status ^= 0 then
	     if force & status = forum_et_$not_eligible then do;
		call forum_requests_$find_forum (path, directory, forum_name, (0), (0));
		call forum_$get_forum_path ((directory), (forum_name), directory, forum_name, status);
	     end;
	     else do;
		call ssu_$print_message (ssu_ptr, status, "Locating ^a.", path);
		return;
	     end;
	else call forum_$get_forum_path_idx (forum_idx, directory, forum_name, status);

	if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Getting names for ^a.", path);
	if forum_idx ^= 0 then call forum_$close_forum (forum_idx, 0);

     	link_path = pathname_ (directory, forum_name);
RETRY_ADD_LINK:
	call hcs_$append_link (link_dir, forum_name, link_path, status);
	if status ^= 0 then
	     if status = error_table_$namedup then do;
		uid2 = "0"b;
		call forum_$get_uid_file (directory, forum_name, uid1, status);
		if status ^= 0 then do;
BAD_DUP:		     call ssu_$print_message (ssu_ptr, 0, "A^[nother^] meeting named ^a is already in the meeting directory.",
			(uid2 ^= ""b), forum_name);
		     return;
		end;

		call forum_$get_uid_file (link_dir, forum_name, uid2, status);
		if status ^= 0 then do;
		     if status ^= forum_et_$no_such_forum then goto BAD_DUP;
		     if ^brief then call ssu_$print_message (ssu_ptr, 0, "Replacing null link to ^a.", forum_name);
		     call hcs_$delentry_file (link_dir, forum_name, status);
		     if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to delete null link.");
		     goto RETRY_ADD_LINK;
		end;
		else if uid1 ^= uid2 then goto BAD_DUP;

		call hcs_$status_minf (link_dir, forum_name, 0, type, (0), status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to get status information for ^a.",
		     forum_name);
		if type = Directory then do;
		     if ^brief then
			call ssu_$print_message (ssu_ptr, 0,
			     "The ^a meeting is in the meetings directory. No link created.", forum_name);
		     return;
		end;
		
		if ^brief then call ssu_$print_message (ssu_ptr, 0, "^a is already in the meeting directory.  Link will be updated.",
		     forum_name);
		call hcs_$delentry_file (link_dir, forum_name, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to delete old link.");
		goto RETRY_ADD_LINK;
	     end;
	     else do;
		call ssu_$print_message (ssu_ptr, status, "Unable to create link to ^a.", link_path);
		return;
	     end;

	status_ptr = addr (sb);
	sb.names_relp = ""b;

	on cleanup begin;
	     if sb.names_relp ^= ""b then free status_entry_names;
	end;

	call hcs_$status_ (directory, forum_name, 0, status_ptr, status_area_ptr, status);
	if status ^= 0 then do;
	     call ssu_$print_message (ssu_ptr, status, "Unable to add additional names to the link for ^a.", path);
	     return;
	end;

	if status_branch.nnames < 1 then do;
	     call ssu_$print_message (ssu_ptr, 0, "Unable to obtain names for ^a.", path);
	     return;
	end;

SET_PRIMARY:
	call hcs_$chname_file (link_dir, forum_name, forum_name, (status_entry_names (1)), status);
	if check_code (1) then goto SET_PRIMARY;

	do idx = 2 to status_branch.nnames;
AGAIN:	     call hcs_$chname_file (link_dir, (status_entry_names (1)), "", (status_entry_names (idx)), status);
	     if check_code (idx) then goto AGAIN;
	end;
	     
	free status_entry_names;

	return;
     end add_the_link;

check_code:
    procedure (idx) returns (bit (1) aligned);

declare	idx			fixed bin;

	if status ^= 0 then
	     if status = error_table_$segnamedup then;
	     else if status = error_table_$namedup then do;
		call nd_handler_ (whoami, link_dir, (status_entry_names (idx)), status);
		if status = 0 then return ("1"b);
	     end;
	     else call ssu_$print_message (ssu_ptr, status, "Unable to add name ^a to ^a>^a.",
		status_entry_names (idx), link_dir, forum_name);
	return ("0"b);
     end check_code;
%page;
remove_link:
     proc (cmtg);

declare	cmtg			bit (1) aligned;

	call hcs_$status_minf (link_dir, forum_name, 0, type, (0), status);
	if status = error_table_$noentry then do;
	     if cmtg then
		call ssu_$abort_line (ssu_ptr, 0, "The current meeting is not in the meeting directory.");

	     call expand_pathname_$add_suffix (arg, "control", "", forum_name, status);
	     if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Expanding ^a.", arg);
	     call hcs_$status_minf (link_dir, forum_name, 0, type, (0), status);
	end;

	if status = error_table_$noentry then
	     call ssu_$abort_line (ssu_ptr, 0, "The ^a meeting is not in the meeting directory.", arg);
	else if type ^= Link then
	     call ssu_$abort_line (ssu_ptr, 0, "The ^a meeting itself is in the meeting directory.^/^-This command does not delete meetings.", arg);

	call hcs_$delentry_file (link_dir, forum_name, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to remove the ^a meeting.", arg);

	return;
     end remove_link;
%page;
remove_links:
     proc (null_switch);

declare	null_switch		bit (1) aligned;

	star_names_ptr, star_entry_ptr = null ();
	on cleanup begin;
	     if star_names_ptr ^= null () then free star_names;
	     if star_entry_ptr ^= null () then free star_entries;
	end;

	no_match = "1"b;				/* Until proven otherwise */

	if null_switch then forum_name = "**.forum";
	call do_the_work ();

	if null_switch then forum_name = "**.control";
	else call expand_pathname_$add_suffix (arg, "control", "", forum_name, status);
	call do_the_work ();

	if no_match & ^brief then
	     if null_switch then call ssu_$print_message (ssu_ptr, 0, "There were no meetings to clean up.");
	     else call ssu_$print_message (ssu_ptr, error_table_$nomatch, "^a", arg);

	return;

do_the_work:
	proc ();

declare	name			char (32);

	call hcs_$star_ (link_dir, forum_name, star_LINKS_ONLY, status_area_ptr, star_entry_count, star_entry_ptr,
	     star_names_ptr, status);
	if status ^= 0 then
	     if status = error_table_$nomatch then return;
	     else call ssu_$abort_line (ssu_ptr, status, "Finding matching names for ^a.", forum_name);

	do idx = 1 to star_entry_count;
	     name = star_names (star_entries.nindex (idx));
	     if null_switch then do;
		call hcs_$status_minf (link_dir, name, 1, type, (0), status);
		if type ^= Link & status = 0 then goto SKIP;
		no_match = "0"b;			/* We found one. */

		if check_switch then do;
		     call ioa_ ("The ^a meeting would be removed.", reverse (after (reverse (name), ".")));
		     goto SKIP;
		end;
		call ioa_ ("Removing the ^a meeting.", reverse (after (reverse (name), ".")));
	     end;
	    
	     call hcs_$delentry_file (link_dir, name, status);
	     if status ^= 0 then
		call ssu_$print_message (ssu_ptr, status, "Unable to remove the ^a meeting.",
		     reverse (after (reverse (name), ".")));
SKIP:	end;

	free star_names;
	free star_entries;
	return;

     end do_the_work;

     end remove_links;

update_links:
	proc (forum_name);

declare	forum_name		char (32);

	star_names_ptr, star_entry_ptr = null ();
	on cleanup begin;
 	     if star_names_ptr ^= null () then free star_names;
	     if star_entry_ptr ^= null () then free star_entries;
	end;

	call hcs_$star_ (link_dir, forum_name, star_LINKS_ONLY, status_area_ptr, star_entry_count, star_entry_ptr,
	     star_names_ptr, status);
	if status ^= 0 then
	     if status = error_table_$nomatch then;
	     else call ssu_$abort_line (ssu_ptr, status, "Listing old meetings.");

	do idx = 1 to star_entry_count;
	     call check_updated (star_names (star_entries.nindex (idx)));
	end;

	if star_names_ptr ^= null () then free star_names;
	if star_entry_ptr ^= null () then free star_entries;

	return;


check_updated:
     proc (name);

declare	name			char (32),
	name_idx			fixed bin,
	new_name			char (32),
	old_names			bit (1) aligned,
	target_dir		char (168),
	target_exists		bit (1) aligned,
	target_name		char (32),
	(uid1, uid2)		bit (36) aligned;

declare	status_link_names		(sl.nnames) char (32) aligned
				based (pointer (status_area_ptr, sl.names_relp)),
	status_pathname		char (sl.pathname_length) based
				(pointer (status_area_ptr, sl.pathname_relp));

	sl.names_relp, sl.pathname_relp = ""b;
	on cleanup begin;
	     if sl.pathname_relp ^= ""b then free status_pathname;
	     if sl.names_relp ^= ""b then free status_link_names;
	end;
	status_ptr = addr (sl);

	call hcs_$status_ (link_dir, name, 0, status_ptr, status_area_ptr, status);
	if status ^= 0 then goto SKIP;

	call hcs_$get_link_target (link_dir, name, target_dir, target_name, status);
	if status = 0 then target_exists = "1"b;
	else if status = error_table_$noentry then target_exists = "0"b;
	else goto SKIP;

	if ltrim (before (reverse (target_name), ".")) = "murof" then do;
	     if target_exists then goto CHECK_SHORTEN;
	     goto SKIP;
	end;

	target_name = reverse (after (reverse (target_name), ".")) || ".forum";
	call hcs_$status_minf (target_dir, target_name, 0, (0), (0), status);
	if status = 0 then do;			/* meeting has been converted */
	     path = pathname_ (target_dir, target_name);
	     call add_the_link ();
	     call hcs_$delentry_file (link_dir, name, (0));
	     call ioa_ ("Updated the ^a meeting.", reverse (after (reverse (name), ".")));
	     no_match, old_names = "0"b;
	end;
	else if target_exists then do;
CHECK_SHORTEN:
	     call expand_pathname_ (target_dir, path, target_name, status);
	     if status ^= 0 then goto SKIP;
	     call hcs_$get_uid_file (path, target_name, uid1, status);
	     if status ^= 0 then goto SKIP;

	     call expand_pathname_ ((status_pathname), path, target_name, status);
	     if status ^= 0 then goto SKIP;
	     call expand_pathname_ (path, path, target_name, status);
	     if status ^= 0 then goto SKIP;
	     call hcs_$get_uid_file (path, target_name, uid2, status);
	     if status ^= 0 then goto SKIP;

	     if uid1 = uid2 then goto SKIP;
	     old_names = "1"b;
	     no_match = "0"b;

	     call hcs_$delentry_file (link_dir, name, status);
	     if status ^= 0 then goto SKIP;

	     path = pathname_ (target_dir, name);
	     call hcs_$append_link (link_dir, name, path, status);
	     if status ^= 0 then goto SKIP;

	     call ioa_ ("Shortened link path for ^a.", name);
	     target_name = name;
	end;
	else goto SKIP;

	do name_idx = 1 to sl.nnames;
	     new_name = status_link_names (name_idx);
	     if ^old_names then new_name = reverse (after (reverse (new_name), ".")) || ".forum";
RETRY:	     call hcs_$chname_file (link_dir, target_name, "", new_name, status);
	     if check_code (name_idx) then goto RETRY;
	end;

SKIP:	if sl.names_relp ^= ""b then free status_link_names;
	if sl.pathname_relp ^= ""b then free status_pathname;
	revert cleanup;

	return;
     end check_updated;

     end update_links;
%page;
announcement_info:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	forum_idx = passport.forum_idx;
	chairman, absolute_path, entry_name = "0"b;

	forum_trans_list_ptr = null ();
	on cleanup begin;
	     if forum_trans_list_ptr ^= null () then free forum_trans_list;
	end;

	call ssu_$return_arg (ssu_ptr, arg_count, active_function, ret_ptr, ret_len);

	parse_flags_word = ONLY_ONE | DISALLOW_MTG | DISALLOW_REV | DISALLOW_INITIAL | DISALLOW_CMSG |
	     DISALLOW_BYCHAIN;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, announce_args, (0), (""),
	     (""), forum_trans_list_ptr);

	call dissect_trans (forum_trans_list.trans_num (1), directory, forum_name, chair, ssu_$abort_line);
	free forum_trans_list;

	if active_function then do;
	     if ^(chairman | entry_name | absolute_path) then
USAGE:		call ssu_$abort_line (ssu_ptr, 0, "Usage:  [ai -control_arg]");

	     if (chairman & entry_name) | (chairman & absolute_path) | (absolute_path & entry_name) then
		goto USAGE;

	     if chairman then ret_string = chair;
	     else if entry_name then ret_string = forum_name;
	     else ret_string = pathname_ (directory, forum_name);
	end;
	else do;
	     if ^(chairman | entry_name | absolute_path) then
		chairman, entry_name, absolute_path = "1"b;
	     if absolute_path then call ioa_ ("The meeting path is ^a.", pathname_ (directory, forum_name));
	     else if entry_name then call ioa_ ("The name of the meeting is ^a.", forum_name);
	     if chairman then call ioa_ ("The chairman is ^a.", chair);
	end;

	return;

announce_args:
     procedure (P_arg_idx);
declare	P_arg_idx			fixed bin parameter;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if arg = "-absolute_pathname" | arg = "-absp" then absolute_path = "1"b;
	else if arg = "-chairman" | arg = "-cm" then chairman = "1"b;
	else if arg = "-entry_name" | arg = "-etnm" then entry_name = "1"b;
	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);

	return;
     end announce_args;

end forum_add_meeting;
  



		    forum_add_participant.pl1       08/16/86  1414.1r w 08/16/86  1354.6      110214


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1984 *
   *                                                            *
   ************************************************************** */

forum_add_participant:
fapt:
     proc;

/* v2 support for v1 access control commands/requests
   removed from v1 forum_create 7/13/83 Jay Pattin
   added v2 xobj hacking 4/15/84 Jay Pattin */

declare	ioa_			entry options (variable),
	com_err_			entry options (variable),
	com_err_$suppress_name	entry options (variable),
	active_fnc_err_		entry options (variable),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin(21)) returns (fixed bin (35)),
	cu_$arg_count		entry (fixed bin),
	cu_$arg_list_ptr		entry returns (ptr),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),

	forum_$open_forum		entry (char (*), char (*), fixed bin, fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$set_switch_idx	entry (fixed bin, char (*), char (*), bit (1) aligned, fixed bin (35)),
	forum_$delete_forum		entry (char (*), char (*), fixed bin (35)),
	forum_$set_forum_acl	entry (char(*), char(*), ptr, fixed bin, fixed bin (35)),
	forum_$set_v1_forum_acl	entry (fixed bin, char (*), bit (1) aligned, bit (1) aligned, bit (1) aligned,
				fixed bin (35)),
	ssu_$abort_line		entry options (variable),
	ssu_$arg_count		entry (ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin(21)),
	ssu_$return_arg		entry (ptr, fixed bin, bit(1) aligned, ptr, fixed bin(21)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$standalone_invocation	entry (ptr, char(*), char(*), ptr, entry, fixed bin(35));

declare	(P_ssu_ptr, P_passport_info_ptr)
				ptr parameter;

declare	code			fixed bin (35),
	arg_idx			fixed bin,
	whoami			char (32),
	forum_name		char (168),
	full_forum_name		char (32),
	forum_no			fixed bin,
	ssu_ptr			ptr,
	subsystem_entry		bit (1) aligned,
	forum_directory		char (168),
	name_len			fixed bin,
	person_id			char (22),
	argp			ptr,
	argl			fixed bin (21),
	argument			char (argl) based (argp),
	nargs			fixed bin,
	chairman			bit (1) aligned init (""b),
	public_switch		bit (1) aligned init (""b),
	person_switch		bit (1) aligned init (""b),
	read_only			bit (1) aligned init (""b),
	add_switch		bit (1) aligned,
	v2			bit (1) aligned,
	cleanup			condition,
	(index, null, substr)	builtin;

declare	1 acl			aligned,
	2 access_name		char (32),
	2 modes			bit (36) aligned,
	2 xmodes			bit (36) aligned,
	2 code			fixed bin (35);

declare	(RWC_XACL			init ("111"b),
	 RW_XACL			init ("110"b),
	 R_XACL			init ("100"b))
				bit (36) static aligned options (constant);

declare	(forum_et_$no_forum,
	forum_et_$no_such_user,
	error_table_$not_act_fnc,
	error_table_$inconsistent,
	error_table_$badopt)	external fixed binary (35);
%page;
%include forum_passport;
%page;
%include access_mode_values;
%page;
	whoami = "forum_add_participant";
	call create_subsystem ();
	if nargs < 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fapt meeting_name person_id {-control_arg}");
	person_switch, add_switch = "1"b;
	goto common;

forum_add_participant$add_participant:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "add_participant";
	call setup_request ();
	if nargs < 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: apt person_id {-control_arg}");
	person_switch, add_switch = "1"b;

common:
	forum_no = 0;
	chairman, read_only = ""b;

	on cleanup begin;
	     if ^subsystem_entry then do;
		call forum_$close_forum (forum_no, (0));
		call ssu_$destroy_invocation (ssu_ptr);
	     end;
	end;

	if ^subsystem_entry then do;
	     call ssu_$arg_ptr (ssu_ptr, 1, argp, argl);

	     call forum_requests_$find_forum (argument, forum_directory, full_forum_name, name_len, code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "^a", argument);
	     forum_name = substr (full_forum_name, 1, name_len);

	     if public_switch then arg_idx = 2;
	     else arg_idx = 3;
	end;

	do arg_idx = arg_idx to nargs;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, argp, argl);

	     if add_switch & (argument = "-read_only" | argument = "-ro") then read_only = "1"b;
	     else if add_switch & (argument = "-chairman" | argument = "-cm") then chairman = "1"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", argument);
	end;

	if chairman & read_only then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-chairman"" and ""-read_only""");

	if subsystem_entry then do;
	     forum_no = passport.forum_idx;
	     forum_directory = passport.forum_dir;
	     full_forum_name = passport.forum_name;
	     forum_name = no_suffix_name;
	     if forum_no = 0 then
		call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	end;
	else do;
	     call forum_$open_forum (forum_directory, full_forum_name, forum_no, code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to open the ^a meeting.", forum_name);
	end;

	v2 = (forum_no < 0);
	if ^v2 & chairman then
	     call ssu_$abort_line (ssu_ptr, 0, "The -chairman control argument may not be used with version 1 meetings.");	

	acl.modes = RW_ACCESS;
	if ^add_switch then acl.xmodes = N_ACCESS;
	else if chairman then acl.xmodes = RWC_XACL;
	else if read_only then acl.xmodes = R_XACL;
	else acl.xmodes = RW_XACL;
	acl.code = 0;

	if public_switch then do;
	     if v2 then do;
		acl.access_name = "*.*.*";
		call forum_$set_forum_acl (forum_directory, full_forum_name, addr (acl), 1, code);
	     end;
	     else call forum_$set_v1_forum_acl (forum_no, "*", "1"b, add_switch, ^read_only, code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to make ^a meeting ^[public^;private^].", forum_name, add_switch);
	end;

	else do;
	     if subsystem_entry then arg_idx = 1;
	     else arg_idx = 2;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, argp, argl);

	     if index (argument, "*") > 0 | index (argument, ".") > 0 then
		call ssu_$abort_line (ssu_ptr, 0, "^[Person^;Project^]_ids may not contain ""."" or ""*"".", person_switch);
	     person_id = argument;

	     if v2 then do;
		if person_switch then acl.access_name = argument || ".*.*";
		else acl.access_name = "*." || argument || ".*";
		call forum_$set_forum_acl (forum_directory, full_forum_name, addr (acl), 1, code);
	     end;
	     else call forum_$set_v1_forum_acl (forum_no, person_id, person_switch, add_switch, ^read_only, code);

	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to ^[add ^a to^;remove ^a from^] ^a meeting.", add_switch,
		     person_id, forum_name);

	     if ^add_switch then do;
		call forum_$set_switch_idx (forum_no, person_id, "participating", "0"b, code);
		if code ^= 0 then
		     if code ^= forum_et_$no_such_user then
			call ssu_$abort_line (ssu_ptr, code, "Unable to turn off participating switch for ^a.", person_id);
			else code = 0;
	     end;
	end;
	if ^subsystem_entry then call forum_$close_forum (forum_no, (0));

	if public_switch then
	     call ioa_ ("The ^a meeting is ^[now^;no longer^] public^[ly readable^].", forum_name, (add_switch), (read_only));
	else call ioa_ ("^[^a^;The ^a project^] ^[may now read^s^;has been ^[added to^;removed from^]^] the ^a meeting.",
	     person_switch, person_id, (read_only), (add_switch), forum_name);

	return;

PUNT:	if ssu_ptr ^= null () & ^subsystem_entry then call ssu_$destroy_invocation (ssu_ptr);

	if ^subsystem_entry & forum_no ^= 0 then call forum_$close_forum (forum_no, 0);
	return;
%page;
forum_add_project: fapj:				/* Entry to add project to existing forum */
     entry ();

	whoami = "forum_add_project";
	call create_subsystem ();
	if nargs < 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fapj meeting_name project_id {-control_arg}");

	person_switch = "0"b;
	add_switch = "1"b;
	goto common;

forum_add_participant$add_project:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "add_project";
	call setup_request ();
	if nargs < 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: apj project_id {-control_arg}");
	person_switch = "0"b;
	add_switch = "1"b;
	goto common;
%page;
forum_remove_project: frpj:				/* Entry to remove project to existing forum */
     entry ();

	whoami = "forum_remove_project";
	call create_subsystem ();
	if nargs ^= 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: frpj meeting_name project_id.");
	person_switch, add_switch = "0"b;
	goto common;

forum_add_participant$remove_project:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "remove_project";
	call setup_request ();
	if nargs ^= 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: rpj project_id");
	person_switch, add_switch = "0"b;
	goto common;
%page;
forum_remove_participant: frpt:				/* Entry to remove participant to existing forum */
     entry ();

	whoami = "forum_remove_participant";
	call create_subsystem ();
	if nargs ^= 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: frpt meeting_name person_id");
	person_switch = "1"b;
	add_switch = "0"b;

	goto common;

forum_add_participant$remove_participant:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "remove_participant";
	call setup_request ();
	if nargs ^= 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: rpt person_id");
	person_switch = "1"b;
	add_switch = "0"b;
	goto common;
%page;						
forum_make_public: fmp:				/* Entry to make public an existing forum */
     entry ();

	whoami = "forum_make_public";
	call create_subsystem ();
	if nargs < 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fmp meeting_name {-control_arg}");

	add_switch, public_switch = "1"b;
	goto common;

forum_add_participant$make_public:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "make_public";
	call setup_request ();
	arg_idx = 1;
	public_switch, add_switch = "1"b;
	goto common;
%page;
forum_unmake_public: fump:				/* Entry to unmake public an existing forum */
     entry ();

	whoami = "forum_unmake_public";
	call create_subsystem ();
	if nargs ^= 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fump meeting_name");

	add_switch = "0"b;
	public_switch = "1"b;
	goto common;

forum_add_participant$unmake_public:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "unmake_public";
	call setup_request ();
	if nargs ^= 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: ump");
	public_switch = "1"b;
	add_switch = "0"b;
	goto common;
%page;
forum_delete: fdl:
     entry ();

	whoami = "forum_delete";
	call cu_$arg_count (nargs);
	if nargs ^= 1 then do;
	     call com_err_$suppress_name (0, whoami, "Usage: fdl meeting_name.");
	     return;
	end;

	call cu_$arg_ptr (1, argp, argl, (0));

	call forum_requests_$find_forum (argument, forum_directory, forum_name, name_len, code);
	if code ^= 0 then do;
	     call com_err_ (code, whoami, "^a", argument);
	     return;
	end;

	call forum_$delete_forum (forum_directory, forum_name, code);
	if code ^= 0 then do;
	     call com_err_ (code, whoami, "Unable to delete the ^a meeting.", substr (forum_name, 1, name_len));
	     return;
	end;
	return;
%page;
setup_request:
   procedure ();

	subsystem_entry = "1"b;
	passport_info_ptr = P_passport_info_ptr;
	ssu_ptr = P_ssu_ptr;

	forum_name = no_suffix_name;
	call ssu_$arg_count (ssu_ptr, nargs);
	arg_idx = 2;

	return;
     end setup_request;


create_subsystem:
     procedure ();

declare	active_function		bit (1) aligned;

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, code);
	if code ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (code, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (code, whoami, "Unable to create subsystem invocation.");
	     goto PUNT;
	end;

	subsystem_entry = "0"b;
	call ssu_$return_arg (ssu_ptr, nargs, active_function, null (), (0));
	if active_function then
	     call ssu_$abort_line (ssu_ptr, error_table_$not_act_fnc);

	return;
     end create_subsystem;

punt:	proc ();

	go to PUNT;

     end punt;

end forum_add_participant;
  



		    forum_admin.pl1                 08/16/86  1414.1rew 08/16/86  1354.5       59508


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     CHanged to use check_gate_access_, handle versions better.
                                                   END HISTORY COMMENTS */


forum_admin:
	procedure ();
	
/* Jay Pattin 03/29/82  Privileged forum interface - don't have to be chairman
  Use of this command requires access to the forum_admin_ gate

  added eligiblility message stuff 5/20/82 Jay Pattin */

declare	arg_count			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	arg			char (arg_len) based (arg_ptr),
	1 fi			aligned like forum_info,
	forum_dir			char (168),
	forum_name		char (32),
	status			fixed bin (35),
	whoami			char (16) static options (constant) init ("forum_admin");

declare	(addr, codeptr, index)	builtin;

declare	(error_table_$entlong, forum_et_$not_eligible, forum_et_$no_such_forum)
				fixed bin (35) external;

declare	check_gate_access_		entry (char (*), ptr, fixed bin (35)),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
	(com_err_, com_err_$suppress_name)
				entry options (variable),
	expand_pathname_$add_suffix	entry (char(*), char(*), char(*), char(*), fixed bin (35)),
	forum_$get_forum_path	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_admin_$change_chairman	entry (char (*), char (*), char (*), fixed bin (35)),
	forum_admin_$v1_change_chairman	entry (char (*), char (*), char (*), fixed bin (35)),
	forum_admin_$convert	entry (char (*), char (*), fixed bin (35)),
	forum_admin_$init_notifications
				entry (fixed bin (35)),
	forum_admin_$set_forum_acl	entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned,
				bit (1) aligned, fixed bin (35)),
	forum_admin_$set_switch	entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35)),
	forum_admin_$set_global_switch
				entry (char (*), bit (1) aligned, fixed bin (35)),
	forum_$forum_info		entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35)),
	ioa_			entry options (variable),
	pathname_			entry (char (*), char (*)) returns (char (168));
%page;
%include forum_info;
%page;
	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami);
	     return;
	end;

	if arg_count = 0 then do;
	     call com_err_$suppress_name (0, "", "Usage:  forum_admin key {arguments}");
	     return;
	end;

	call check_gate_access_ ("forum_admin_", codeptr (forum_admin), status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "This command requires access to the forum_admin_ gate");
	     return;
	end;

	call get_arg (1);

	if arg = "init_notifications" then do;
	     if arg_count ^= 1 then do;
WRONG_ARGS:	call com_err_ (0, whoami, "Wrong number of arguments for this keyword.");
		return;
	     end;
	     call forum_admin_$init_notifications (status);
	     if status ^= 0 then call com_err_ (status, whoami);
	end;
	
	else if arg = "convert" then do;
	     if arg_count ^= 2 then goto WRONG_ARGS;
	     call get_path (2, "1"b);
	     call forum_admin_$convert (forum_dir, forum_name, status);
	     if status ^= 0 then call com_err_ (status, whoami, "Converting meeting.");
	end;

	else if arg = "change_chairman" then do;
	     if arg_count ^= 3 then goto WRONG_ARGS;
	     call get_path (2, "0"b);
	     call get_arg (3);
	     fi.version = forum_info_version_1;
	     call forum_$forum_info (forum_dir, forum_name, "", (0), addr (fi), status);
	     if status = 0 | status = forum_et_$not_eligible then do;
		call ioa_ ("Changing chairman from ^a.^a to ^a.", fi.chairman.username, fi.chairman.project, arg);
		call forum_admin_$change_chairman (forum_dir, forum_name, arg, status);
		if status ^= 0 then call com_err_ (status, whoami, "Changing chairman.");
	     end;
	     else call com_err_ (status, whoami, "Getting forum info.");
	end;
	else if arg = "switch_on" | arg = "swn" then call set_switch ("1"b);
	else if arg = "switch_off" | arg = "swf" then call set_switch ("0"b);
	else call com_err_ (0, whoami, "Unrecognized key. ""^a""", arg);

PUNT:	return;
%page;
get_arg:
     procedure (arg_num);

declare	arg_num			fixed bin;

	call cu_$arg_ptr (arg_num, arg_ptr, arg_len, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "Argument #^d.", arg_num);
	     goto PUNT;
	end;

	return;
     end get_arg;


get_path:
     procedure (path_arg, must_be_v1);

declare	path_arg			fixed bin,
	must_be_v1		bit (1) aligned;

	call get_arg (path_arg);
	if must_be_v1 then goto VERSION1;
	call expand_pathname_$add_suffix (arg, "forum", forum_dir, forum_name, status);
	if status ^= 0 then do;
	     if status = error_table_$entlong then goto VERSION1;
EXPANDERR:    
	     call com_err_ (status, whoami, "Expanding ""^a"".", arg);
	     goto PUNT;
	end;

	call forum_$get_forum_path (forum_dir, forum_name, forum_dir, forum_name, status);
	if status = 0 then return;

VERSION1:	call expand_pathname_$add_suffix (arg, "control", forum_dir, forum_name, status);
	if status ^= 0 then goto EXPANDERR;
	
	return;
     end get_path;
%page;
set_switch:
     procedure (value);

declare	value			bit (1) aligned,
	switch_name		char (32);

	if arg_count < 2 then goto WRONG_ARGS;
	call get_arg (2);
	switch_name = arg;

	if switch_name = "meeting_eligibility_messages" | switch_name = "mtg_emsg" |
	     switch_name = "adjourned" | switch_name = "adj" then do;
	     if arg_count ^= 3 then goto WRONG_ARGS;
	     call get_path (3, "0"b);
	     call forum_admin_$set_switch (forum_dir, forum_name, "", switch_name, value, status);
	     if status ^= 0 then
		call com_err_ (status, whoami, "^[S^;Res^]etting ""^a"" switch for the ^a meeting",
		value, switch_name, pathname_ (forum_dir, forum_name));
	end;
	else do;
	     if arg_count ^= 2 then goto WRONG_ARGS;
	     call forum_admin_$set_global_switch (arg, value, status);
	     if status ^= 0 then call com_err_ (status, whoami, "^[S^;Res^]etting ""^a"" switch.", value, arg);
	end;

     end set_switch;

end forum_admin;



		    forum_create.pl1                08/19/86  2046.3rew 08/19/86  2045.0      218502


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added 'do you really want to announce?' query and -force,
     -no_force to suppress it.   Made announce report read_only
     public.
  2) change(86-08-19,Pattin), approve(86-08-19,MCR7354),
     audit(86-08-19,Margolin), install(86-08-19,MR12.0-1135):
     PBF to above change.  Copy user's long_name into fname with the char
     builtin instead of substr, which does not pad with blanks.
                                                   END HISTORY COMMENTS */


forum_create:
fcr:
     procedure ();

/* Version 2 Forum - Create Forum meetings
  1/4/83 Jay Pattin from version 1 fcr
  Modified 6/4/83 Jay Pattin for meeting announcements */

declare	active_fnc_err_		entry options (variable),
	command_query_		entry options (variable),
	com_err_			entry options (variable),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin (21)) returns (fixed bin (35)),
	cu_$arg_list_ptr		entry returns (ptr),
	expand_pathname_		entry (char (*), char (*), char (*), fixed bin (35)),
	format_document_$string	entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35)),
	forum$enter_first_trans	entry (char (*)),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	forum_$chname_forum_idx	entry (fixed bin, char (*), char (*), fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$create_forum		entry (char (*), char (*), fixed bin (35)),
	forum_$delete_forum		entry (char (*), char (*), fixed bin (35)),
	forum_$enter_trans		entry (fixed bin, char (*), fixed bin, char (*), bit (36) aligned, fixed bin,
				fixed bin (35)),
	forum_$forum_info		entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35)),
	forum_$list_forum_acl	entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)),
	forum_$open_forum		entry (char (*), char (*), fixed bin, fixed bin (35)),
	forum_$read_trans		entry (fixed bin, fixed bin, ptr, ptr, fixed bin (35)),
	forum_$set_forum_acl	entry (char (*), char (*), ptr, fixed bin, fixed bin (35)),
	forum_$set_message		entry (fixed bin, char (*), fixed bin (35)),
	get_system_free_area_	entry returns (ptr),
	get_temp_segment_		entry (char (*), ptr, fixed bin (35)),
	get_wdir_			entry returns (char (168)),
	hcs_$list_acl		entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)),
	hcs_$status_		entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)),
	(ioa_, ioa_$rsnnl)		entry options (variable),
	iox_$get_line		entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)),
	pathname_			entry (char (*), char (*)) returns (char (168)),
	release_temp_segment_	entry (char (*), ptr, fixed bin (35)),
 	ssu_$abort_line		entry options (variable),
	ssu_$arg_count		entry (ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin (21)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$get_subsystem_and_request_name
				entry (ptr) returns (char (72) var),
	ssu_$print_message		entry options(variable),
	ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)),
	user_info_$whoami		entry (char (*), char (*), char (*));

declare	(P_passport_info_ptr	ptr,
	P_ssu_ptr			ptr)
				parameter;

declare	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	arg			char (arg_len) based (arg_ptr),
	answer			char (256) varying,
	area_ptr			ptr,
	code			fixed bin (35),
	enter_description		bit (1) aligned,
	force			bit (1) aligned,
	forum_name		char (32),
	fname			char (32),
	forum_idx			fixed bin,
	forum_directory		char (168),
	forum_dir_dir		char (168),
	forum_dir_ent		char (32),
	message			char (512),
	meeting_switch		bit (1) aligned,
	name_len			fixed bin,
	person_id			char (22),
	project			char (9),
	public_switch		bit (1) aligned,
	query_info_ptr		ptr,	
	read_only			bit (1) aligned,
	short_name		char (128),
	ssu_ptr			ptr,
	subsystem			bit (1) aligned,
	temp_seg			char (104480) based (temp_seg_ptr),
	temp_seg_ptr		ptr,
	text			char (text_len) based (temp_seg_ptr),
	text_len			fixed bin (21),
	trans_pic			pic "zz9999",
	whoami			char (32),
	cleanup			condition,
	(addr, after, before, char, index, length, ltrim, maxlength, null, pointer, reverse, rtrim, string, substr)
				builtin;

declare	1 fdoc			aligned like format_document_options,
	1 fi			aligned like forum_info,
	1 sb			aligned like status_branch;

declare	1 one_acl			aligned,
	2 access_name		char (32),
	2 modes			bit (36) aligned,
	2 xmodes			bit (36) aligned,
	2 code			fixed bin (35);

declare	forum_data_$meetings_directory
				char (32) external,
	(error_table_$badopt,
	error_table_$noarg,
	forum_et_$cant_notify,
	forum_et_$no_forum)		fixed bin (35) external,
	iox_$user_input		ptr external;

declare	(RW_XACL			init ("110"b),
	R_XACL			init ("100"b),
	RW_ACCESS			init ("101"b))
				bit (3) static options (constant);

declare	(DIR			init ("Enter the pathname of the directory where the meeting is to be placed.^/Entering a carriage return will create the meeting in the current working directory.^/^/Pathname: "),
	NAME			init ("Enter the primary name of the new meeting. The name may be from 1 to 26 characters long.^/^/Primary name: "),
	SNAME			init ("Enter a secondary name for the meeting, or a carriage return if no second name is desired.^/^/Short name: "),
	PUBLIC			init ("Answering ""yes"" will allow all users on the system to participate in the meeting.^/Answering ""no"" will restrict participation to users you explicitly allow.^/"),
	PROJECT		init ("Answering ""yes"" will allow you to specify projects whose users will be allowed to participate in the meeting.^/Answering ""no"" will restrict participation to users you explicitly allow.^/"),
	PROJECTS			init ("Enter the name of a project whose users will be allowed to participate in the meeting.^/Enter a period (""."") if there are no more projects to be specified.^/"),
     	PERSON			init ("Answering ""yes"" will allow you to add individuals to the list of users allowed to participate in the meeting.^/"),
	PEOPLE			init ("Enter the person_id of a user to be allowed to participate in the meeting.^/Enter a period (""."") if there are no more users to be specified.^/"),
	ANNOUNCE			init ("Answering ""yes"" will allow you to enter an announcement of this meeting^/into another meeting so that others may easily add it to their search list.^/"),
	ANN_MTG			init ("Enter the name of the meeting in which the announcement should be entered.^/Enter a carriage return to announce it in the ^a meeting.^/Enter ""quit"" to not make the announcement.^/^/"))
				char (256) static options (constant);

declare	CMSG_EXP			char (300);	/* Not a constant because it's too big */
%page;
%include forum_passport;
%page;
%include forum_user_trans;
%page;
%include forum_info;
%page;
%include query_info;
%page;
%include format_document_options;
%page;
%include status_structures;
%page;
	whoami = "forum_create";
	subsystem = "0"b;
	call user_info_$whoami (person_id, project, "");
	forum_idx = 0;

	forum_user_trans_ptr, temp_seg_ptr = null ();
	forum_directory, forum_name = "";
	on cleanup call clean_up ("1"b);

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, code);
	if code ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (code, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (code, whoami, "Unable to create subsystem invocation.");
	     return;
	end;

	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count ^= 0 then call ssu_$abort_line (ssu_ptr, 0, "Usage:  fcr");

	query_info_ptr = addr (query_info);
	query_info.version = query_info_version_6;
	query_info.suppress_spacing = "1"b;
	query_info.explanation_ptr = addr (DIR);
	query_info.explanation_len = length (rtrim (DIR));

	call command_query_ (query_info_ptr, answer, "",
	     "Enter pathname of meeting directory (carriage return for working_dir)^/");
	if answer = "" then
	     forum_directory = get_wdir_ ();
	else do;
	     forum_directory = answer;
	     call expand_pathname_ (forum_directory, forum_dir_dir, forum_dir_ent, code);
	     if code ^= 0 then 
		call ssu_$abort_line (ssu_ptr, code, "Expanding ""^a""", answer);
	     forum_directory = rtrim (forum_dir_dir) || ">" || rtrim (forum_dir_ent);
	end;

	query_info.suppress_spacing = "0"b;
	query_info.explanation_ptr = addr (NAME);
	query_info.explanation_len = length (rtrim (NAME));

BLANK:	     
	call command_query_ (query_info_ptr, answer, "", "Please enter long meeting name (<27 characters): ");
	if answer = "" then goto BLANK;

	forum_name = rtrim (answer) || ".forum";
	call forum_$create_forum (forum_directory, forum_name, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Error creating meeting.");

	fname = char (answer, 32);

	call forum_$open_forum (forum_directory, forum_name, forum_idx, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Unable to open newly created meeting.");

	query_info.explanation_ptr = addr (SNAME);
	query_info.explanation_len = length (rtrim (SNAME));

	call command_query_ (query_info_ptr, answer, "", "Now enter abbreviated meeting name: ");

	short_name = answer;
	if short_name ^= "" then do;
	     call forum_$chname_forum_idx (forum_idx, "", rtrim (short_name) || ".forum", code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to add short name to meeting ^a.", fname);
	end;

	query_info.explanation_ptr = addr (PUBLIC);
	query_info.explanation_len = length (rtrim (PUBLIC));

	one_acl.modes = RW_ACCESS;
	query_info.yes_or_no_sw = "1"b;
	query_info.prompt_after_explanation = "1"b;
	call command_query_ (query_info_ptr, answer, "", "Should the meeting be public? ");
	if answer = "yes" then do;
	     public_switch = "1"b;
	     read_only = "0"b;
	     one_acl.access_name = "*.*.*";
	     one_acl.xmodes = RW_XACL;
	     call forum_$set_forum_acl (forum_directory, forum_name, addr (one_acl), 1, code);
	     if code ^= 0 then
		call ssu_$print_message (ssu_ptr, code, "Unable to make meeting public.");
	     goto CMSG;
	end;

	public_switch = "0"b;
	query_info.explanation_ptr = addr (PERSON);
	query_info.explanation_len = length (rtrim (PERSON));

	query_info.yes_or_no_sw = "1"b;
	call command_query_ (query_info_ptr, answer, "", "Should specified individuals be allowed to participate?");
	if answer = "yes" then do;
	     query_info.yes_or_no_sw = ""b;
	     call ioa_ ("^/Now please type person_id's of attendees when prompted.");
	     call ioa_ ("Signal the end of the list by typing a period only.");

	     query_info.explanation_ptr = addr (PEOPLE);
	     query_info.explanation_len = length (rtrim (PEOPLE));

	     call set_acl ("1"b);
	end;

	query_info.explanation_ptr = addr (PROJECT);
	query_info.explanation_len = length (rtrim (PROJECT));

	query_info.yes_or_no_sw = "1"b;
	call command_query_ (query_info_ptr, answer, "", "Should specified projects be allowed to participate?");
	if answer = "yes" then do;
	     call ioa_ ("^/Now please type project_ids when prompted.");
	     call ioa_ ("Signal the end of the list by typing a period only.");
	     query_info.explanation_ptr = addr (PROJECTS);
	     query_info.explanation_len = length (rtrim (PROJECTS));

	     query_info.yes_or_no_sw = ""b;
	     call set_acl ("0"b);
	end;

CMSG:	CMSG_EXP = "The chairman message is printed each time a participant attends a meeting^/after the message has changed and the first time he enters a transaction^/after going to a meeting.";
	CMSG_EXP = rtrim (CMSG_EXP) || "  It is intended to a serve as a reminder of the^/purpose of the meeting and of the meeting's audience.^2/Do you want to enter a chairman message? ";
				
	query_info.yes_or_no_sw = "1"b;
	query_info.prompt_after_explanation = "0"b;
	query_info.explanation_ptr = addr (CMSG_EXP);
	query_info.explanation_len = length (rtrim (CMSG_EXP));
	call command_query_ (query_info_ptr, answer, "", "Do you want to enter a chairman message (? for explanation)?");

	if answer = "yes" then call get_message ();

	call ioa_ ("The ^a meeting has been established in ^a.", fname, forum_directory);

	call ioa_ ("You must now enter the first transaction in the ^a meeting, which will^/act as an introduction.", fname);
	call forum$enter_first_trans (rtrim (forum_directory) || ">" || fname);

	query_info.prompt_after_explanation = "1"b;
	query_info.explanation_ptr = addr (ANNOUNCE);
	query_info.explanation_len = length (rtrim (ANNOUNCE));
	call command_query_ (query_info_ptr, answer, "", "Do you want to announce this meeting?");
	if answer = "yes" then call announce ();

EGRESS:	call clean_up ("0"b);
	return;
%page;
set_acl:
     proc (person);

declare	person			bit (1) aligned;

	do while ("1"b);
	     call command_query_ (query_info_ptr, answer, "", "^[Person^;Project^]_id: ", person);
	     if answer = "." then return;

	     read_only = "1"b;
	     if substr (answer, length (answer) - length (" -ro") + 1) = " -ro" then
		answer = substr (answer, 1, length (answer) - length (" -ro"));
	     else if substr (answer, length (answer) - length (" -read_only") + 1) = " -read_only" then
		answer = substr (answer, 1, length (answer) - length (" -read_only"));
	     else read_only = "0"b;
		
	     if index (answer, ".") > 0 | index (answer, "*") > 0 then
		call ssu_$print_message (ssu_ptr, 0, "^[Person^;Project^]_ids may not contain ""."" or ""*"".", person);
	     else if answer ^= "" then do;
		if person then do;
		     if answer = person_id then do;
			call ssu_$print_message (ssu_ptr, 0, "You are already a participant.");
			goto NEXT_ID;
		     end;
		     one_acl.access_name = rtrim (answer) || ".*.*";
		end;
		else one_acl.access_name = "*." || rtrim (answer) || ".*";
		if read_only then one_acl.xmodes = R_XACL;
		else one_acl.xmodes = RW_XACL;
		call forum_$set_forum_acl (forum_directory, forum_name, addr (one_acl), 1, code);
		if code ^= 0 then
		     call ssu_$print_message (ssu_ptr, code, "Unable to add ^[project ^]^a to new meeting.",
			^person, answer);
	     end;
NEXT_ID:	end;
     end set_acl;
%page;
get_message:
     proc ();

	call ioa_ ("Message (End with "".""):");

	call get_input ();
	call forum_$set_message (forum_idx, rtrim (message), code);
	if code ^= 0 then
	     call ssu_$print_message (ssu_ptr, code, "Setting chairman message.");
	return;
     end get_message;

get_input:
     proc ();

declare	buffer			char (256),
	len			fixed bin (21);

	message = "";
	do while ("1"b);
	     buffer = "";
	     call iox_$get_line (iox_$user_input, addr (buffer), 256, len, code);
	     if code ^= 0 then do;
		call ssu_$print_message (ssu_ptr, code, "Reading message.");
		return;
	     end;

	     if len > 0 then do;
		if len = 2 & substr (buffer, 1, 1) = "." then return;
		buffer = substr (buffer, 1, len);
		if length (rtrim (message)) + length (rtrim (buffer)) > maxlength (message) then
		     call ssu_$abort_line (ssu_ptr, 0, "Input must be less than 512 characters.");
		message = rtrim (message) || buffer;
	     end;
	end;
     end get_input;
%page;
announce_meeting:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	forum_idx = passport.forum_idx;

	subsystem = "1"b;
	meeting_switch, enter_description, force = "0"b;
	forum_user_trans_ptr, temp_seg_ptr = null ();
	sb.names_relp = ""b;
	on cleanup call clean_up ("1"b);

	call ssu_$arg_count (ssu_ptr, arg_count);

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") ^= 1 then
		call ssu_$abort_line (ssu_ptr, 0, "Usage:  anm {-control_arg}");
	     else if arg = "-enter_description" | arg = "-eds" then enter_description = "1"b;
	     else if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-meeting" | arg = "-mtg" then do;
		meeting_switch = "1"b;
		arg_idx = arg_idx + 1;
		if arg_idx > arg_count then
		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
		call forum_requests_$find_forum (arg, forum_dir_dir, forum_dir_ent, name_len, code);
		if code ^= 0 then
		     call ssu_$abort_line (ssu_ptr, code, "Locating ^a.", arg);
	     end;
	     else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;
		
	if forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	if ^meeting_switch then do;
	     forum_dir_dir = forum_data_$central_directory;
	     forum_dir_ent = forum_data_$meetings_directory;
	     name_len = index (forum_data_$meetings_directory, ".forum") - 1;
	     if name_len < 0 then name_len = index (forum_data_$meetings_directory, ".control") - 1;
	end;
	forum_directory = passport.forum_dir;
	forum_name = passport.forum_name;
	fname = no_suffix_name;

	if ^force then do;
	     query_info.version = query_info_version_6;
	     string (query_info.switches) = ""b;
	     query_info.yes_or_no_sw = "1"b;
	     query_info.explanation_ptr, query_info.question_iocbp, query_info.answer_iocbp = null ();
	     call command_query_ (addr (query_info), answer, ssu_$get_subsystem_and_request_name (ssu_ptr),
		"Do you really want to announce the ^a meeting in the ^a meeting?",
		fname, pathname_ (forum_dir_dir, substr (forum_dir_ent, 1, name_len)));
	     if answer = "no" then return;
	end;

	area_ptr, status_area_ptr = passport.area_ptr;
	status_ptr = addr (sb);

	short_name = "";
	call hcs_$status_ (forum_directory, forum_name, 0, status_ptr, area_ptr, code);
	if code = 0 then do;
	     fname = reverse (after (reverse (status_entry_names (1)), "."));
	     if sb.nnames > 1 then
		short_name = reverse (after (reverse (status_entry_names (2)), "."));
	     do arg_idx = 3 to sb.nnames while (length (rtrim (short_name)) < 102);
		short_name = rtrim (short_name) || ", " || reverse (after (reverse (status_entry_names (arg_idx)), "."));
	     end;
	end;

	fi.version = forum_info_version_1;
	call forum_$forum_info (forum_directory, forum_name, "", 0, addr (fi), code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code);
	person_id = fi.chairman.username;
	project = fi.chairman.project;

	one_acl.access_name = "*.*.*";
	if forum_idx < 0 then do;
	     call forum_$list_forum_acl (forum_directory, forum_name, null (), null (), addr (one_acl), 1, code);
	     if code ^= 0 then public_switch = "0"b;
	     else do;
		public_switch = (one_acl.xmodes ^= ""b);
		read_only = (one_acl.xmodes = R_XACL);
	     end;
	end;
	else do;
	     call hcs_$list_acl (forum_directory, forum_name, null (), null (), addr (one_acl), 1, code);
	     if code ^= 0 then public_switch = "1"b;
	     else public_switch = (one_acl.modes = RW_ACCESS);
	end;

	call announce_existing ();
	return;
%page;
announce:
     proc ();

declare	(announce_idx, idx)		fixed bin,
	announce_path		char (168);

     	query_info.yes_or_no_sw, query_info.prompt_after_explanation = "0"b;
	query_info.suppress_spacing = "1"b;

	query_info.explanation_ptr = addr (ANN_MTG);
	query_info.explanation_len = length (rtrim (ANN_MTG));
AGAIN:	call command_query_ (query_info_ptr, answer, "", "^/Enter the name of the meeting where the announcement should be made.^/(Enter carriage return for ^a>^a.)^/",
	     forum_data_$central_directory, before (forum_data_$meetings_directory, "."));
	if answer = "quit" then return;

	if answer = "" then do;
	     forum_dir_dir = forum_data_$central_directory;
	     forum_dir_ent = forum_data_$meetings_directory;
	end;
	else do;
	     call forum_requests_$find_forum ((answer), forum_dir_dir, forum_dir_ent, (0), code);
	     if code ^= 0 then do;
BADMTG:		call ssu_$print_message (ssu_ptr, code, "Unable to locate ^a meeting.", answer);
		goto AGAIN;
	     end;
	end;

	area_ptr =  get_system_free_area_ ();
	call user_info_$whoami (person_id, project, "");
	enter_description = "0"b;
	goto JOIN;

announce_existing:
     entry ();

JOIN:     announce_idx = 0;
	on cleanup call forum_$close_forum (announce_idx, (0));

	call forum_$open_forum (forum_dir_dir, forum_dir_ent, announce_idx, code);
	if code ^= 0 then
	     if subsystem then call ssu_$abort_line (ssu_ptr, code, "Opening ^a>^a.", forum_dir_dir, forum_dir_ent);
	     else goto BADMTG;

	announce_path = rtrim (forum_dir_dir) || ">" || forum_dir_ent;
	call get_temp_segment_ (whoami, temp_seg_ptr, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Unable to obtain temp segment.");

	call ioa_$rsnnl (" Names:^2-^a^[, ^a^;^s^]^/ Location:^-^a^/ Chairman:^-^a.^a^/ Participation:^-^[Public^[ (read-only)^]^/^/^]",
	     temp_seg, text_len, fname, (short_name ^= ""), short_name, forum_directory, person_id, project,
	     public_switch, read_only);

	if ^public_switch then do;
	     call ioa_ ("Enter a short description of the access to the meeting (End with ""."").");
	     call get_input ();

	     idx = length (rtrim (message));
	     if idx = 0 then do;
		substr (temp_seg, text_len, 2) = "

";
		text_len = text_len + 2;
	     end;
	     else begin;

declare	temp			char (2 * idx + 20),
	len			fixed bin (21);

		fdoc.version_number = format_document_version_2;
		fdoc.indentation = 20;
		fdoc.line_length = 52;
		string (fdoc.switches) = ""b;
		fdoc.galley_sw, fdoc.literal_sw, fdoc.dont_break_indented_lines_sw = "1"b;
		fdoc.syllable_size = 3;		/* Make fdoc happy */

		call format_document_$string (substr (message, 1, idx), temp, len, addr (fdoc), code);
		if code ^= 0 then
		     call ssu_$abort_line (ssu_ptr, code, "Unable to fill announcement.");

		len = len - 20;			/* remove indentation from first line. */
		substr (temp_seg, text_len + 1, len + 1) = substr (temp, 21, len) || "
";
		text_len = text_len + len + 1;
	     end;					/* BEGIN */
	end;

	if enter_description then call enter_meeting_description ();
	else do;
	     call forum_$read_trans (forum_idx, 1, area_ptr, forum_user_trans_ptr, code );
	     if code ^= 0 then do;
		call ssu_$print_message (ssu_ptr, code, "Unable to read first transaction.");
		call enter_meeting_description ();
	     end;
	     else do;
		substr (temp_seg, text_len + 1, forum_user_trans.text_length) = forum_user_trans.text;
		text_len = text_len + forum_user_trans.text_length;
	     end;
	end;

	forum_dir_dir = rtrim (fname) || " meeting";
	call forum_$enter_trans (announce_idx, text, 0, forum_dir_dir, "11"b, idx, code);
	if code ^= 0 then
	     if code ^= forum_et_$cant_notify then
		call ssu_$abort_line (ssu_ptr, code, "Unable to enter announcement.");

	trans_pic = idx;
	call ioa_ ("Announcement [^a] entered in the ^a meeting.", ltrim (trans_pic), announce_path);

	call forum_$close_forum (announce_idx, (0));

	return;
     end announce;
%page;
enter_meeting_description:
     proc ();

declare	idx			fixed bin (21);

	call ioa_ ("Please enter a short description of the meeting (End with ""."").");
	call get_input ();

	idx = length (rtrim (message));
	substr (temp_seg, text_len + 1, idx) = message;
	text_len = text_len + idx;
	return;
     end enter_meeting_description;

clean_up:
     proc (cleanup_sw);

declare	cleanup_sw		bit (1) aligned;

     	if forum_user_trans_ptr ^= null () then free forum_user_trans;
	if temp_seg_ptr ^= null () then
	     call release_temp_segment_ (whoami, temp_seg_ptr, (0));

	if subsystem then do;
	     if sb.names_relp ^= ""b then free status_entry_names;
	     return;
	end;

	call forum_$close_forum (forum_idx, (0));
	if ^cleanup_sw then return;

	call forum_$delete_forum (forum_directory, forum_name, (0));
	call ssu_$destroy_invocation (ssu_ptr);

	return;
     end clean_up;


punt:
     proc ();

	goto EGRESS;

	end punt;
	
end forum_create;
  



		    forum_find_v1.pl1               04/09/85  1614.8r w 04/08/85  1130.6       94221


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1985 *
   *                                                            *
   ************************************************************** */
ffv1:
forum_find_v1:
     proc ();

%include star_structures;
%include status_structures;
%include access_mode_values;

declare	arg_count			fixed bin,
	arg_ptr			ptr,
	arg_len			fixed bin (21),
	arg			char (arg_len) based (arg_ptr),
	(dir, dir_dir)		char (168),
	dir_name			char (32),
	dir_quota			fixed bin (18),
	dir_qused			fixed bin (18),
	idx			fixed bin,
	modes			bit (36) aligned,
	name			char (32),
	v1_recs_used		fixed bin,
	v2_qused			fixed bin (18),
	status			fixed bin (35);

declare	cu_$arg_count		entry (fixed bin, fixed bin(35)),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
	check_gate_access_		entry (char (*), ptr, fixed bin (35)),
	com_err_			entry options (variable),
	convert_status_code_	entry (fixed bin(35), char(8) aligned, char(100) aligned),
	expand_pathname_		entry (char(*), char(*), char(*), fixed bin(35)),
	forum_$delete_forum		entry (char(*), char(*), fixed bin(35)),
	forum_$get_forum_path	entry (char(*), char(*), char(*), char(*), fixed bin(35)),
	forum_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	forum_admin_$convert	entry (char (*), char (*), fixed bin (35)),
	get_system_free_area_	entry returns (ptr),
	get_wdir_			entry returns (char (168)),
	hcs_$get_link_target	entry (char(*), char(*), char(*), char(*), fixed bin(35)),
	hcs_$get_user_access_modes	entry (char(*), char(*), char(*), fixed bin, bit(36) aligned, bit(36) aligned,
				fixed bin(35)),
	hcs_$quota_read		entry (char(*), fixed bin(18), fixed bin(71), bit(36) aligned, bit(36), fixed bin(1),
				fixed bin(18), fixed bin(35)),
	hcs_$star_		entry (char(*), char(*), fixed bin(2), ptr, fixed bin, ptr, ptr, fixed bin(35)),
	hcs_$status_		entry (char(*), char(*), fixed bin(1), ptr, ptr, fixed bin(35)),
	hphcs_$restore_quota	entry (),
	hphcs_$suspend_quota	entry (),
	ioa_$ioa_switch		entry options (variable),
	iox_$look_iocb		entry (char(*), ptr, fixed bin(35)),
	pathname_			entry (char(*), char(*)) returns(char(168));

declare	(link_switch, link_err_switch, meeting_switch, meeting_err_switch)
				pointer static init (null ()),
	iox_$error_output		pointer external;

declare	(error_table_$wrong_no_of_args,
	 error_table_$noaccess,
	 error_table_$noentry,
	 error_table_$no_info,
	 error_table_$nomatch,
	 forum_et_$not_a_forum,
	 forum_et_$no_suffix,
	 forum_et_$no_such_forum) fixed bin (35) external;

declare	(length, addr, binary, sum, reverse, rtrim)
				builtin,
	(cleanup, linkage_error)	condition;

declare	1 sb			aligned like status_branch;
%page;
	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
PUNT:	     call com_err_ (status, "forum_find_v1_links");
	     return;
	end;

	if arg_count > 1 then do;
	     status = error_table_$wrong_no_of_args;
	     goto PUNT;
	end;
	if arg_count = 1 then do;
	     call cu_$arg_ptr (1, arg_ptr, arg_len, status);
	     if status ^= 0 then goto PUNT;
	     call expand_pathname_ (arg, dir, name, status);
	     if status ^= 0 then goto PUNT;
	     dir = pathname_ (dir, name);
	end;
	else dir = get_wdir_ ();

	star_entry_ptr, star_names_ptr = null ();
	on cleanup begin;
	     if star_names_ptr ^= null () then free star_names;
	     if star_entry_ptr ^= null () then free star_entries;
	end;

	call hcs_$star_ (dir, "**.*.control", star_LINKS_ONLY, get_system_free_area_ (), star_entry_count,
	     star_entry_ptr, star_names_ptr, status);
	if status ^= 0 then do;
	     if status = error_table_$nomatch then goto LOOK_FOR_MEETINGS;
	     else do;
		call ioa_$ioa_switch (iox_$error_output, "^a ^a", get_message (status), dir);
		return;
	     end;
	end;
	
	do idx = 1 to star_entry_count;
	     if test_link (star_names (star_entries (idx).nindex)) then do;
		free star_names;
		free star_entries;
		call ioa_$ioa_switch (link_switch, "^a", dir);
		goto LOOK_FOR_MEETINGS;
	     end;
	end;
	free star_names;
	free star_entries;
/* Now look for meetings */

LOOK_FOR_MEETINGS:
	call hcs_$star_ (dir, "**.*.control", star_ALL_ENTRIES, get_system_free_area_ (), star_entry_count,
	     star_entry_ptr, star_names_ptr, status);
	if status ^= 0 then do;
	     if status = error_table_$nomatch then return;
	     else do;
		call ioa_$ioa_switch (iox_$error_output, "^a ^a", get_message (status), dir);
		return;
	     end;
	end;
	
	do idx = 1 to star_entry_count;
	     if star_entries (idx).type = star_SEGMENT then
		call test_meeting (star_names (star_entries (idx).nindex));
	end;

	free star_names;
	free star_entries;
	return;

test_link:
     procedure (name) returns (bit (1) aligned);

declare	name			char (32),
	target_dir		char (168),
	target_name		char (32);

	call forum_$get_forum_path (dir, name, target_dir, target_name, status);
	if status = 0 then return ("1"b);

	call hcs_$get_link_target (dir, name, target_dir, target_name, status);
	if status = 0 then return ("0"b);		/* target exists, not a meeting */

	if status = error_table_$noentry then do;
	     target_name = reverse (after (reverse (target_name), ".")) || ".forum";
	     call forum_$get_forum_path (target_dir, target_name, target_dir, target_name, status);
	     if status = 0 then return ("1"b);		/* already converted */
	     if status ^= forum_et_$no_such_forum & status ^= forum_et_$no_suffix then 
		call ioa_$ioa_switch (link_err_switch, "^a In noentry ^a in ^a.", get_message (status), name, dir);
	end;
	else if status ^= error_table_$no_info & status ^= error_table_$noaccess then
	   call ioa_$ioa_switch (link_err_switch, "^a link target for ^a in ^a.",
		get_message (status), name, dir);

	return ("0"b);
     end test_link;

test_meeting:
     procedure (name);

declare	name			char (32),
	uid			bit (36) aligned;

	call forum_$get_uid_file (dir, name, uid, status);
	if status = 0 then do;
	     call ioa_$ioa_switch (meeting_switch, "^a", pathname_ (dir, name));
	     return;
	end;

	if status ^= forum_et_$not_a_forum then
	     call ioa_$ioa_switch (meeting_err_switch, "^a ^a in ^a.", get_message (status), name, dir);
	
	return;
     end test_meeting;

get_message:
     procedure (status) returns (char (100) aligned);
     
declare	status			fixed bin (35),
	short			char (8) aligned,
	long			char (100) aligned;

	call convert_status_code_ (status, short, long);
	return (long);
     end get_message;

init_search:
     entry ();

declare	no_switch_		condition;

	call iox_$look_iocb ("forum_links_", link_switch, status);
	if link_switch = null () then signal no_switch_;

	call iox_$look_iocb ("forum_meetings_", meeting_switch, status);
	if meeting_switch = null () then signal no_switch_;

	call iox_$look_iocb ("forum_link_errors_", link_err_switch, status);
	if link_switch = null () then signal no_switch_;

	call iox_$look_iocb ("forum_meeting_errors_", meeting_err_switch, status);
	if meeting_switch = null () then signal no_switch_;

	return;

init_convert:
     entry ();

	call check_gate_access_ ("hphcs_", codeptr (init_convert), status);
	if status ^= 0 then do;
	     call com_err_ (status, "convert_meetings", "This command requires access to the hphcs_ gate.");
	     return;
	end;

	call check_gate_access_ ("forum_admin_", codeptr (init_convert), status);
	if status ^= 0 then do;
	     call com_err_ (status, "convert_meetings", "This command requires access to the forum_admin_ gate.");
	     return;
	end;

	call hphcs_$suspend_quota ();
	return;

cleanup_convert:
     entry ();

	call hphcs_$restore_quota ();
	return;

/* convert one meeting. This is called as a command by the exec_com, don't
   bother checking the arguments. */

convert_one_meeting:
     entry (meeting_path);

declare	meeting_path		char (*),
	v2_name			char (32),
	proceedings_name		char (32);

	call expand_pathname_ (meeting_path, dir, name, status);
	if status ^= 0 then do;
BADPATH:	     call ioa_$ioa_switch (iox_$error_output, "^a for ^a.", get_message (status), meeting_path);
	     return;
	end;

	call expand_pathname_ (dir, dir_dir, dir_name, status);
	if status ^= 0 then goto BADPATH;

	call hcs_$get_user_access_modes (dir_dir, dir_name, "", -1, modes, ""b, status);
	if modes ^= SMA_ACCESS then do;
	     call ioa_$ioa_switch (iox_$error_output, "No sma permission on containing directory for ^a.", meeting_path);
	     return;
	end;

	call find_terminal_quota (dir_quota, dir_qused);

	call forum_admin_$convert (dir, name, status);
	if status ^= 0 then goto BADPATH;

	v2_name = reverse (substr (reverse (rtrim (name)), 9)) || ".forum";

	call hcs_$quota_read (pathname_ (dir, v2_name), 0, 0, ""b, ""b, 0, v2_qused, status);
	if status ^= 0 then do;
DELV2:	     call forum_$delete_forum (dir, v2_name, (0));
	     call ioa_$ioa_switch (iox_$error_output, "^a after conversion of ^a.", get_message (status), meeting_path);
	end;

	if v2_qused + dir_qused <= dir_quota then do;	/* obviously enough quota */
	     call forum_$delete_forum (dir, name, (0));
	     return;
	end;

/* Now we need to determine how much quota the v1 meeting is using */

	proceedings_name = reverse (substr (reverse (rtrim (name)), 9)) || ".proceedings";

	call hcs_$status_ (dir, name, 0, addr (sb), null (), status);
	if status ^= 0 then goto DELV2;
	
	v1_recs_used = sb.records_used;

	call hcs_$status_ (dir, proceedings_name, 0, addr (sb), null (), status);
	if status ^= 0 then goto DELV2;

	v1_recs_used = v1_recs_used + sb.records_used;
	if dir_qused + v2_qused - v1_recs_used <= dir_quota + 5 /* SLOP */then do;
	     call forum_$delete_forum (dir, name, (0));
	     return;
	end;

	call ioa_$ioa_switch (iox_$error_output, "Insufficient quota to convert ^a.", meeting_path);
	call forum_$delete_forum (dir, v2_name, (0));

	return;

find_terminal_quota:
	procedure (dir_quota, dir_qused);

declare	(dir_quota, dir_qused)	fixed bin (18),
	local_dir			char (168);

declare	cant_find_terminal_quota	condition;

	local_dir = dir;
	do while ("1"b);
	     call hcs_$quota_read (local_dir, dir_quota, 0, ""b, ""b, 0, dir_qused, status);
	     if status ^= 0 then goto BADPATH;

	     if dir_quota > 0 then return;
	     local_dir = reverse (after (reverse (local_dir), ">"));

	     if local_dir = "" then signal cant_find_terminal_quota;
	end;
     end find_terminal_quota;

     end forum_find_v1;
   



		    forum_input_requests_.pl1       04/27/92  1054.2r w 04/27/92  1032.0      458262


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) BULL HN Information Systems Inc., 1990       *
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Fixed bug in apply request causing null ptr faults.
  2) change(90-09-03,Bubric), approve(90-09-03,MCR8200),
     audit(90-09-26,Blackmore), install(90-10-05,MR12.4-1038):
     Fix the forum request "apply" so that it doesn't change an unprocessed
     transaction's meeting to the current meeting.
  3) change(91-09-05,Huen), approve(91-09-05,MCR8249),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20579: Fix the "apply" request to create new unproc trans when
     no unproc trans exists and no trans_specs is given.
     phx20578: Generate a complete header when printing an unproc trans which
     is created iwth the use of the "spply" request.
  4) change(91-09-05,Huen), approve(91-09-05,MCR8250),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20898 & 20899: Fix the "enter" request to handle trans created with
     "reply -mtg"
                                                   END HISTORY COMMENTS */
/* This module contains the following forum requests:

   talk   reply   set_message   enter   subject   fill
   apply   qedx   ted

   Original coding 6/81 J. Spencer Love
   Modified for ssu_ 8/21/81 Jay Pattin
   added set_message 2/27/82 Jay Pattin
   changed to use format_document_ and apply_request_util_ 6/27/82 Jay Pattin
   changed to use qedx_ (FINALLY !!) 1/18/83 Jay Pattin */

forum_input_requests_$talk_request:
     procedure (P_ssu_ptr, P_passport_info_ptr);

	declare (P_ssu_ptr, P_passport_info_ptr)
				 ptr parameter;

	declare (addr, codeptr, divide, index, length, ltrim, min, null, rtrim, string, substr, translate, verify)
				 builtin;

	declare (cleanup, linkage_error) condition;

	declare answer		 char (6) varying,
	        arg_count		 fixed bin,
	        arg_idx		 fixed bin,
	        arg_len		 fixed bin (21),
	        arg_ptr		 ptr,
	        auto_rql		 bit (1) aligned,
	        auto_write		 bit (1) aligned,
	        bit_count		 fixed bin (24),
	        brief_switch	 bit (1),
	        buffer_len		 fixed bin (21),
	        buffer_ptr		 ptr,
	        default_switch	 bit (1) aligned,
	        dirname		 char (168),
	        entryname		 char (32),
	        fill_switch		 fixed bin,
	        first_nonwhite_pos	 fixed bin (21),
	        force		 bit (1) aligned,
	        idx		 fixed bin (21),
	        inhibit_auto_fill	 bit (1) aligned,
	        inhibit_input_cp_escape bit (1) aligned,
	        line_length		 fixed bin,
	        mask		 bit (36) aligned,
	        message		 char (256),
	        message_sw		 bit (1) aligned,
	        forum_idx		 fixed bin,
	        forum_dir		 char (168),
	        forum_name		 char (32),
	        full_forum_name	 char (32),
	        new_buffer_ptr	 ptr,
	        new_buffer_len	 fixed bin (21),
	        no_chars_read	 fixed bin (21),	/* used for iox_ calls */
	        reply_switch	 bit (1),
	        reply_trans_idx	 fixed bin,
	        request_loop	 bit (1) aligned,
	        return_arg_len	 fixed bin (21),
	        return_arg_ptr	 ptr,
	        ssu_ptr		 ptr,
	        status		 fixed binary (35),
	        subject_arg_len	 fixed bin (21),
	        subject_arg_ptr	 ptr,
	        subject_switch	 bit (1) aligned,
	        ted_data_p		 ptr,
	        temp_forum		 bit (1) aligned,
	        text_len		 fixed bin (21),
	        temp_seg_ptr	 ptr,
	        terminal_switch	 bit (1) aligned,
	        trans_pic		 pic "zz9999",	/* pretty picture of trans no */
	        user_file_len	 fixed bin (21),
	        user_file_ptr	 ptr,
	        whoami		 char (32),
	        whoami_really	 char (32);

	declare 1 ted_info		 aligned like ted_data,
	        1 fdoc		 aligned like format_document_options,
	        1 qi		 aligned,
		2 header		 like qedx_info.header,
		2 buffers		 (2) like qedx_info.buffers;

	declare arg		 char (arg_len) based (arg_ptr),
	        buffer		 char (buffer_len) based (buffer_ptr),
	        new_buffer		 char (new_buffer_len) based (new_buffer_ptr),
	        return_arg		 char (return_arg_len) varying based (return_arg_ptr),
	        subject		 char (no_chars_read - first_nonwhite_pos)
				 based (add_char_offset_ (buffer_ptr, first_nonwhite_pos)),
	        subject_arg		 char (subject_arg_len) based (subject_arg_ptr),
	        temp_seg		 char (4 * sys_info$max_seg_size) based (temp_seg_ptr),
	        temp_text		 char (text_len) based (temp_seg_ptr),
	        user_file		 char (user_file_len) based (user_file_ptr);

	declare static_initialized	 bit (1) aligned static initial ("0"b),
	        my_person_id	 char (20) static,
	        my_project_id	 char (9) static;

	declare NORMAL_TERMINATION	 initial (1) fixed bin static options (constant),
	        ENTER_REQUEST_LOOP	 initial (2) fixed bin static options (constant),
	        ENTER_EDITOR	 initial (3) fixed bin static options (constant);

	declare LOWER_CASE		 initial ("abcdefghijklmnopqrstuvwxyz") char (26) static options (constant),
	        UPPER_CASE		 initial ("ABCDEFGHIJKLMNOPQRSTUVWXYZ") char (26) static options (constant);

	declare NL		 char (1) static options (constant) initial ("
"),
	        SPACE_AND_TAB	 char (2) static options (constant) initial ("	 "),
	        WHITE_CHARS		 char (5) static options (constant) initial ("
	 ");					/* NL VT FF HT SPACE				*/

	declare (forum_et_$cant_notify,
	        forum_et_$no_forum,
	        forum_et_$no_unprocessed,
	        forum_et_$read_only,
	        error_table_$bad_conversion,
	        error_table_$badopt,
	        error_table_$fatal_error,
	        error_table_$inconsistent,
	        error_table_$long_record,
	        error_table_$noarg,
	        error_table_$oldnamerr,
	        error_table_$recoverable_error,
	        error_table_$zero_length_seg,
	        sys_info$max_seg_size) fixed bin (35) external,
	        iox_$user_input	 ptr external;

	declare add_char_offset_	 entry (ptr, fixed bin (21)) returns (ptr) reducible,
	        command_query_	 entry () options (variable),
	        format_document_$string entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35)),
	        forum_requests_$open_forum
				 entry (char (*), fixed bin, char (*), char (*), fixed bin (35)),
	        forum_trans_specs_$parse_specs
				 entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*), ptr),
	        forum_trans_util_$read_trans entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	        forum_$close_forum	 entry (fixed bin, fixed bin (35)),
	        forum_$enter_trans	 entry (fixed bin, char (*), fixed bin, char (*), bit (1) aligned, fixed bin,
				 fixed bin (35)),
	        forum_$get_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$set_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$open_forum	 entry (char (*), char (*), fixed bin, fixed bin (35)),
	        cu_$cp		 entry (ptr, fixed bin (21), fixed bin (35)),
	        cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35)),
	        expand_pathname_	 entry (char (*), char (*), char (*), fixed bin (35)),
	        get_temp_segment_	 entry (char (*), ptr, fixed bin (35)),
	        hcs_$fs_get_path_name	 entry (ptr, char (*), fixed bin, char (*), fixed bin (35)),
	        hcs_$initiate_count	 entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr,
				 fixed bin (35)),
	        hcs_$reset_ips_mask	 entry (bit (36) aligned, bit (36) aligned),
	        hcs_$set_bc_seg	 entry (ptr, fixed bin (24), fixed bin (35)),
	        hcs_$set_ips_mask	 entry (bit (36) aligned, bit (36) aligned),
	        hcs_$status_mins	 entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)),
	        hcs_$terminate_noname	 entry (ptr, fixed bin (35)),
	        iox_$get_line	 entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)),
	        ioa_		 entry options (variable),
	        ioa_$nnl		 entry options (variable),
	        ipc_$cutoff		 entry (fixed bin (71), fixed bin (35)),
	        ipc_$reconnect	 entry (fixed bin (71), fixed bin (35)),
	        qedx_		 entry (ptr, fixed bin (35)),
	        release_temp_segment_	 entry (char (*), ptr, fixed bin (35)),
	        requote_string_	 entry (char (*)) returns (char (*)),
	        ssu_$abort_line	 entry options (variable),
	        ssu_$apply_request_util entry (ptr, fixed bin, ptr, fixed bin (21), fixed bin (21)),
	        ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin (21)),
	        ssu_$get_request_name	 entry (ptr) returns (char (32) varying),
	        ssu_$get_subsystem_and_request_name
				 entry (ptr) returns (char (72) varying),
	        ssu_$print_message	 entry options (variable),
	        ssu_$return_arg	 entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)),
	        user_info_$whoami	 entry (char (*), char (*), char (*)),
	        value_$get		 entry options (variable);
%page;
%include forum_passport;
%page;
%include forum_user_trans;
%page;
%include forum_trans_list;
%page;
%include query_info;
%page;
%include ted_;
%page;
%include qedx_info;
%page;
%include format_document_options;
%page;
/* forum_input_requests_$talk_request:  procedure (P_ssu_ptr, P_passport_info_ptr);		*/

	call setup_request (1);

	reply_switch = "0"b;
	auto_rql = "1"b;

	on cleanup call clean_up_talk ();

	do arg_idx = 1 to arg_count;
	     call parse_arg (arg_idx);
	end;

	call process_transaction ();

	call clean_up_talk ();

	return;
%page;
forum_input_requests_$reply_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (1);
	if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	reply_switch = "1"b;
	auto_rql = "1"b;

	on cleanup call clean_up_talk ();

	parse_flags_word = ""b;
	parse_flags.only_one = "1"b;
	parse_flags.disallow_unproc = "1"b;
	parse_flags.disallow_meeting = "1"b;
	parse_flags.disallow_reverse = "1"b;
	parse_flags.disallow_idl = "1"b;
	parse_flags.dont_read = "1"b;
	parse_flags.disallow_cmsg = "1"b;
	parse_flags.disallow_by_chain = "1"b;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, parse_arg, forum_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	if forum_idx ^= 0 then do;
		temp_forum = "1"b;
		if forum_idx < 0 then
		     full_forum_name = rtrim (forum_name) || ".forum";
		else full_forum_name = rtrim (forum_name) || ".control";
	     end;
	else forum_idx = passport.forum_idx;
	reply_trans_idx = forum_trans_list.list (1).trans_num; /* get correct subject */

	free forum_trans_list;

	call process_transaction ();

	call clean_up_talk ();

	return;
%page;
forum_input_requests_$set_message:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (1);

	message_sw, auto_rql = "1"b;

	on cleanup call clean_up_talk ();

	do arg_idx = 1 to arg_count;
	     call parse_arg (arg_idx);
	end;

	call process_transaction ();
	call clean_up_talk ();

	return;
%page;
parse_arg:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	if substr (arg, 1, min (1, arg_len)) = "-"
	then if arg = "-brief" | arg = "-bf" then brief_switch = "1"b;
	     else if arg = "-auto_write" then auto_write = "1"b;
	     else if arg = "-no_auto_write" then auto_write = "0"b;
	     else if arg = "-fill" | arg = "-fi" then fill_switch = 1;
	     else if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-input_file" | arg = "-if" then call get_input_file (arg_idx);
	     else if arg = "-line_length" | arg = "-ll" then do;
		     if arg_idx = arg_count then
			call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		     arg_idx = arg_idx + 1;
		     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
		     line_length = cv_dec_check_ (arg, status);
		     if status ^= 0 then
			call ssu_$abort_line (ssu_ptr, error_table_$bad_conversion, "^a", arg);

		     if line_length < 40 then call ssu_$abort_line (ssu_ptr, 0, "Line length must be at least 40.");
		     fill_switch = 1;
		end;
	     else if arg = "-long" | arg = "-lg" then brief_switch = "0"b;
	     else if ^message_sw & (arg = "-meeting" | arg = "-mtg") then call get_forum (arg_idx);
	     else if arg = "-no_fill" | arg = "-nfi" then fill_switch = -1;
	     else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
	     else if arg = "-no_request_loop" | arg = "-nrql" then do;
		     request_loop = "0"b;
		     auto_rql = "0"b;
		end;
	     else if arg = "-request_loop" | arg = "-rql" then do;
		     request_loop = "1"b;
		     auto_rql = "0"b;
		end;
	     else if ^message_sw & (arg = "-subject" | arg = "-sj") then call get_subject (arg_idx);
	     else if arg = "-terminal_input" | arg = "-ti" then terminal_switch = "1"b;

	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, """^a""", arg);

	else call ssu_$abort_line (ssu_ptr, 0, "Usage:  ^a ^[{trans_spec} ^]{-control_args}", whoami, reply_switch);

	return;

     end parse_arg;
%page;
get_input_file:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	if user_file_ptr ^= null () then call ssu_$abort_line (ssu_ptr, 0, "Only one -input_file is permitted.");

	arg_idx = arg_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	call expand_pathname_ (arg, dirname, entryname, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);

	call hcs_$initiate_count (dirname, entryname, "", bit_count, 0, user_file_ptr, status);
	if user_file_ptr = null ()
	then call ssu_$abort_line (ssu_ptr, status, "Initiating ^a^[>^]^a.", dirname, dirname ^= ">", entryname);

	user_file_len = divide (bit_count, 9, 21, 0);
	if user_file_len <= 0 then
	     call ssu_$abort_line (ssu_ptr, error_table_$zero_length_seg, "^a^[>^]^a", dirname, dirname ^= ">", entryname);

	return;

     end get_input_file;
%page;
get_forum:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	if temp_forum then call ssu_$abort_line (ssu_ptr, 0, "-meeting may only be specified once.");

	arg_idx = arg_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	call forum_requests_$open_forum (arg, forum_idx, forum_dir, forum_name, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);

	temp_forum = "1"b;
	if forum_idx < 0 then
	     full_forum_name = rtrim (forum_name) || ".forum";
	else full_forum_name = rtrim (forum_name) || ".control";
	return;

     end get_forum;
%page;
get_subject:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	if subject_arg_ptr ^= null ()
	then call ssu_$abort_line (ssu_ptr, 0, "Only one ""-subject"" may be specified.");

	arg_idx = arg_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, subject_arg_ptr, subject_arg_len);

	subject_arg_len = length (rtrim (subject_arg, WHITE_CHARS));
	idx = verify (subject_arg, WHITE_CHARS) - 1;
	if idx < 0 then idx = 0;
	subject_arg_len = subject_arg_len - idx;
	subject_arg_ptr = add_char_offset_ (subject_arg_ptr, idx);

	if subject_arg_len = 0 then call ssu_$abort_line (ssu_ptr, 0, "The subject field may not be blank.");

	return;

     end get_subject;

ask_subject:
     procedure ();

	no_chars_read, first_nonwhite_pos = 0;
	do while (no_chars_read <= first_nonwhite_pos);
	     call get_line ("Subject:  ");
	end;

	call allocate_transaction (subject, "", inhibit_auto_fill);

	return;

     end ask_subject;

add_to_subject:
     procedure ();

	if buffer_ptr = null () then do;
		buffer_len = 256;
		allocate buffer in (forum_area);
	     end;

	do while (subject_arg_len + arg_len + 1 > buffer_len);
	     call make_bigger_buffer (subject_arg_len);
	end;

	buffer = substr (buffer, 1, subject_arg_len) || arg || " ";
	subject_arg_len = subject_arg_len + arg_len + 1;

	return;
     end add_to_subject;
%page;
process_transaction:
     procedure ();

	if forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	if user_file_ptr ^= null () & terminal_switch then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-input_file"" and ""-terminal_input""");

	if user_file_ptr ^= null () then
	     if auto_rql then request_loop = "1"b;
	     else ;
	else auto_rql = "0"b;

	if fill_switch = 0 then
	     if user_file_ptr ^= null () | ^passport.talk_fill then fill_switch = -1;
	     else fill_switch = 1;

	if passport.unprocessed_trans_ptr ^= null ()
	then if user_file_ptr ^= null () & ^request_loop
	     then forum_user_trans_ptr = null ();	/* Don't affect unprocessed in this case. */
	     else if ^force then do;
		     query_info.version = query_info_version_5;
		     query_info.suppress_name_sw = ""b;
		     query_info.yes_or_no_sw = "1"b;
		     call command_query_ (addr (query_info), answer, whoami_really,
			"A previous unprocessed transaction has not been entered.^/Do you wish to overwrite it?");
		     if answer = "no" then call ssu_$abort_line (ssu_ptr);
		end;

	inhibit_auto_fill = (fill_switch < 0);

	if ^message_sw then do;
		if ^brief_switch & passport.print_message then do;
			call forum_$get_message (forum_idx, message, status);
			if status = 0 then call ioa_$nnl ("^a", message);
			passport.print_message = "0"b;
		     end;

		if reply_switch then call print_subject ("", inhibit_auto_fill);
		else if subject_arg_ptr ^= null () then call allocate_transaction (subject_arg, "", inhibit_auto_fill);
		else call ask_subject ();
	     end;
	else call allocate_transaction ((""), (""), inhibit_auto_fill);

	if user_file_ptr ^= null () then do;
		call allocate_transaction (forum_user_trans.subject, user_file, forum_user_trans.unfilled);
		if ^request_loop then call enter_the_transaction ();
		if auto_rql then
		     call ioa_ ("Use the ""enter"" request to enter the ^[message^;transaction^].", message_sw);
	     end;

	else call build_transaction ();

	return;

     end process_transaction;
%page;
print_subject:
     procedure (P_text, P_inhibit_auto_fill);

	declare P_text		 char (*),
	        P_inhibit_auto_fill	 bit (1) aligned,
	        p			 ptr;


/* If -subject given in "reply" request, then override default subject specification.  We needn't tell him, he knows.	*/

	if subject_arg_len > 0 then do;
		call allocate_transaction (subject_arg, P_text, P_inhibit_auto_fill);
		return;
	     end;

/* Now read out the forum to reply to so we can get its subject.  Transaction is always from current meeting*/

	call forum_trans_util_$read_trans (passport_info_ptr, passport.forum_idx, reply_trans_idx, p, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Transaction #^d.", reply_trans_idx);

/* If the unprocessed transaction has no associated forum_name, repair damage done by "subject -unthread".		*/

	if forum_name = "" then do;
		forum_dir = passport.forum_dir;
		full_forum_name = passport.forum_name;
		forum_name = no_suffix_name;
	     end;

/* If subject already begins with "Re: " then we shouldn't add another one.					*/

	if substr (p -> forum_user_trans.subject, 1, min (4, p -> forum_user_trans.subject_length)) = "Re: "
	then call allocate_transaction (p -> forum_user_trans.subject, P_text, P_inhibit_auto_fill);
	else call allocate_transaction ("Re: " || p -> forum_user_trans.subject, P_text, P_inhibit_auto_fill);

/* OK, now we can tell the user what the subject is. */

	call ioa_ ("Subject:  ^a", forum_user_trans.subject);

	return;

     end print_subject;
%page;
build_transaction:					/* Internal procedure to handle interactive 'talk' requests */
     procedure ();

	declare termination_type	 fixed bin;

	call get_temp_segment_ (whoami_really, temp_seg_ptr, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting temp segment.");

	call ipc_$cutoff (passport.public_channel, (0));

	call ioa_ ("^[Message^;Transaction^]:", message_sw);

	termination_type = add_lines ();

	if termination_type = ENTER_EDITOR then call enter_the_editor ();

	if termination_type = ENTER_REQUEST_LOOP & no_chars_read > first_nonwhite_pos + 2
	then do;
		first_nonwhite_pos = first_nonwhite_pos + 2;
		if substr (buffer, no_chars_read, 1) = NL then no_chars_read = no_chars_read - 1;
		if no_chars_read = first_nonwhite_pos then ;
		else if translate (substr (buffer, first_nonwhite_pos + 1, no_chars_read - first_nonwhite_pos),
		     LOWER_CASE, UPPER_CASE) = "nf"
		then forum_user_trans.unfilled = "1"b;
		else call ssu_$print_message (ssu_ptr, 0, "Characters following ""q"" ignored.");
	     end;

	call clean_up_talk ();

	if termination_type = NORMAL_TERMINATION & ^request_loop then call enter_the_transaction ();

	return;

     end build_transaction;
%page;
add_lines:
     procedure () returns (fixed bin);

	declare idx		 fixed bin (21),
	        quote_switch	 bit (1) aligned,
	        second_char		 char (1) based (addr (substr (buffer, first_nonwhite_pos + 2))),
	        third_char		 char (1) based (addr (substr (buffer, first_nonwhite_pos + 3)));

	quote_switch = "0"b;
	text_len = 0;
	do while ("1"b);
	     call get_line ("");
	     if no_chars_read = 2
	     then if substr (buffer, 1, 2) = "." || NL then return (NORMAL_TERMINATION);

	     first_nonwhite_pos = 0;
	     idx = index (substr (buffer, 1, no_chars_read), "\") - 1;
	     do while (idx >= 0);
		if idx > 0 then call add_to_trans (buffer, first_nonwhite_pos, idx);

		if quote_switch | no_chars_read - first_nonwhite_pos < 2 then
		     call add_to_trans (buffer, first_nonwhite_pos, 1);
		else if second_char = "c" | second_char = "C" then do;
			first_nonwhite_pos = first_nonwhite_pos + 2;
			quote_switch = "1"b;
		     end;
		else if second_char = "q" | second_char = "Q" then return (ENTER_REQUEST_LOOP);
		else if second_char = "f" | second_char = "F" then do;
			if idx ^= 0 then text_len = text_len - 1; /* In this case, the new line goes on the request */
			if no_chars_read - first_nonwhite_pos < 3 then return (ENTER_EDITOR);
			else if third_char ^= "q" & third_char ^= "Q" then return (ENTER_EDITOR);
			else do;
				first_nonwhite_pos = first_nonwhite_pos + 1;
				return (ENTER_REQUEST_LOOP);
			     end;
		     end;
		else call add_to_trans (buffer, first_nonwhite_pos, 1);

		idx = index (substr (buffer, first_nonwhite_pos + 1, no_chars_read - first_nonwhite_pos), "\") - 1;
	     end;

	     call add_to_trans (buffer, first_nonwhite_pos, no_chars_read - first_nonwhite_pos);
	end;

add_to_trans:
     procedure (buffer, pos, len);

	declare buffer		 char (*),
	        pos		 fixed bin (21),
	        len		 fixed bin (21);

	substr (temp_seg, text_len + 1, len) = substr (buffer, pos + 1, len);
	text_len = text_len + len;
	first_nonwhite_pos = first_nonwhite_pos + len;
	quote_switch = "0"b;

	return;
     end add_to_trans;

     end add_lines;
%page;
/* This procedure is used for the subject prompt and by the talk and reply requests to read in a transaction.
   It returns its results in the global variables buffer, no_chars_read, and first_nonwhite_pos.  It removes
   the trailing newline from the line, if any, and trims off trailing whitespace.  It optionally accepts the
   ".." escape to execute command lines while doing input.  The ".." must be the first white characters on the
   line.  The ".." is always accepted when the prompt field is nonblank; otherwise the "value" variable
   "forum.input_cp_escape" is consulted.								*/

get_line:
     procedure (prompt);

	declare prompt		 char (*),
	        newline		 bit (1) aligned;

	do while ("1"b);
	     call read_a_line ();

	     newline = "0"b;			/* Now hack off whitespace */
	     if substr (buffer, no_chars_read, 1) = NL
	     then do;
		     newline = "1"b;
		     no_chars_read = no_chars_read - 1;
		end;
	     no_chars_read = length (rtrim (substr (buffer, 1, no_chars_read), SPACE_AND_TAB));
	     if newline & prompt = ""
	     then do;
		     substr (buffer, no_chars_read + 1, 1) = NL;
		     no_chars_read = no_chars_read + 1;
		end;

	     first_nonwhite_pos = verify (substr (buffer, 1, no_chars_read), WHITE_CHARS) - 1;
	     if first_nonwhite_pos < 0
	     then do;
		     first_nonwhite_pos = no_chars_read;
		     return;			/* Line is blank.  Can't contain command processeor escape. */
		end;

	     if no_chars_read - first_nonwhite_pos < 2 then return;
	     if substr (buffer, first_nonwhite_pos + 1, 2) ^= ".." then return;

	     if prompt = ""
	     then if ^input_cp_escape_allowed () then return;

	     call cu_$cp (add_char_offset_ (addr (buffer), first_nonwhite_pos + 2),
		no_chars_read - first_nonwhite_pos - 2, (0));

	     if prompt = "" then call ioa_ ("Please continue entering your ^[reply^;transaction^].", reply_switch);
	end;
%page;
/* The following internal procedure of get_line actually reads an entire line into a buffer.  This is done as
   a separate level to compensate for the losing I/O system behavior when the input buffer is too small.		*/

read_a_line:
     procedure ();

	declare long_record		 bit (1) aligned,
	        no_new_chars_read	 fixed bin (21);

	if buffer_ptr = null ()
	then do;
		buffer_len = 256;
		allocate buffer in (forum_area);
	     end;

	long_record = "0"b;
	no_chars_read = 0;
	do while (long_record | no_chars_read = 0);

	     if prompt ^= "" & ^long_record then call ioa_$nnl (prompt);

	     call iox_$get_line (iox_$user_input, add_char_offset_ (buffer_ptr, no_chars_read),
		buffer_len - no_chars_read, no_new_chars_read, status);
	     no_chars_read = no_chars_read + no_new_chars_read;
	     if status = 0 then long_record = "0"b;
	     else if status ^= error_table_$long_record then call ssu_$abort_line (ssu_ptr, status);
	     else do;
		     call make_bigger_buffer (no_chars_read);
		     long_record = "1"b;
		end;
	end;

	return;

     end read_a_line;

     end get_line;

make_bigger_buffer:
     proc (copy_len);

	declare copy_len		 fixed bin (21);

	new_buffer_len = 2 * buffer_len;
	allocate new_buffer in (forum_area);
	substr (new_buffer, 1, copy_len) = substr (buffer, 1, copy_len);
	free buffer;
	buffer_ptr = new_buffer_ptr;
	buffer_len = new_buffer_len;
	new_buffer_ptr = null ();

	return;
     end make_bigger_buffer;
%page;
input_cp_escape_allowed:
     procedure () returns (bit (1) aligned);

	declare tf_string		 char (5);

	if inhibit_input_cp_escape then return ("0"b);

	call value_$get (null (), "11"b, rtrim (my_person_id) || ".forum.input_cp_escape", tf_string, status);
	if status ^= 0
	then if status ^= error_table_$oldnamerr
	     then return ("0"b);
	     else do;
		     call value_$get (null (), "11"b, "forum.input_cp_escape", tf_string, status);
		     if status ^= 0 then return ("0"b);
		end;

	tf_string = translate (tf_string, LOWER_CASE, UPPER_CASE);

	if tf_string = "true" then return ("1"b);
	if tf_string = "t" then return ("1"b);
	if tf_string = "on" then return ("1"b);
	if tf_string = "yes" then return ("1"b);
	if tf_string = "y" then return ("1"b);

	inhibit_input_cp_escape = "1"b;

	return ("0"b);

     end input_cp_escape_allowed;
%page;
enter_the_editor:
     procedure ();

	first_nonwhite_pos = first_nonwhite_pos + 2;	/* Skip the \f */

	call allocate_transaction (forum_user_trans.subject, temp_text, forum_user_trans.unfilled);
	text_len = -1;

	if standard_default_editor () then call call_qedx (subject);
	else call call_ted (add_char_offset_ (buffer_ptr, first_nonwhite_pos), no_chars_read - first_nonwhite_pos);

	return;
     end enter_the_editor;


standard_default_editor:
     procedure () returns (bit (1) aligned);

	declare editor		 char (4);

	on linkage_error go to USE_QEDX;

	call value_$get (null (), "11"b, rtrim (my_person_id) || ".forum.editor", editor, status);
	if status ^= 0 then
	     if status ^= error_table_$oldnamerr then return ("1"b);
	     else do;
		     call value_$get (null (), "11"b, "forum.editor", editor, status);
		     if status ^= 0 then return ("1"b);
		end;

	editor = translate (editor, LOWER_CASE, UPPER_CASE);

	if editor ^= "ted" then return ("1"b);

	if codeptr (ted_) ^= null () then return ("0"b);	/* Provoke linkage error if possible. */

USE_QEDX:
	return ("1"b);

     end standard_default_editor;
%page;
call_qedx:
     proc (request);

	declare request		 char (*);

	qi.header.version = QEDX_INFO_VERSION_1;
	qi.editor_name = whoami_really;
	string (qi.header.flags) = ""b;
	qi.header.query_if_modified = "1"b;

	qi.buffers (1).buffer_name = "0";
	qi.buffers (1).buffer_pathname = "<forum transaction>";
	qi.buffers (1).region_ptr = temp_seg_ptr;
	qi.buffers (1).region_max_lth = 4 * sys_info$max_seg_size;
	qi.buffers (1).region_initial_lth = forum_user_trans.text_length;
	string (qi.buffers (1).flags) = ""b;
	qi.buffers (1).read_write_region, qi.buffers (1).default_read_ok, qi.buffers (1).default_write_ok,
	     qi.buffers (1).locked_pathname = "1"b;
	qi.buffers (1).auto_write = auto_write;

	if request = "" then qi.n_buffers = 1;
	else do;
		qi.n_buffers = 2;
		qi.buffers (2).buffer_name = "exec";
		qi.buffers (2).buffer_pathname = "";
		qi.buffers (2).region_ptr = addr (request);
		qi.buffers (2).region_max_lth, qi.buffers (2).region_initial_lth = length (rtrim (request));
		string (qi.buffers (2).flags) = ""b;
		qi.buffers (2).read_write_region, qi.buffers (2).execute_buffer = "1"b;
	     end;

	call qedx_ (addr (qi), status);
	if status = error_table_$fatal_error then call ssu_$abort_line (ssu_ptr, 0);

	if qi.buffers (1).region_final_lth > 0 then text_len = qi.buffers (1).region_final_lth;
	else if forum_user_trans.text_length > 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Qedx returned a zero length buffer.  ^[Message^;Transaction^] not replaced.",
		message_sw);

	return;
     end call_qedx;
%page;
call_ted:
     proc (rq_ptr, rq_len);

	declare rq_ptr		 ptr,
	        rq_len		 fixed bin (21),
	        rq		 char (rq_len) based (rq_ptr),
	        path		 char (168),
	        request		 char (2 * 172 + rq_len);

	call hcs_$set_bc_seg (temp_seg_ptr, (9 * forum_user_trans.text_length), (0));
	call hcs_$fs_get_path_name (temp_seg_ptr, dirname, arg_idx, entryname, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status);

	path = substr (dirname, 1, arg_idx) || ">" || rtrim (entryname);
	if ^auto_write then request = "r " || path || NL || "^r " || path || NL || rq;
	else request = rq;

	ted_info.tedname = rtrim (whoami_really);
	ted_info.version = ted_data_version_1;
	ted_info.ted_com_p = addr (request);
	ted_info.ted_com_l = length (rtrim (request));
	ted_info.ted_mode = 0;			/* NORMAL */
	ted_info.arg_list_p, ted_info.return_string_p = null ();
	ted_info.arg_list_1, ted_info.arg_list_n, ted_info.return_string_l = 0;
	ted_info.input_l, ted_info.output_l = 0;
	ted_info.temp_dir = "";

	if auto_write then do;
		ted_info.input_p, ted_info.output_p = temp_seg_ptr;
		ted_info.input_l = forum_user_trans.text_length;
	     end;
	else ted_info.input_p, ted_info.output_p = null ();

	call ted_ (addr (ted_info), status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status);

	if auto_write then text_len = ted_info.output_l;
	else do;
		call hcs_$status_mins (temp_seg_ptr, (0), bit_count, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting bit count.");

		text_len = divide (bit_count, 9, 21, 0);
	     end;

	if text_len = 0 then
	     if forum_user_trans.text_length > 0 then
		call ssu_$abort_line (ssu_ptr, 0, "Ted returned a zero length buffer.  ^[Message^;Transaction^] not replaced.",
		     message_sw);

	return;
     end call_ted;
%page;
forum_input_requests_$enter_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (-1);

	on cleanup call clean_up_talk ();

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	     if arg = "-meeting" | arg = "-mtg"
	     then if reply_trans_idx = 0 | message_sw
		then call get_forum (arg_idx);
		else call ssu_$abort_line (ssu_ptr, 0, "Cannot use -meeting entering a reply or message.");
	     else if arg = "-brief" | arg = "-bf" then brief_switch = "1"b;
	     else if arg = "-long" | arg = "-lg" then brief_switch = "0"b;

	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, """^a""", arg);
	end;

	call enter_the_transaction ();

	call clean_up_talk ();

	return;
%page;
enter_the_transaction:
     procedure ();

	if forum_user_trans.text_length = 0
	then call ssu_$abort_line (ssu_ptr, 0, "Zero-length ^[message^;transaction^] - not entered.", message_sw);

	if forum_user_trans.type = message_type then do;
		call forum_$set_message (forum_idx, forum_user_trans.text, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Message not set.");
		free forum_user_trans;
		passport.unprocessed_trans_ptr = null ();
	     end;

	else do;
		if full_forum_name ^= passport.forum_name then do;
			call forum_$open_forum (forum_dir, full_forum_name, forum_idx, status);
			if status ^= 0 then
			     call ssu_$abort_line (ssu_ptr, status, "Opening ^a^[>^]^a.", forum_dir, forum_dir ^= ">",
				forum_name);
		     end;

		mask = ""b;
		on cleanup begin;
			if substr (mask, 36, 1) then
			     call hcs_$reset_ips_mask (mask, mask);
			call clean_up_talk ();
		     end;

		call hcs_$set_ips_mask (""b, mask);

/* TR20898 & 20899: If entering the trans in another mtg with the use of reply, trans shouldn't be chained;
   therefore, reply_trans_idx which is used previously to get correct subject, has to be set to zero. */

		if reply_switch & (passport.forum_idx ^= forum_idx)
		then reply_trans_idx = 0;

		call forum_$enter_trans (forum_idx, forum_user_trans.text, reply_trans_idx, forum_user_trans.subject,
		     forum_user_trans.unfilled, forum_user_trans.trans_no, status);
		if status ^= 0 then
		     if status = forum_et_$cant_notify then
			call ssu_$print_message (ssu_ptr, status, "The transaction was entered.");
		     else call ssu_$abort_line (ssu_ptr, status, "Transaction not entered.");

		if forum_user_trans_ptr = passport.unprocessed_trans_ptr then passport.unprocessed_trans_ptr = null ();

		call hcs_$reset_ips_mask (mask, mask);

		if ^brief_switch then do;
			trans_pic = forum_user_trans.trans_no;
			call ioa_ ("Transaction [^a] entered in ^a^[>^]^a meeting.", ltrim (trans_pic), forum_dir,
			     forum_dir ^= ">", forum_name);
		     end;

		if forum_idx = passport.forum_idx then forum_user_trans_ptr = null ();

		else do;
			free forum_user_trans;
			call forum_$close_forum (forum_idx, (0));
			forum_idx = passport.forum_idx;
			passport.unprocessed_forum_dir = "";
			passport.unprocessed_forum_name = "";
			passport.unprocessed_reply_trans = 0;
		     end;
	     end;

	return;

     end enter_the_transaction;
%page;
/* This routine allocates a transaction, possibly replacing in a race-free way the currently allocated transaction.	*/

allocate_transaction:
     procedure (P_subject, P_text, P_fill_trans);

	declare P_subject		 char (*),
	        P_text		 char (*),
	        P_fill_trans	 bit (1) aligned,
	        p			 ptr,
	        saved_forum_user_trans_ptr ptr;

	alloc_subject_length = length (rtrim (P_subject, WHITE_CHARS));
	alloc_text_length = length (rtrim (P_text, WHITE_CHARS));
	if alloc_text_length > 0 then alloc_text_length = alloc_text_length + 1;

	saved_forum_user_trans_ptr = forum_user_trans_ptr;
	p = null ();
	on cleanup
	     begin;
		if p ^= null ()
		then if p ^= forum_user_trans_ptr then free p -> forum_user_trans;
		     else if saved_forum_user_trans_ptr ^= null ()
		     then if saved_forum_user_trans_ptr = passport.unprocessed_trans_ptr
			then free passport.unprocessed_trans_ptr -> forum_user_trans;
			else free saved_forum_user_trans_ptr -> forum_user_trans;
	     end;

	allocate forum_user_trans in (forum_area) set (p);

	if message_sw then p -> forum_user_trans.type = message_type;
	else p -> forum_user_trans.type = user_trans_type;
	p -> forum_user_trans.person_id = my_person_id;
	p -> forum_user_trans.project_id = my_project_id;
	p -> forum_user_trans.next_trans_ptr, p -> forum_user_trans.prev_trans_ptr = null ();
	p -> forum_user_trans.unfilled = P_fill_trans;

	p -> forum_user_trans.subject = substr (P_subject, 1, alloc_subject_length);

	if alloc_text_length > 0
	then do;
		substr (p -> forum_user_trans.text, 1, alloc_text_length - 1) =
		     substr (P_text, 1, alloc_text_length - 1);
		substr (p -> forum_user_trans.text, alloc_text_length, 1) = NL;
	     end;

	forum_user_trans_ptr = p;

	text_len = -1;

	if saved_forum_user_trans_ptr ^= null ()
	then if saved_forum_user_trans_ptr = passport.unprocessed_trans_ptr
	     then free passport.unprocessed_trans_ptr -> forum_user_trans;
	     else free saved_forum_user_trans_ptr -> forum_user_trans;

	return;

     end allocate_transaction;
%page;
forum_input_requests_$subject_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (-1);
	if message_sw then call ssu_$abort_line (ssu_ptr, 0, "Messages do not have subjects.");

	if arg_count = 0 then
	     if return_arg_ptr ^= null () then do;
		     return_arg = requote_string_ (forum_user_trans.subject);
		     return;
		end;
	     else do;
		     call ioa_ ("Subject: ^a", forum_user_trans.subject);
		     return;
		end;

	if return_arg_ptr ^= null () then call ssu_$abort_line (ssu_ptr, 0, "Usage:  [sj]");

	on cleanup call clean_up_talk ();

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	     if index (arg, "-") = 1 & ^subject_switch then
		if arg = "-default" then default_switch = "1"b;
		else if arg = "-subject" | arg = "-sj" then subject_switch = "1"b;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	     else call add_to_subject ();
	end;
	subject_arg_ptr = buffer_ptr;

	if default_switch & buffer_ptr ^= null () then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "You cannot give both a subject and -default.");

	if default_switch & reply_trans_idx = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "-default may only be used with replies.");

	if default_switch then do;
		if forum_idx = 0 then do;
			call forum_$open_forum (forum_dir, full_forum_name, forum_idx, status);
			if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Opening ^a>^a", forum_dir, forum_name);
		     end;
		call print_subject (forum_user_trans.text, forum_user_trans.unfilled);
	     end;

	else if subject_arg_len > 0 then
	     call allocate_transaction (subject_arg, forum_user_trans.text, forum_user_trans.unfilled);
	else if subject_arg_ptr ^= null () then
	     call ssu_$abort_line (ssu_ptr, 0, "The subject field may not be blank.");

	call clean_up_talk ();

	return;
%page;
forum_input_requests_$fill_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (-1);

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	     if index (arg, "-") = 1 then
		if arg = "-line_length" | arg = "-ll" then do;
			arg_idx = arg_idx + 1;
			call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

			line_length = cv_dec_check_ (arg, status);
			if status ^= 0
			then call ssu_$abort_line (ssu_ptr, error_table_$bad_conversion, "^a", arg);
		     end;
		else if arg = "-on" then fill_switch = 1;
		else if arg = "-off" then fill_switch = -1;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	     else call ssu_$abort_line (ssu_ptr, 0, "Usage:  fill {-control_args}");
	end;

	if fill_switch ^= 0 then do;
		forum_user_trans.unfilled = (fill_switch < 0);
		return;
	     end;

	if line_length < 10 | line_length > 136 then
	     call ssu_$abort_line (ssu_ptr, 0, "Invalid line length.  ^d", line_length);

	on cleanup call clean_up_talk ();

	text_len = forum_user_trans.text_length;

	if forum_user_trans.unfilled then do;
		call fill_the_transaction (forum_user_trans.text);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Filling transaction.");
	     end;
	else call unpack_trans_to_temp_seg ();		/* clean up talk will fill it */

	call clean_up_talk ();
	return;
%page;
forum_input_requests_$apply_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	declare new_unpro_trans	 bit (1);

	call setup_request (2);

	if arg_count = 0 then
APPLY_USAGE:   call ssu_$abort_line (ssu_ptr, 0, "Usage:  apply {trans_specs} {-control_args} command_line");

	on cleanup call clean_up_apply ();
						/* TR20579 & 20810: apply can create unproc trans */
	parse_flags_word = DISALLOW_MTG | DEFAULT_TO_UNPROC | DISALLOW_CMSG | CALL_ON_BAD_ARGS | CREATE_UNPROC;
	arg_idx = 0;

	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, apply_args, (0), "", "",
	     forum_trans_list_ptr);
	if arg_idx = 0 then call ssu_$abort_line (ssu_ptr, 0, "No command line given.");

	new_unpro_trans = "0"b;

/* TR20579: If no unproc trans and no trans_specs given, create new unproc trans */

	if (passport.unprocessed_trans_ptr = null () & forum_trans_list.size = 0) then do;
		forum_trans_list.size = 1;
		forum_trans_list.trans_num (1) = 0;	/* force to unproc instead of using current trans */
		new_unpro_trans = "1"b;
	     end;

	do idx = 1 to forum_trans_list.size;

	     if forum_trans_list.trans_num (idx) = 0 then do; /* if unproc */
		     forum_user_trans_ptr = passport.unprocessed_trans_ptr;
		     reply_trans_idx = passport.unprocessed_reply_trans;
		     if forum_user_trans_ptr ^= null () then
			message_sw = (forum_user_trans.type = message_type);
		     if passport.read_only then
			call ssu_$abort_line (ssu_ptr, forum_et_$read_only);
		end;
	     else do;
		     call forum_trans_util_$read_trans (passport_info_ptr, forum_idx, forum_trans_list.trans_num (idx),
			forum_user_trans_ptr, status);
		     if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Reading transaction ^d.",
			     forum_trans_list.trans_num (idx));
		end;

	     call unpack_trans_to_temp_seg ();
	     call ssu_$apply_request_util (ssu_ptr, arg_idx, temp_seg_ptr, forum_user_trans.text_length, text_len);

	     if forum_trans_list.trans_num (idx) = 0 then do;
		     if text_len = 0 then call ssu_$abort_line (ssu_ptr, 0,
			     "Command returned a zero length file.  ^[Message^;Transaction^] not replaced.", message_sw);

		     if ^forum_user_trans.unfilled & fill_switch >= 0 then begin;

			     declare text		      char (text_len);
			     text = temp_text;
			     call fill_the_transaction (text);
			end;
		     if status = 0 then do;
			     call allocate_transaction (forum_user_trans.subject, temp_text, forum_user_trans.unfilled);
			     passport.unprocessed_trans_ptr = forum_user_trans_ptr;
			     passport.unprocessed_reply_trans = reply_trans_idx;
						/* TR20578: If new_unproc_trans, generate correct meeting_name */
			     if new_unpro_trans then do;
				     passport.unprocessed_forum_dir = forum_dir;
				     passport.unprocessed_forum_name = full_forum_name;
				     passport.unprocessed_name_len = length (rtrim (forum_name));
				     new_unpro_trans = "0"b;
				end;
			end;
		     text_len = -1;			/* prevent cleanup from doing it again */
		     forum_user_trans_ptr = null ();
		end;
	end;

	call clean_up_apply ();

	return;
%page;
apply_args:
     proc (P_arg_idx);

	declare P_arg_idx		 fixed bin;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if index (arg, "-") = 1 then
	     if arg = "-fill" | arg = "-fi" then fill_switch = 1;
	     else if arg = "-no_fill" | arg = "-nfi" then fill_switch = -1;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	else do;
		arg_idx = P_arg_idx;
		P_arg_idx = arg_count + 1;
	     end;

	return;
     end apply_args;


clean_up_apply:
     proc ();

	if forum_trans_list_ptr ^= null () then free forum_trans_list;
	if passport.unprocessed_trans_ptr = forum_user_trans_ptr then call clean_up_talk ();

	if temp_seg_ptr ^= null () then call release_temp_segment_ (whoami_really, temp_seg_ptr, (0));

	return;
     end clean_up_apply;
%page;
forum_input_requests_$qedx_request:			/* Entry to enter qedx */
     entry (P_ssu_ptr, P_passport_info_ptr);

	call editor_request ("1"b);

	return;


forum_input_requests_$ted_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	on linkage_error
	     call ssu_$abort_line (ssu_ptr, 0, "The ""ted"" editor appears not to be available at this site.");

	if codeptr (ted_) = null () then return;	/* Provoke linkage_error if possible. */

	revert linkage_error;

	call editor_request ("0"b);
	return;

editor_request:
     proc (qedx_switch);

	declare qedx_switch		 bit (1) aligned;

	call setup_request (0);

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-fill" | arg = "-fi" then fill_switch = 1;
		else if arg = "-no_fill" | arg = "-nfi" then fill_switch = -1;
		else if arg = "-auto_write" then auto_write = "1"b;
		else if arg = "-no_auto_write" then auto_write = "0"b;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	     else call ssu_$abort_line (ssu_ptr, 0, "Usage:  ^[qx^;ted^] {-control_args}", qedx_switch);
	end;

	on cleanup call clean_up_talk ();

	call unpack_trans_to_temp_seg ();

	call ipc_$cutoff (passport.public_channel, (0));

	if qedx_switch then call call_qedx ("");
	else call call_ted (null (), (0));

	call clean_up_talk ();

	return;
     end editor_request;
%page;
unpack_trans_to_temp_seg:
     procedure ();

	if forum_user_trans_ptr = null () then do;
		if passport.forum_idx = 0 then
		     call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
		call ask_subject ();
	     end;

	if temp_seg_ptr = null () then do;
		call get_temp_segment_ (whoami_really, temp_seg_ptr, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting temp segment.");
	     end;

	substr (temp_seg, 1, forum_user_trans.text_length) = forum_user_trans.text;

	return;

     end unpack_trans_to_temp_seg;


fill_the_transaction:
     proc (transaction);

	declare transaction		 char (*);

	if temp_seg_ptr = null () then do;
		call get_temp_segment_ (whoami_really, temp_seg_ptr, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting temp segment.");
	     end;

	fdoc.version_number = format_document_version_2;
	fdoc.indentation = 0;
	fdoc.line_length = line_length;
	string (fdoc.switches) = ""b;
	fdoc.galley_sw, fdoc.literal_sw, fdoc.dont_break_indented_lines_sw = "1"b;
	fdoc.syllable_size = 3;			/* Make fdoc happy */
	call format_document_$string (transaction, temp_seg, text_len, addr (fdoc), status);
	if status = error_table_$recoverable_error then status = 0;

	return;
     end fill_the_transaction;
%page;
clean_up_talk:
     procedure ();

	declare p			 ptr;

	status = 0;
	if new_buffer_ptr ^= null () then free new_buffer;
	if buffer_ptr ^= null () then free buffer;

	if forum_trans_list_ptr ^= null () then free forum_trans_list;
	if forum_idx ^= passport.forum_idx then call forum_$close_forum (forum_idx, (0));

	if user_file_ptr ^= null () then do;
		p = user_file_ptr;
		user_file_ptr = null ();
		call hcs_$terminate_noname (p, (0));
		if forum_user_trans_ptr ^= null () then
		     if ^forum_user_trans.unfilled & fill_switch >= 0 then do;
			     call fill_the_transaction (forum_user_trans.text);
			     if status = 0 then
				call allocate_transaction (forum_user_trans.subject, temp_text, forum_user_trans.unfilled);
			     call release_temp_segment_ (whoami_really, temp_seg_ptr, (0));
			end;
	     end;

	if temp_seg_ptr ^= null () then do;
		if text_len >= 0 then do;
			if ^forum_user_trans.unfilled & fill_switch >= 0 then begin;

				declare text		 char (text_len);
				text = temp_text;
				call fill_the_transaction (text);
			     end;
			if status = 0 then
			     call allocate_transaction (forum_user_trans.subject, temp_text, forum_user_trans.unfilled);
		     end;
		call release_temp_segment_ (whoami_really, temp_seg_ptr, (0));
	     end;

	if forum_user_trans_ptr ^= null then do;
		if passport.unprocessed_trans_ptr ^= forum_user_trans_ptr & passport.unprocessed_trans_ptr ^= null () then
		     free passport.unprocessed_trans_ptr -> forum_user_trans;

		passport.unprocessed_trans_ptr = forum_user_trans_ptr;
		passport.unprocessed_reply_trans = reply_trans_idx;
		passport.unprocessed_forum_dir = forum_dir;
		passport.unprocessed_forum_name = full_forum_name;
		passport.unprocessed_name_len = length (rtrim (forum_name));
	     end;

	call ipc_$reconnect (passport.public_channel, (0));

	return;

     end clean_up_talk;
%page;
setup_request:
     procedure (P_new_trans_switch);

	declare P_new_trans_switch	 fixed bin;

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;

	whoami = ssu_$get_request_name (ssu_ptr);
	whoami_really = ssu_$get_subsystem_and_request_name (ssu_ptr);
	buffer_ptr, forum_trans_list_ptr, new_buffer_ptr, subject_arg_ptr, temp_seg_ptr, user_file_ptr = null ();
	brief_switch, default_switch, force, inhibit_auto_fill, inhibit_input_cp_escape, request_loop = "0"b;
	fill_switch, subject_arg_len = 0;
	if passport.input_fill_width ^= 0 then line_length = passport.input_fill_width;
	else line_length = 72;
	forum_idx = passport.forum_idx;
	text_len = -1;
	message_sw, subject_switch, temp_forum, terminal_switch = "0"b;
	auto_write = passport.auto_write;

	if P_new_trans_switch = 1 & passport.read_only then
	     call ssu_$abort_line (ssu_ptr, forum_et_$read_only);

	if P_new_trans_switch > 0 | (passport.unprocessed_trans_ptr = null () & P_new_trans_switch = 0) then do;
		forum_user_trans_ptr = null ();
		if passport.forum_idx = 0 then forum_dir, full_forum_name, forum_name = "";
		else do;
			forum_dir = passport.forum_dir;
			full_forum_name = passport.forum_name;
			forum_name = no_suffix_name;
		     end;
		reply_trans_idx = 0;
	     end;

	else if passport.unprocessed_trans_ptr = null () then
	     call ssu_$abort_line (ssu_ptr, forum_et_$no_unprocessed);

	else do;
		forum_user_trans_ptr = passport.unprocessed_trans_ptr;
		forum_dir = passport.unprocessed_forum_dir;
		full_forum_name = passport.unprocessed_forum_name;
		forum_name = substr (passport.unprocessed_forum_name, 1, passport.unprocessed_name_len);
		reply_trans_idx = passport.unprocessed_reply_trans;
		message_sw = (forum_user_trans.type = message_type);
	     end;

	if ^static_initialized then do;
		call user_info_$whoami (my_person_id, my_project_id, (""));
		static_initialized = "1"b;
	     end;

	call ssu_$return_arg (ssu_ptr, arg_count, ("0"b), return_arg_ptr, return_arg_len);

	return;

     end setup_request;

     end forum_input_requests_$talk_request;
  



		    forum_list_meetings.pl1         02/16/88  1456.2r w 02/16/88  1411.9      311607


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added -count to next_meeting, added -from and -exclude to check_meetings.
     Made check_meetings save meeting list pointer.
     Check for duplicates in search list.
                                                   END HISTORY COMMENTS */


/* forum_list_meetings

   Originally written:  May 1980          ML Auerbach
   Extensively revised: 2 December 1980   MLA
   Modified 29 May 1981 by J. Spencer Love to update to current programming standards and add features.
   Modified 13 June 1981 by J. Spencer Love to call gate, implement -inhibit_error, and add forum_list_request entry.
   Modified 08/21/81 Jay Pattin for ssu_, renamed it to con_list_meetings
   Modified 01/21/82 Jay Pattin renamed forum_list and added -chairman, -participating, -verbose
   Modified 02/17/82 Jay Pattin for ssu_$standalone_invocation RAH RAH
   Modified 3/26/82 Jay Pattin back to forum_list_meetings
   Modified 5/5/82 Jay Pattin added read only stuff
   Modified 5/31/82 Jay Pattin added -nnt, -npart, -nchg
   Modified 8/6/82 Jay Pattin for better error reporting
   Modified 9/24/82 Jay Pattin for real pathnames and -from, -adj, nadj
   Modified 6/2/83 Jay Pattin to add check_meetings and next_meeting
   Modified 12/6/85 Jay Pattin nm -count, timing stuff, duplication checking
*/

forum_list_meetings:
flsm:
     procedure () options (variable);

declare	(P_ssu_ptr, P_passport_info_ptr)
				ptr parameter;

declare	(addr, addrel, after, before, binary, clock, currentsize, divide, length, max, min, null, rtrim, substr)
				builtin;

declare	cleanup			condition;

declare	absolute_pathname		bit (1) aligned,
	access_name		char (32),
	access_time		fixed bin (71),
	active_function		bit (1) aligned,
	adjourned			bit (1) aligned,
	all_switch		bit (1) aligned,
	any_person		bit (1) aligned,
	arg			character (arg_lth) based (arg_ptr) unal,
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_lth			fixed bin (21),
	arg_ptr			ptr,
	before_time		fixed bin (71),
	brief_switch		bit (1) aligned,
	chairman_switch		bit (1) aligned,
	chairman_expected		bit (1) aligned,
	chair_width		fixed bin,
	ckm_switch		bit (1) aligned,
	count_switch		bit (1) aligned,
	cpu			fixed bin (71),
	dir_idx			fixed bin,
	change_switch		bit (1) aligned,
	cm_username		char (20),
	eligible_switch		bit (1) aligned,
	exclude_switch		bit (1) aligned,
	explicit			bit (1) aligned,
	header_switch		bit (1) aligned,
	i			fixed bin,
	inhibit_error		bit (1) aligned,
	interesting_switch		bit (1) aligned,
	j			fixed bin,
	forum_directory		char (168),
	last_cpu			fixed bin (71),
	last_pf			fixed bin,
	last_seen_pic		pic "zz9999",
	last_trans_pic		pic "zz9999",
	message			char (48),
	name_width		fixed bin,
	no_adjourned		bit (1) aligned,
	noheader_switch		bit (1) aligned,
     	no_read_only		bit (1) aligned,
     	no_changes		bit (1) aligned,
     	no_participate		bit (1) aligned,
     	no_notify			bit (1) aligned,
	notify_switch		bit (1) aligned,
	obj_name_count		fixed bin,
	obj_name_idx		fixed bin,
	participate_switch		bit (1) aligned,
	page_faults		fixed bin,
	read_only			bit (1) aligned,
	request			char (256),
	return_string		char (rtn_string_length) varying based (rtn_string_ptr),
	rtn_string_length		fixed bin (21),
	rtn_string_ptr		ptr,
	select_names_ptr		ptr,
	short_name_width		fixed bin,
	status			fixed bin (35),
	subsystem_entry		bit (1) aligned,
	ssu_ptr			ptr,
     	system_area		area based (system_area_ptr),
	system_area_ptr		ptr,
	timing			bit (1) aligned,
	uid_array			(200) bit (36) aligned,
	uid_count			fixed bin,
	user_name_expected		bit (1) aligned,
	user_name_given		bit (1) aligned,
	verbose_switch		bit (1) aligned,
	whoami			char (32);

declare	1 select_names		aligned based (select_names_ptr),
	  2 no_names		fixed bin,
	  2 pad			bit (36) aligned,
	  2 array			(0 refer (select_names.no_names)),
	    3 forum_names		char (32) unaligned,
	    3 exclude		bit (1) aligned,
	    3 star_name		bit (1) aligned,
	    3 matched		bit (1) aligned;

declare	1 fi			aligned like forum_info;

declare	(
	forum_et_$no_such_forum,
	forum_et_$not_eligible,
	error_table_$badopt,
	error_table_$inconsistent,
	error_table_$noarg,
	error_table_$nomatch
	)			fixed bin (35) external;

declare	active_fnc_err_		entry () options (variable),
	check_star_name_$entry	entry (char (*), fixed bin (35)),
	com_err_			entry () options (variable),
     	convert_date_to_binary_	entry (char (*), fixed bin (71), fixed bin (35)),
	cpu_time_and_paging_	entry (fixed bin, fixed bin(71), fixed bin),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin (21)) returns (fixed bin (35)),
	cu_$arg_list_ptr		entry () returns (ptr),
	forum_$forum_info		entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35)),
	forum_$get_forum_path	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	get_system_free_area_	entry () returns (ptr),
	get_temp_segment_		entry (char (*), ptr, fixed bin (35)),
	hcs_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	hcs_$star_dir_list_		entry (char (*), char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr,
				fixed bin (35)),
	ioa_			entry () options (variable),
	match_star_name_		entry (char (*), char (*), fixed bin (35)),
	release_temp_segment_	entry (char (*), ptr, fixed bin (35)),
	requote_string_		entry (char (*)) returns (char (*)),
	search_paths_$get		entry (char (*), bit (36), char (*), ptr, ptr, fixed bin, ptr, fixed bin (35)),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin (21)),
	ssu_$abort_line		entry options (variable),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$execute_line		entry (ptr, ptr, fixed bin (21), fixed bin (35)),
	ssu_$print_message		entry options (variable),
	ssu_$return_arg		entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)),
	ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)),
	user_info_$whoami		entry (char (*),char (*), char (*));
%page;
%include forum_info;
%page;
%include forum_meeting_list;
%page;
%include sl_info;
%page;
%include sl_control_s;
%page;
%include star_structures;
%page;
	subsystem_entry, ckm_switch = "0"b;

	whoami = "forum_list_meetings";
	call create_subsystem ();
	go to FLS_COMMON;


forum_list_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	whoami = "list_meetings";
	subsystem_entry = "1"b;
	ckm_switch = "0"b;
	goto FLS_COMMON;

forum_check_meetings:
fckm:	entry;

	whoami = "forum_check_meetings";
	subsystem_entry = "0"b;
	ckm_switch = "1"b;
	call create_subsystem ();
	goto FLS_COMMON;

check_meetings:
	entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	whoami = "check_meetings";
	subsystem_entry = "1"b;
	ckm_switch = "1"b;
	goto FLS_COMMON;
%page;
FLS_COMMON:

	absolute_pathname, all_switch, any_person, brief_switch, change_switch, count_switch, eligible_switch,
	     exclude_switch, interesting_switch, noheader_switch, notify_switch, user_name_expected,
	     read_only, no_read_only, no_notify, no_participate, no_changes, adjourned, no_adjourned, timing,
	     chairman_switch, chairman_expected, user_name_given, participate_switch, verbose_switch = "0"b;

	inhibit_error, header_switch = "1"b;
	cm_username = "";
	access_time, before_time, name_width, short_name_width, chair_width, uid_count = 0;

	if ckm_switch then change_switch, count_switch, brief_switch, noheader_switch = "1"b;

	select_names_ptr, sl_info_p, star_list_branch_ptr, star_list_names_ptr = null ();
	on cleanup call clean_up ();

	call get_temp_segment_ (whoami, select_names_ptr, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting temp_segment.");
	select_names.no_names = 0;

	call ssu_$return_arg (ssu_ptr, arg_count, active_function, rtn_string_ptr, rtn_string_length);

	do arg_idx = 1 to arg_count;

	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_lth);

	     if user_name_expected then call get_user_name ("0"b);

	     else if substr (arg, 1, min (arg_lth, 1)) ^= "-" then do;
		if chairman_expected then call get_user_name ("1"b);
		else do;
		     call get_select_name ();
		     chairman_expected = "0"b;
		end;
	     end;

	     else if arg = "-exclude" | arg = "-ex" then exclude_switch = "1"b;
	     else if arg = "-from" | arg = "-fm" then do;
		if arg_idx = arg_count then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		arg_idx = arg_idx + 1;
		call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_lth);
		call convert_date_to_binary_ (arg, access_time, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);
		change_switch = "1"b;
	     end;
	     else if arg = "-timing" then timing = "1"b;

	     else if ckm_switch then do;
		if arg = "-list" | arg = "-ls" then brief_switch = "0"b;
		else goto BADOPT;
	     end;

	     else if arg = "-absolute_pathname" | arg = "-absp" then absolute_pathname = "1"b;
	     else if arg = "-adjourned" | arg = "-adj" then adjourned = "1"b;
	     else if arg = "-all" | arg = "-a" then all_switch = "1"b;
	     else if arg = "-before" | arg = "-be" then do;
		if arg_idx = arg_count then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		arg_idx = arg_idx + 1;
		call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_lth);
		call convert_date_to_binary_ (arg, before_time, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);
	     end;
	     else if arg = "-brief" | arg = "-bf" then brief_switch = "1"b;
	     else if arg = "-chairman" | arg = "-cm" then chairman_expected, chairman_switch = "1"b;
	     else if arg = "-changes" | arg = "-changed" | arg = "-chg" then change_switch = "1"b;
	     else if (arg = "-count" | arg = "-ct") & ^active_function then count_switch = "1"b;
	     else if arg = "-eligible" | arg = "-elig" then eligible_switch = "1"b;
	     else if arg = "-header" | arg = "-he" then header_switch, noheader_switch = "1"b;
	     else if arg = "-include" | arg = "-incl" | arg = "-inc" then exclude_switch = "0"b;
	     else if arg = "-inhibit_error" | arg = "-ihe" then inhibit_error = "1"b;
	     else if arg = "-long" | arg = "-lg" then brief_switch = "0"b;
	     else if arg = "-no_adjourned" | arg = "-nadj" then no_adjourned = "1"b;
	     else if arg = "-no_changes" | arg = "-nchg" then no_changes = "1"b;
	     else if arg = "-no_header" | arg = "-nhe" then header_switch, noheader_switch = "0"b;
	     else if arg = "-no_inhibit_error" | arg = "-nihe" then inhibit_error = "0"b;
	     else if arg = "-no_notify" | arg = "-nnt" then no_notify = "1"b;
	     else if arg = "-no_participating" | arg = "-npart" then no_participate = "1"b;
	     else if arg = "-no_read_only" | arg = "-nro" then no_read_only = "1"b;
	     else if arg = "-notify" | arg = "-nt" then notify_switch = "1"b;
	     else if arg = "-participating" | arg = "-part" then participate_switch = "1"b;
	     else if arg = "-read_only" | arg = "-ro" then read_only = "1"b;
	     else if arg = "-user" then user_name_expected = "1"b;
	     else if ^active_function & (arg = "-verbose" | arg = "-vb") then verbose_switch = "1"b;

	     else
BADOPT:		call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;
%page;
/* Do some consistency checks */

	if user_name_expected then 
	     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "A userid must be given after ""-user"".");

	message = "";

	if all_switch & change_switch then message =  """-all"" and ""-changes""";
	else if all_switch & no_changes then message = """-all"" and ""-no_changes""";
	else if all_switch & notify_switch then message = """-all"" and ""-notify""";
	else if all_switch & no_notify then message = """-all"" and ""-no_notify""";
	else if all_switch & eligible_switch then message = """-all"" and ""-eligible""";
	else if all_switch & participate_switch then message = """-all"" and ""-participating""";
	else if all_switch & no_participate then message = """-all"" and ""-no_participating""";
	else if eligible_switch & change_switch then message =  """-eligible"" and ""-changes""";
	else if eligible_switch & notify_switch then message =  """-eligible"" and ""-notify""";
	else if chairman_switch & user_name_given then message = """-chairman"" and ""-user""";
	else if change_switch & verbose_switch then message = """-changes"" and ""-verbose""";
	else if read_only & no_read_only then message = """-read_only"" and ""-no_read_only""";
	else if adjourned & no_adjourned then message = """-adjourned"" and ""-no_adjourned""";
	else if notify_switch & no_notify then message = """-notify"" and ""-no_notify""";
	else if change_switch & no_changes then message = """-changes"" and ""-no_changes""";
	else if participate_switch & no_participate then message = """-participating"" and ""-no_participating""";
	else if before_time ^= 0 & change_switch then message = """-before"" and ""-changes"" or ""-from""";

	if message ^= "" then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, message);

	if ^change_switch & ^notify_switch & ^all_switch & ^participate_switch then
	     eligible_switch = "1"b;

	if change_switch & (header_switch ^= noheader_switch) then header_switch = "0"b;
	if change_switch & ^adjourned then no_adjourned = "1"b;

	if any_person & (change_switch | notify_switch | count_switch) then
	     call ssu_$abort_line (ssu_ptr, 0, """-user *"" cannot be used with ""-changes"", ""-count"" or ""-notify"".");

	if ^user_name_given then access_name = "";
	if access_time = 0 then access_time = clock ();
	if chairman_switch & cm_username = "" then call user_info_$whoami (cm_username, "", "");

	forums_array_ptr = addrel (select_names_ptr, currentsize (select_names));
	forums_array.version = forum_meeting_list_version_1;

	system_area_ptr = get_system_free_area_ ();

	call search_paths_$get ("forum", sl_control_default, "", null (), system_area_ptr,
	     sl_info_version_1, sl_info_p, status);

	if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Getting ""forum"" search list.");

	do dir_idx = 1 to sl_info_p -> sl_info.num_paths;

	     if sl_info.paths (dir_idx).code ^= 0 then do;
		if ^inhibit_error then
		     call ssu_$print_message (ssu_ptr, sl_info.paths (dir_idx).code,
		     "Expanding ^a", sl_info.paths (dir_idx).pathname);
	     end;
	     else do;
		     forum_directory = sl_info.paths (dir_idx).pathname;
		     call scan_dir (".forum");
		     call scan_dir (".control");
		end;
	end;

	if ^absolute_pathname | active_function then call sort_output ();
	
	do i = 1 to select_names.no_names;
	     if ^select_names.matched (i) then
		if select_names.star_name (i) then
		     call ssu_$print_message (ssu_ptr, error_table_$nomatch, "^a", select_names.forum_names (i));
		else call ssu_$print_message (ssu_ptr, forum_et_$no_such_forum, select_names.forum_names (i));
	end;

	if ckm_switch then begin;

declare	temp_ptr			ptr,
	words			(word_count) bit (36) aligned based,
	word_count		fixed bin;

	     temp_ptr = forum_data_$meeting_list;
	     if temp_ptr ^= null () then free temp_ptr -> forums_array;
	     word_count = currentsize (forums_array);
	     allocate words in (system_area) set (temp_ptr);
	     temp_ptr -> forums_array.no_selected = forums_array.no_selected;
	     temp_ptr -> forums_array.forums (*) = forums_array.forums (*);

	     forum_data_$meeting_list = temp_ptr;
	     if no_selected = 0 then call ssu_$print_message (ssu_ptr, 0, "No meetings have changed.");
	     else if ^brief_switch then call print_changes (1);
	end;

	else if active_function then call return_af_value (1);
	else if change_switch then call print_changes (1);
	else call print_output ();

EGRESS:
	call clean_up ();

	return;
%page;
create_subsystem:
     procedure ();

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, status);
	if status ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (status, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (status, whoami, "Unable to create subsystem invocation.");
	     goto EGRESS;
	end;

	return;
     end create_subsystem;
%page;
/* This routine attempts to list the control segments in the directory whose pathname is in the global
   variable forum_directory.  It sets the global variables obj_name_idx and obj_name_count, which are
   used by check_forum to find the names of the forum to examine.  */

scan_dir:
     procedure (suffix);

declare	object_idx		fixed bin,
	suffix			char (*);

	star_select_sw = star_ALL_ENTRIES;

	call hcs_$star_dir_list_ (forum_directory, "**.*" || suffix, star_select_sw, system_area_ptr, star_branch_count,
	     star_link_count, star_list_branch_ptr, star_list_names_ptr, status);
	if status ^= 0 & status ^= error_table_$nomatch then do;
	     if ^inhibit_error then
		call ssu_$print_message (ssu_ptr, status, "Trying to list meetings in ^a.", forum_directory);
	end;
	else do object_idx = 1 to star_branch_count + star_link_count;
	     obj_name_idx = star_dir_list_branch.nindex (object_idx);
	     obj_name_count = star_dir_list_branch.nnames (object_idx);
	     if timing then call cpu_time_and_paging_ (last_pf, last_cpu, (0));
	     call check_forum (suffix);
	     if timing then do;
		call cpu_time_and_paging_ (page_faults, cpu, (0));
		call ioa_ ("^a: ^d PF ^d msec.", star_list_names (obj_name_idx), page_faults - last_pf,
		     divide ((cpu - last_cpu), 1000, 17, 0));
	     end;
	end;

	return;

     end scan_dir;


already_done:
     proc () returns (bit (1) aligned);

declare	uid			bit (36) aligned,
	forum_idx			fixed bin;

	call hcs_$get_uid_file (forum_directory, star_list_names (obj_name_idx), uid, status);
	if status ^= 0 then return ("0"b);

	do forum_idx = 1 to uid_count;
	     if uid_array (forum_idx) = uid then return ("1"b);
	end;

	if uid_count < hbound (uid_array, 1) then do;
	     uid_count = uid_count + 1;
	     uid_array (uid_count) = uid;
	end;

	return ("0"b);
     end already_done;
%page;
/* The following procedure examines a forum to discover whether it meets the selection criteria given to the command.
   If it does, it is added to the "forums" array for later printing out.  */

check_forum:
     procedure (suffix);

declare	forum_idx			fixed bin,
	my_long_name		char (32) varying,
	my_short_name		char (32) varying,
	my_path			char (168) varying,
	real_dir			char (168),
	real_name			char (32),
	suffix			char (*);

	explicit = "0"b;
	if select_names.no_names > 0
	then if ^match_select_name () then return;

	my_long_name =
	     substr (star_list_names (obj_name_idx), 1,
	     length (rtrim (star_list_names (obj_name_idx))) - length (suffix));

	if obj_name_count < 2 then my_short_name = "";
	else my_short_name =
		substr (star_list_names (obj_name_idx + 1), 1,
		length (rtrim (star_list_names (obj_name_idx + 1))) - length (suffix));

	if already_done () then return;

	if suffix = ".control" then fi.version = forum_info_version_1;
	else fi.version = forum_info_version_2;

	call forum_$forum_info (forum_directory, star_list_names (obj_name_idx), access_name, access_time,
	     addr (fi), status);
	if status ^= 0 then do;
	     if status = forum_et_$no_such_forum then do;
		if ^explicit & inhibit_error then return;
		call ssu_$print_message (ssu_ptr, status, "^a>^a", forum_directory, star_list_names (obj_name_idx));
	     end;
	     if status = forum_et_$not_eligible & all_switch then goto ADD_FORUM;
	     if (status ^= forum_et_$not_eligible | ((change_switch | count_switch) & user_name_given) | explicit)
		& ^inhibit_error then
		call ssu_$print_message (ssu_ptr, status, "Getting meeting info for ^a>^a", forum_directory, star_list_names (obj_name_idx));
	     return;
	end;
	
	if no_participate then
	     if ^fi.removed & fi.last_time_attended ^= 0 then return;
	     else;
	else if ^all_switch & ^((any_person | eligible_switch) & fi.eligible) & (fi.removed | fi.last_time_attended = 0) then return;

	if change_switch & fi.changes_count = 0 then return;
	if no_changes & fi.changes_count ^= 0 then return;

	if chairman_switch & cm_username ^= fi.chairman.username then return;

	if read_only & ^fi.read_only then return;
	if no_read_only & fi.read_only then return;
	if fi.adjourned & no_adjourned then return;
	if ^fi.adjourned & adjourned then return;

	if (notify_switch & ^fi.notify) | (no_notify & fi.notify) then do;
	     if change_switch then interesting_switch = "1"b;
	     return;
	end;

	if before_time > 0 & before_time < fi.last_time_changed then return;

ADD_FORUM:
	do forum_idx = 1 to no_selected;
	     if fi.forum_uid = forums (forum_idx).uid then return;
	end;

	no_selected = no_selected + 1;

	call forum_$get_forum_path (forum_directory, star_list_names (obj_name_idx), real_dir, real_name, status);
	if status ^= 0 then do;
	     if forum_directory = ">" then my_path = forum_directory;
	     else my_path = rtrim (forum_directory) || ">";
	     my_path = my_path || my_long_name;
	end;
	else do;
	     if real_dir = ">" then my_path = real_dir;
	     else my_path = rtrim (real_dir) || ">";
	     my_path = my_path || substr (real_name, 1, length (rtrim (real_name)));
	end;

	forums (no_selected).long_name = my_long_name;
	forums (no_selected).path_name = my_path;
	forums (no_selected).uid = fi.forum_uid;
	forums (no_selected).last_seen = fi.last_seen_trans_idx;
	forums (no_selected).last_trans = fi.transaction_count;
	forums (no_selected).eligible = fi.eligible;
	forums (no_selected).removed = fi.removed;
	forums (no_selected).notify = fi.notify;
	forums (no_selected).attending = fi.attending;
	forums (no_selected).read_only = fi.read_only;
	forums (no_selected).attended = (fi.last_time_attended ^= 0);
	forums (no_selected).adjourned = fi.adjourned;
	forums (no_selected).processed = "0"b;
	forums (no_selected).count = fi.changes_count;
	forums (no_selected).order = no_selected;

	if my_short_name = "" then do;
	     forums (no_selected).short_name = my_long_name;
	     forums (no_selected).two_names = "0"b;
	end;
	else do;
	     forums (no_selected).short_name = my_short_name;
	     forums (no_selected).two_names = "1"b;
	     if verbose_switch then short_name_width = max (short_name_width, length (rtrim (my_short_name)));
	end;

	if verbose_switch then do;
	     forums (no_selected).chairman = rtrim (fi.chairman.username) || "." || fi.chairman.project;
	     chair_width = max (chair_width, length (rtrim (forums (no_selected).chairman)));
	end;

	if absolute_pathname then
	     name_width = max (name_width, length (my_path));
	else name_width = max (name_width, length (my_long_name));

	if fi.changes_count > 0 then no_changed = no_changed + 1;

	return;

     end check_forum;
%page;
get_select_name:
     procedure ();

	if arg_lth > 26 then
	     call ssu_$abort_line (ssu_ptr, 0, "^[Exclude^;Match^] name too long.  ^a", exclude_switch, arg);

	no_names = no_names + 1;

	forum_names (no_names) = arg;
	exclude (no_names) = exclude_switch;
	matched (no_names) = exclude_switch;		/* don't care if excludes are matched */
	call check_star_name_$entry (rtrim (forum_names (no_names)) || ".forum", status);
	if status ^= 0
	then if status = 1 | status = 2
	     then star_name (no_names) = "1"b;
	     else call ssu_$abort_line (ssu_ptr, status, "^[Exclude^;Match^] name.  ""^a""", exclude_switch, arg);

	return;

     end get_select_name;


match_select_name:
     procedure () returns (bit (1) aligned);

declare	accepting			bit (1) aligned,
	match			bit (1) aligned,
	name_idx			fixed bin,
	star_idx			fixed bin;

	accepting = exclude (1);

	do name_idx = 1 to select_names.no_names;
	     match = "0"b;
	     do star_idx = obj_name_idx to obj_name_idx + obj_name_count - 1 while (^match);

		if star_name (name_idx) then do;
		     call match_star_name_ (star_list_names (star_idx), rtrim (forum_names (name_idx)) || ".forum",
			status);
		     if status ^= 0 then
			call match_star_name_ (star_list_names (star_idx), rtrim (forum_names (name_idx)) || ".control",
			status);
		     if status = 0 then match = "1"b;
		end;
		else if rtrim (forum_names (name_idx)) || ".forum" = star_list_names (star_idx) |
		     rtrim (forum_names (name_idx)) || ".control" = star_list_names (star_idx)
		     then explicit, match = "1"b;
		matched (name_idx) = matched (name_idx) | match;
	     end;
	     if match then accepting = ^exclude (name_idx);
	end;

	return (accepting);

     end match_select_name;
%page;
get_user_name:
     procedure (chairman_sw);

declare	personid			char (32) varying,
	projectid			char (31) varying,
	tag			char (30) varying,
	chairman_sw		bit (1) aligned;

	if (^chairman_sw & user_name_given) then
	     call ssu_$abort_line (ssu_ptr, 0, "Only one -user specification may be given.  ^a", arg);
	if arg_lth > 32 then call ssu_$abort_line (ssu_ptr, 0, "User names must be less than 32 characters.  ^a", arg);

	if ^chairman_sw then do;
	     user_name_expected = "0"b;
	     user_name_given = "1"b;
	end;

	personid = before (arg, ".");
	if personid = "" then personid = "*";
	if personid = "*" then any_person = "1"b;
	if length (personid) > 20 then call ssu_$abort_line (ssu_ptr, 0, "Usernames may not exceed 20 characters.  ^a", arg);

	projectid = after (arg, ".");
	tag = after (projectid, ".");
	if tag = "" then tag = "*";
	else if length (tag) ^= 1 then call ssu_$abort_line (ssu_ptr, 0, "Tags must be one character long.  ^a", arg);

	projectid = before (projectid, ".");
	if projectid = "" then projectid = "*";
	else if length (projectid) > 9 then call ssu_$abort_line (ssu_ptr, 0, "Projects cannot exceed 9 characters.  ^a", arg);

	if chairman_sw then cm_username = personid;
	else access_name = personid || "." || projectid || "." || tag;

	return;

     end get_user_name;
%page;
/* The following routine is a simple shell sort by short_name.  */

sort_output:
     procedure ();

dcl	(i, k, l, t)		fixed bin;

	k, l = no_selected;
	do while (k <= l);
	     l = -1;
	     do i = 2 to k;
		l = i - 1;
		if short_name (order (l)) > short_name (order (i))
		then do;
			t = order (l);
			order (l) = order (i);
			order (i) = t;
			k = l;
		     end;
	     end;
	end;

	return;

     end sort_output;
%page;
/* Here we build the active function return value.  The short_name of
   each forum is returned if possible, otherwise the long_name.  The
   names are requoted since they might contain special command_processor
   characters, and they are separated by spaces.  */

return_af_value:
     procedure (start);

declare	start			fixed bin;

	do i = start to no_selected;

	     if length (return_string) ^= 0 then return_string = return_string || " ";

	     if absolute_pathname
	     then return_string = return_string || requote_string_ (rtrim (forums (order (i)).path_name));
	     else return_string = return_string || requote_string_ (rtrim (forums (order (i)).short_name));
	end;

	return;
     end;
%page;
print_changes:
     procedure (start);

declare	start			fixed bin;

	if header_switch & no_selected - start + 1 > 0 then call ioa_ ("Changed meetings = ^d.^/",
	     no_selected - start + 1);
	else if no_selected - start + 1 = 0 & ^brief_switch
	then call ioa_ ("No ^[interesting ^]meetings have changed.", interesting_switch);

	if absolute_pathname & name_width > 0 then name_width = name_width + 5;
	if count_switch then name_width = name_width + 7;

	do i = start to no_selected;

	     j = order (i);

	     if absolute_pathname
	     then call ioa_ ("^[^5d  ^;^s^]^a^[^v.0t(^a)^;^s^]", count_switch, forums (j).count,
		     forums (j).path_name, forums (j).two_names, name_width, forums (j).short_name);

	     else call ioa_ ("^[^5d  ^;^s^]^a^[  (^a)^]", count_switch, forums (j).count, forums (j).long_name,
		     forums (j).two_names, forums (j).short_name);
	end;

	return;

     end print_changes;
%page;
/* Print the results, displaying the long and short name (if any) and whatever flags the user asked
   for.  If the user wants a header, print one.  And make the columns line up in the minimum amount of space.  */

print_output:
     procedure ();

declare	flag_string		char (8) varying,
	last_width		fixed bin,
	i			fixed bin,
	j			fixed bin;

	if absolute_pathname then do;
	     if count_switch then do;
		name_width = name_width + 10;
		short_name_width = name_width + short_name_width + 9;
	     end;
	     else do;
		name_width = name_width + 3;
		short_name_width = name_width + short_name_width + 11;
	     end;
	end;
	else do;
	     if count_switch then short_name_width = short_name_width + 5;
	     short_name_width = name_width + short_name_width + 12;
	end;
	chair_width = chair_width + short_name_width + 2;

	if header_switch then
	     call ioa_ ("Meetings = ^d, Changed = ^d.^[^/^]^[^vtChairman^vtCurrent  Last^]", no_selected, no_changed,
		no_selected > 0, verbose_switch, short_name_width, chair_width);

	do i = 1 to no_selected;

	     j = order (i);

	     if all_switch
	     then if forums (j).eligible
		then flag_string = "e";
		else flag_string = " ";
	     else flag_string = "";

	     if (all_switch | eligible_switch) & ^any_person & ^no_participate
	     then if forums (j).removed then flag_string = flag_string || "r";
		else if forums (j).attended then flag_string = flag_string || "p";
		else flag_string = flag_string || " ";

	     if forums (j).adjourned then
		flag_string = flag_string || "j";
		else flag_string = flag_string || " ";

	     if ^notify_switch & ^any_person & ^no_notify
	     then if forums (j).notify
		then flag_string = flag_string || "n";
		else flag_string = flag_string || " ";

	     if ^any_person & ^count_switch & ^no_changes
	     then if forums (j).count > 0
		then flag_string = flag_string || "c";
		else flag_string = flag_string || " ";

	     if ^any_person
	     then if forums (j).attending
		then flag_string = flag_string || "a";
		else flag_string = flag_string || " ";

	     if ^any_person & ^read_only
	     then if forums (j).read_only
		then flag_string = flag_string || "o";
		else flag_string = flag_string || " ";

	     if (all_switch | ^any_person) & ^count_switch then flag_string = flag_string || "  ";

	     if verbose_switch then do;
		last_seen_pic = forums (j).last_seen;
		last_trans_pic = forums (j).last_trans;
		if forums (j).last_trans > 100000 then last_width = chair_width + 11;
		else if forums (j).last_trans > 10000 then last_width = chair_width + 10;
		last_width = chair_width + 9;
	     end;

	     if absolute_pathname
	     then call ioa_ ("^a^v.0t^[^[^5d  ^;^7x^s^]^;^2s^]^a^[^vt(^a)^;^2s^]^[^vt^a^vt[^a]^vt[^a]^]", flag_string,
		     (length (flag_string) + 1), count_switch, (forums (j).count > 0), forums (j).count,
		     forums (j).path_name, forums (j).two_names, (name_width + length (flag_string)), forums (j).short_name,
		     verbose_switch, short_name_width, forums (j).chairman, chair_width,
		     ltrim (last_seen_pic), last_width, ltrim (last_trans_pic));

	     else call ioa_ ("^a^v.0t^[^[^5d  ^;^7x^s^]^;^2s^]^va^[  ^a^;^s^]^[^vt^a^vt[^a]^vt[^a]^]", flag_string,
		     (length (flag_string) + 1),
		     count_switch, (forums (j).count > 0), forums (j).count, name_width, forums (j).long_name,
		     forums (j).two_names, forums (j).short_name, verbose_switch, short_name_width,
		     forums (j).chairman, chair_width, ltrim (last_seen_pic), last_width, ltrim (last_trans_pic));
	end;

	return;

     end print_output;
%page;
punt:	proc ();

	go to EGRESS;

     end punt;
     

clean_up:
     procedure ();

	if select_names_ptr ^= null () then call release_temp_segment_ (whoami, select_names_ptr, (0));

	if star_list_branch_ptr ^= null ()
	then do;
		if star_list_names_ptr ^= null () then free star_list_names;
		free star_dir_list_branch;
	     end;

	if sl_info_p ^= null () then free sl_info;

	if ^subsystem_entry then call ssu_$destroy_invocation (ssu_ptr);

	return;

     end clean_up;
%page;
next_meeting:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;

	call ssu_$return_arg (ssu_ptr, arg_count, active_function, rtn_string_ptr, rtn_string_length);

	absolute_pathname, all_switch, brief_switch, count_switch = "0"b;
	header_switch = "1"b;

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_lth);
	     if index (arg, "-") ^= 1 then 
		call ssu_$abort_line (ssu_ptr, 0, "Usage:  nm {-control_arg}");
	     else if arg = "-all" | arg = "-a" then all_switch, count_switch = "1"b;
	     else if arg = "-count" | arg = "-ct" then brief_switch = "1"b;
	     else if arg = "-list" | arg = "-ls" then count_switch = "1"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;

	if brief_switch & count_switch then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-count"" and ""-all"" or ""-list""");

	if forum_data_$meeting_list = null () then
	     call ssu_$abort_line (ssu_ptr, 0, "The check_meetings request has not been used in this process.");
	
	forums_array_ptr = forum_data_$meeting_list;

	if brief_switch then do;
	     do i = 1 to forums_array.no_selected while (forums (order (i)).processed);
	     end;
	     j = forums_array.no_selected - i + 1;
	     if active_function then return_string = ltrim (char (j));
	     else call ioa_ ("There ^[is^;are^] ^[no more^s^;^d^] changed meeting^[s^].", j = 1, (j = 0), j, j ^= 1);
	     return;
	end;

	if count_switch then do;
	     if all_switch then i = 1;
	     else do i = 1 to forums_array.no_selected while (forums (order (i)).processed);
	     end;

	     if active_function then call return_af_value (i);
	     else call print_changes (i);
	     return;
	end;

	do i = 1 to forums_array.no_selected;
	     j = order (i);
	     if ^forums (j).processed then do;
		if active_function then return_string = forums (j).long_name;
		else do;
		     request = "goto " || requote_string_ (forums (j).path_name);
		     call ssu_$execute_line (ssu_ptr, addr (request), length (rtrim (request)), status);
		end;
		forums (j).processed = "1"b;
		return;
	     end;
	end;

	call ssu_$abort_line (ssu_ptr, 0, "There are no more changed meetings.");

     end forum_list_meetings;
 



		    forum_list_users.pl1            08/16/86  1414.1rew 08/16/86  1354.1      230166


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added -no_notify, -sort last_seen.  Use date_time_$format
     Fixed -eligible for v1 meetings.
                                                   END HISTORY COMMENTS */


flsu:
forum_list_users:
     proc ();

/* forum_list_users: prints out information on participants in a CONTINUUM forum
   This is accessible both as a command/active_function and as a subsystem
   request. As an active function it returns a string of usernames
   Jay Pattin 6/21/81 updates from code by M. Auerbach
   Jay Pattin 8/21/81 for ssu_
   Jay Pattin 1/16/82 added -seen, -unseen, changes for new continuum_
   Jay Pattin 01/21/82 renamed forum_list_users, added -total
   Jay Pattin 02/16/82 added -eligible
   Jay Pattin 02/28/82 added standalone_invocation
   Jay Pattin 05/05/82 added -read_only, -no_read_only
   Jay Pattin 10/2/82 added -sort
   Jay Pattin 7/1/83 added -asc, -dsc, -after, -before, -names_only, -part, -npart,  */

declare	(P_ssu_ptr, P_passport_info_ptr)
				ptr parameter;

declare	(all_switch, person_switch, project_switch, attending_switch, temp_forum, brief_switch, active_function, command,
	no_notify, notify_switch, header_switch, total_switch, unseen_switch, eligible_switch, read_only, no_read_only, 
	forum_opened, ascending, descending, names_only, part, no_part)
				bit (1) aligned init ("0"b);

declare	me			char (32),
	(after_time, before_time)	fixed bin (71),
	forum_dir			char (168),
	trans_time		char (250) varying,
	trans_pic			pic "zz9999",
	attendee_name		char (256) varying,
	project_name		char (256) varying,
	forum_name		char (32),
	full_forum_name		char (32),
	name_len			fixed bin,
	temp_idx			fixed bin,
	code			fixed bin (35);

declare	(acl_count, seen_idx, no_selected, messlen, i, forum_idx, argument_idx, arg_count, arg_len, ret_len, count,
				sort, delete_type)
				fixed bin;
declare	(acl_ptr, based_area_ptr, arg_ptr, ret_ptr, ssu_ptr)
				ptr;

declare	argument			char (arg_len) based (arg_ptr),
	ret_arg			char (ret_len) varying based (ret_ptr);

declare	(addr, after, before, char, index, length, ltrim, maxlength, mod, null, rtrim, substr, unspec)
				builtin,
	cleanup			condition;

declare	1 acl			(acl_count) aligned based (acl_ptr),
	2 access_name		char (32),
	2 modes			bit (36),
	2 xmodes			bit (36),
	2 status_code		fixed bin (35);

declare	(SORT_BY_NAME		init (1),
	SORT_BY_TIME		init (2),
	SORT_BY_SEEN		init (3),
	ONLY_NONDELETED		init (0),
	INCLUDE_DELETED		init (1),
	ONLY_DELETED		init (2))
				fixed bin static options (constant);

declare	(error_table_$badopt,
	error_table_$bad_conversion,
	error_table_$inconsistent,
	error_table_$noarg,
	forum_et_$no_forum,
	forum_et_$old_format)	fixed bin (35) external;

declare	(ioa_, ioa_$nnl, ioa_$rsnnl)	entry options (variable),
	(com_err_, active_fnc_err_)	entry options (variable),
	com_err_$suppress_name	entry options (variable),
	active_fnc_err_$af_suppress_name
				entry options (variable),
	convert_date_to_binary_	entry (char (*), fixed bin (71), fixed bin (35)),
	date_time_$format		entry (char (*), fixed bin (71 ), char (*), char (*)) returns (char(250) varying),
	get_system_free_area_	entry returns (ptr),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	forum_trans_specs_$parse_specs
				entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*), ptr),
	forum_trans_util_$clear_cache entry (ptr),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$get_transaction_map_idx
				entry (fixed bin, char (*), bit (*) aligned, fixed bin (35)),
	forum_$list_forum_acl	entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)),
	forum_$list_v1_forum_acl	entry (char (*), char (*), ptr, ptr, fixed bin, fixed bin (35)),
	forum_$list_users		entry (char (*), char (*), ptr, ptr, fixed bin (35)),
	forum_$open_forum		entry (char (*), char (*), fixed bin, fixed bin (35)),
	cu_$arg_list_ptr		entry returns (ptr),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin) returns (fixed bin (35)),
	sort_items_$char		entry (ptr, fixed bin (24)),
	sort_items_indirect_$char	entry (ptr, ptr, fixed bin),
	sort_items_indirect_$fixed_bin
				entry (ptr, ptr),
     	sort_items_indirect_$general	entry (ptr, ptr, entry),
	ssu_$abort_line		entry options (variable),
	ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)),
	ssu_$return_arg		entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin),
	ssu_$print_message		entry options (variable),
	ssu_$destroy_invocation	entry (ptr);
%page;
%include forum_user_list;
%page;
%include forum_passport;
%page;
%include forum_trans_list;
%page;
%include access_mode_values;
%page;
	command = "1"b;
	forum_idx = 0;
	me = "forum_list_users";

	call ssu_$standalone_invocation (ssu_ptr, me, "1", cu_$arg_list_ptr (), punt, code);
	if code ^= 0 then do;	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (code, me, "Unable to create subsystem invocation.");
	     else call com_err_ (code, me, "Unable to create subsystem invocation.");
	     return;
	end;
	passport_info_ptr = null ();
	goto common;


list_users_request:					/* Entry for use as a forum request */
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;

	me = "list_users";
	forum_idx = passport.forum_idx;
	forum_dir = passport.forum_dir;
	forum_name = no_suffix_name;
	full_forum_name = passport.forum_name;

common:
	header_switch = "1"b;
	forum_trans_list_ptr, user_list_ptr = null ();
	based_area_ptr = get_system_free_area_ ();
	on cleanup call cleanup_handler;
	seen_idx, temp_idx = 0;

	call ssu_$return_arg (ssu_ptr, arg_count, active_function, ret_ptr, ret_len);
	if active_function then ret_arg = "";

	if command & arg_count = 0 then go to USAGE;

	argument_idx = 0;
	if arg_count > 0 then do;
	     call get_arg ();
	     if substr (argument, 1, 1) ^= "-" then call get_forum (argument);
	     else argument_idx = 0;
	end;

	sort = SORT_BY_NAME;
	delete_type = ONLY_NONDELETED;
	attendee_name, project_name = "";
	count, after_time, before_time = 0;

	do while (argument_idx < arg_count);
	     call get_arg ();
	     if index (argument, "-") = 1 then do;
		if argument = "-user" then argument_idx = collect_ids (attendee_name, "1"b);
		else if argument = "-after" | argument = "-af" then call get_date (after_time);
		else if argument = "-before" | argument = "-be" then call get_date (before_time);
		else if argument = "-at" | argument = "-attending" then attending_switch = "1"b;
		else if argument = "-all" | argument = "-a" then all_switch = "1"b;
		else if argument = "-brief" | argument = "-bf" then brief_switch = "1"b;
		else if argument = "-long" | argument = "-lg" then brief_switch = "0"b;
		else if argument = "-include_deleted" | argument = "-idl" then delete_type = INCLUDE_DELETED;
		else if argument = "-only_deleted" | argument = "-odl" then delete_type = ONLY_DELETED;
		else if argument = "-only_non_deleted" | argument = "-ondl" then delete_type = ONLY_NONDELETED;
		else if argument = "-meeting" | argument = "-mtg" then do;
		     if temp_forum then
			call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "Only one meeting name may be specified.");
		     call get_arg ();
		     call get_forum (argument);
		end;
		else if argument = "-participating" | argument = "-part" then part = "1"b;
		else if argument = "-no_participating" | argument = "-npart" then no_part = "1"b;
		else if argument = "-project" | argument = "-pj" then argument_idx = collect_ids (project_name, "0"b);
		else if argument = "-read_only" | argument = "-ro" then read_only = "1"b;
		else if argument = "-no_read_only" | argument = "-nro" then no_read_only = "1"b;
		else if argument = "-seen" then argument_idx, seen_idx = argument_idx + 1;
		else if argument = "-unseen" then do;
		     argument_idx, seen_idx = argument_idx + 1;
		     unseen_switch = "1"b;
		end;
		else if argument = "-notify" | argument = "-nt" then notify_switch = "1"b;
		else if argument = "-no_notify" | argument = "-nnt" then no_notify = "1"b;
		else if active_function then goto BADOPT;
		else if argument = "-ascending" | argument = "-asc" then do;
		     ascending = "1"b;
		     descending = "0"b;
		end;
		else if argument = "-descending" | argument = "-dsc" then do;
		     ascending = "0"b;
		     descending = "1"b;
		end;
		else if argument = "-eligible" | argument = "-elig" then eligible_switch = "1"b;
		else if argument = "-header" | argument = "-he" then header_switch = "1"b;
		else if argument = "-no_header" | argument = "-nhe" then header_switch = "0"b;
		else if argument = "-names_only" then names_only = "1"b;
		else if argument = "-sort" then do;
		     call get_arg ();
		     if argument = "name" then sort = SORT_BY_NAME;
		     else if argument = "date_time_attended" | argument = "dta" then sort = SORT_BY_TIME;
		     else if argument = "last_seen" | argument = "ls" then sort = SORT_BY_SEEN;
		     else call ssu_$abort_line (ssu_ptr, 0, "Unknown sort type: ""^a"".", argument);
		end;
		else if argument = "-total" | argument = "-tt" then total_switch = "1"b;
		else
BADOPT:		     call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", argument);
	     end;
	     else if temp_forum then
		call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "Only one meeting may be specified. ^a", argument);
	     else call get_forum (argument);
	end;

	if forum_idx = 0 & ^temp_forum then 
	     if command then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "No meeting_name was given.");
	     else call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	if read_only & no_read_only then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "-read_only and -no_read_only");

	if notify_switch & no_notify then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "-notify and -no_notify");

	if part & no_part then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "-participating and -no_participating");

	if after_time ^= 0 & before_time ^= 0 then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "-before and -after");

	if person_switch & (all_switch | count > 0 | notify_switch | no_notify | total_switch | attending_switch | read_only |
	     no_read_only | after_time > 0 | before_time > 0 | part | no_part) then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, "The -all, -after, -attending, -before, -notify, -no_notify, -no_participating, -no_read_only, -participating, -read_only, -seen, -total, and -unseen arguments may not be used with -user.");

	if seen_idx > 0 then call get_count (ssu_ptr, forum_dir, full_forum_name);

	if eligible_switch then do;
	     if attending_switch | notify_switch | no_notify | all_switch | count > 0 | person_switch | project_switch |
		total_switch | read_only | no_read_only | ascending | descending | after_time > 0 |
		before_time > 0 | part | no_part then
		call ssu_$abort_line (ssu_ptr, error_table_$inconsistent,
		     "No other control arguments may be used with -eligible.");

	     call list_the_acl ();
	end;

	else do;
	     attendee_name = attendee_name || ".";
	     project_name = project_name || ".";

	     call forum_$list_users (forum_dir, full_forum_name, based_area_ptr, user_list_ptr, code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Getting user list.");

	     if ^part & ^no_part & delete_type = ONLY_NONDELETED then part = "1"b;
	     if ^ascending & ^descending then ascending = (sort = SORT_BY_NAME);
	     call name_list_ ();
	end;
EXIT:
	call cleanup_handler ();
	return;

USAGE:
	if active_function then
	     call active_fnc_err_$af_suppress_name (0, me, "Usage: [flsu meeting_name {-control_args}]");
	else call com_err_$suppress_name (0, me, "Usage: flsu meeting_name {-control_args}");
	return;
%page;
get_arg:
     proc ();

	argument_idx = argument_idx + 1;
	if argument_idx > arg_count then
	     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", argument);
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);

	return;
     end get_arg;

get_count:
     proc (sci_ptr, dir, name);			/* avoid #@&%$ name conflicts */

declare	sci_ptr			ptr,
	(dir, name)		char (*),
	1 pp			aligned like passport;

	call forum_$open_forum (dir, name, temp_idx, code);
	if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Opening meeting.");
	forum_opened = "1"b;

	unspec (pp) = ""b;
	pp.ssu_ptr = sci_ptr;
	pp.forum_idx = temp_idx;
	if passport_info_ptr = null () then pp.current_trans = 0;
	else pp.current_trans = passport.current_trans;
	pp.area_ptr = based_area_ptr;
	pp.unprocessed_trans_ptr, pp.first_trans_ptr, pp.last_trans_ptr = null ();

     	parse_flags_word = NON_NULL | ONLY_ONE | ALLOW_DELETED | DISALLOW_UNPROC | DISALLOW_MTG | DISALLOW_REV |
	     DISALLOW_IDL | DISALLOW_INITIAL | DISALLOW_CMSG | DISALLOW_BYCHAIN;

	call forum_trans_specs_$parse_specs (addr (pp), seen_idx, parse_flags_word, dummy, (0), (""), (""),
	     forum_trans_list_ptr);
	count = forum_trans_list.trans_num (1);

	call forum_trans_util_$clear_cache (addr (pp));	/* in case any got read out */
	return;

dummy:	proc (P_arg_idx);

declare	P_arg_idx		fixed bin;

	P_arg_idx = arg_count + 1;			/* we're done now */

	return;
     end dummy;

     end get_count;
%page;
get_forum:
     proc (forum);

	declare forum		 char (*);

	call forum_requests_$find_forum (forum, forum_dir, full_forum_name, name_len, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code,  "Finding the ""^a"" meeting.", forum);
	forum_name = substr (full_forum_name, 1, name_len);
	temp_forum = "1"b;
	return;
     end get_forum;


get_date:
     proc (time);

declare	time			fixed bin (71);

	call get_arg ();
	call convert_date_to_binary_ (argument, time, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "^a", argument);

	return;
     end get_date;


collect_ids:
     procedure (id_string, person) returns (fixed bin);

declare	(person, found)		bit (1) aligned,
	id_string			char (*) varying;

	if argument_idx >= arg_count then
NOARG:	     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", argument);

	found = "0"b;
	if person then person_switch = "1"b;
	else project_switch = "1"b;

	do while (argument_idx < arg_count);
	     call get_arg ();
	     if char (argument, 1) = "-" then do;
		if ^found then goto NOARG;
		return (argument_idx - 1);
	     end;
	     found = "1"b;
	     if length (id_string) + arg_len > maxlength (id_string) then
		call ssu_$abort_line (ssu_ptr, 0, "Too many names.");
	     if index (argument, ".") > 0 | index (argument, "*") > 0 then
		call ssu_$abort_line (ssu_ptr, 0, "Invalid ^[user^;project^] name ""^a"".", person, argument);
	     id_string = id_string || "." || argument;
	end;
	return (argument_idx);
     end collect_ids;
%page;
list_the_acl:
     procedure ();

	acl_ptr = null ();
	on cleanup begin;
	     if acl_ptr ^= null then free acl;
	end;

	call forum_$list_forum_acl (forum_dir, full_forum_name, based_area_ptr, acl_ptr,
	     null (), acl_count, code);
	if code ^= 0 then
	     if code = forum_et_$old_format then do;
		call list_v1_acl ();
		return;
	     end;
	     else call ssu_$abort_line (ssu_ptr, code, "Listing acl for the ""^a"" meeting.", forum_name);

	if header_switch then call print_name_header ();

	do i = 1 to acl_count;
	     call ioa_ ("^[r^]^[w^]^[c^]^[null^]^-^a", substr (acl.xmodes (i), 1, 1), substr (acl.xmodes (i), 2, 1),
		substr (acl.xmodes (i), 3, 1), acl.xmodes (i) = ""b, acl.access_name (i));
	end;
	free acl;

	return;
     end list_the_acl;
%page;
list_v1_acl:
     procedure ();

declare	public			bit (1) aligned,
	public_ro			bit (1) aligned,
	one_acl_ptr		ptr,
	1 one_acl			aligned based (one_acl_ptr),
	2 access_name		char (32),
	2 modes			bit (36),
	2 xmodes			bit (36),
	2 status_code		fixed bin (35);

	call forum_$list_v1_forum_acl (forum_dir, rtrim (forum_name) || ".control", based_area_ptr, acl_ptr, acl_count, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Listing acl for the ""^a"" meeting.", forum_name);

	if header_switch then call print_name_header ();

	if acl (acl_count).access_name = "*.*.*" then do;
	     public = (acl (acl_count).modes ^= "0"b);
	     public_ro = (acl (acl_count).modes = "100"b);
	     acl_count = acl_count - 1;		/* avoid printing '*' as a project */
	end;
	else public, public_ro = "0"b;

	begin;
declare	1 v			aligned,
	2 n			fixed bin,
	2 vector			(acl_count) pointer unaligned;

	     v.n = acl_count;
	     do i = 1 to acl_count;
		v.vector (i) = addr (acl (i).access_name);
	     end;
	     call sort_items_$char (addr (v), 44);

	     call ioa_  ("The meeting is ^[not ^s^;^[read-only ^]^]public.", ^public, public_ro);

	     if acl_count > 0 then do;
		if public then do;
		     if public_ro then call list_it (RW_ACCESS, "0"b, "0"b);
		     else call list_it (R_ACCESS, "0"b, "1"b);
		     call list_it (N_ACCESS, "0"b, "1"b);
		end;
		else call list_it (R_ACCESS, "1"b, "0"b);
	     end;
	     free acl;
	     return;
%page;
list_it:						/* Still inside BEGIN block */
     procedure (match_acl, at_least, not_switch);

declare	(at_least, not_switch, done)	bit (1) aligned,
	match_acl			bit (3);

     	done, header_switch = "0"b;
	count = 0;
	do i = 1 to acl_count while (^done);
	     one_acl_ptr = v.vector (i);
	     if substr (one_acl.access_name, 1, 2) ^= "*." then done = "1"b;
	     else if one_acl.access_name ^= "*.SysDaemon.*" then do;
		if (one_acl.modes = match_acl) | (at_least & one_acl.modes > match_acl) then do;
		     if ^header_switch then do;
			call ioa_ ("^/The following projects are ^[not ^]eligible to ^[write^;participate^]:",
			     not_switch, ^at_least & (match_acl ^= N_ACCESS));
			header_switch = "1"b;
		     end;
		     if mod (count, 4) = 0 then call ioa_ ();
		     count = count + 1;
		     call ioa_$nnl ("^[*^; ^]^15a", (at_least & ^(substr (one_acl.modes, 3, 1))), before (after (one_acl.access_name, "."), "."));
		end;
	     end;
	end;

	if header_switch then call ioa_ ();
	header_switch = "0"b;
	count = 0;
	do i = i - 1 to acl_count;
	     one_acl_ptr = v.vector (i);
	     if (one_acl.modes = match_acl) | (at_least & one_acl.modes > match_acl) then do;
		if ^header_switch then do;
		     call ioa_ ("^/The following users are ^[not ^]eligible to ^[write^;participate^]:",
			not_switch, ^at_least & (match_acl ^= N_ACCESS));
		     header_switch = "1"b;
		end;
		if mod (count, 4) = 0 then call ioa_ ();
		count = count + 1;
		call ioa_$nnl ("^[*^; ^]^15a",
		     (at_least & ((one_acl.modes & W_ACCESS) = "000"b)),
		     before (one_acl.access_name, "."));
	     end;
	end;

	if header_switch then call ioa_ ();
	return;
     end list_it;

	end;					/* BEGIN block */
     end list_v1_acl;
%page;
name_list_:
     proc ();

declare	name_array		(user_list.no_attendees) char (78),
	bit_map			bit (user_list.transaction_count) aligned,
	1 v			aligned,
	2 n			fixed bin,
	2 vector			(user_list.no_attendees) ptr unaligned,
	1 idxs			aligned,
	2 n			fixed bin,
	2 vector			(user_list.no_attendees) fixed bin (18);

	no_selected = 0;
	do i = 1 to user_list.no_attendees;

	     if all_switch then goto accept_name;

	     if person_switch then
		if index (attendee_name, "." || rtrim (user_list.attendees (i).person_id) || ".") ^= 0 then
		     goto accept_name;
		else goto reject_name;

	     if project_switch then
		if index (project_name, "." || rtrim (user_list.attendees (i).project_id) || ".") ^= 0 then
		     goto accept_name;
		else goto reject_name;

	     if part & user_list.attendees (i).removed then goto reject_name;
	     if no_part & ^user_list.attendees (i).removed then goto reject_name;
	     if user_list.attendees (i).deleted & delete_type = ONLY_NONDELETED then goto reject_name;
	     if ^user_list.attendees (i).deleted & delete_type = ONLY_DELETED then goto reject_name;

	     if attending_switch & ^user_list.attendees (i).attending then goto reject_name;

	     if notify_switch & ^user_list.attendees (i).notify then goto reject_name;
	     if no_notify & user_list.attendees (i).notify then goto reject_name;
	     if read_only & ^user_list.attendees (i).read_only then goto reject_name;
	     if no_read_only & user_list.attendees (i).read_only then goto reject_name;

	     if before_time ^= 0 & user_list.attendees (i).last_time_attended > before_time then goto reject_name;

	     if user_list.attendees (i).last_time_attended < after_time then goto reject_name;

accept_name:
	     if count > 0 then do;
		call forum_$get_transaction_map_idx (temp_idx, user_list.attendees (i).person_id, bit_map, code);
		if code ^= 0 then
		     if code = forum_et_$old_format then do;
			if unseen_switch then
			     if user_list.attendees (i).highest_trans_seen >= count then goto reject_name;
			     else;
			else if user_list.attendees (i).highest_trans_seen < count then goto reject_name;
		     end;
		     else call ssu_$abort_line (ssu_ptr, code, "Getting transaction map.");
		else if unseen_switch then
		     if substr (bit_map, count, 1) then goto reject_name;
		     else;
		else if ^substr (bit_map, count, 1) then goto reject_name;
	     end;

	     no_selected = no_selected + 1;
	     if active_function then
		ret_arg = ret_arg || user_list.attendees (i).person_id;
	     else if ^total_switch then do;
		if ^names_only then
		     if user_list.attendees (i).attending then trans_time = "NOW ATTENDING";
		     else if user_list.attendees (i).last_time_attended ^= 0 then
			trans_time = date_time_$format ("date_time", user_list.attendees (i).last_time_attended,
			     "", "");
		     else trans_time = "NEVER ATTENDED";

		trans_pic = user_list.attendees (i).highest_trans_seen;
		call ioa_$rsnnl ("^[^4s^; ^[^[d^;r^]^;^s ^]^[n^; ^]^[o^; ^]^3x^]^a^[.^a^;^s^]^[^43t^[[^a]^; *END*^s^]^52t^a^]",
		     name_array (no_selected), messlen, names_only, (user_list.attendees (i).deleted |
		     user_list.attendees (i).removed), user_list.attendees (i).deleted, 
		     (user_list.attendees (i).notify), (user_list.attendees (i).read_only),
		     rtrim (user_list.attendees (i).person_id), (user_list.attendees (i).project_id ^= ""),
		     user_list.attendees (i).project_id, ^names_only,
		     (user_list.attendees (i).highest_trans_seen < user_list.transaction_count),
		     ltrim (trans_pic), trans_time);

		if sort = SORT_BY_NAME then
		     if names_only then v.vector (no_selected) = addr (name_array (no_selected));
		     else v.vector (no_selected) = addr (substr (name_array (no_selected), 8));
		else if sort = SORT_BY_SEEN then
		     v.vector (no_selected) = addr (user_list.attendees (i).highest_trans_seen);
		else v.vector (no_selected) = addr (user_list.attendees (i).last_time_attended);
	     end;
reject_name:
	end;

	if no_selected = 0 & ^active_function then do;
	     if ^brief_switch then
		call ssu_$print_message (ssu_ptr, 0, "No participants were selected.");
	     return;
	end;

	else if ^active_function then do;
	     if header_switch then call print_name_header ();
	     if total_switch then
		call ioa_ ("Total users ^[selected ^]=  ^d.", (attending_switch | notify_switch | person_switch | count > 0),
		     no_selected);
	     else do;
		idxs.n, v.n = no_selected;
		do i = 1 to no_selected;
		     idxs.vector (i) = i;
		end;
		if sort = SORT_BY_NAME then
		     call sort_items_indirect_$char (addr (v), addr (idxs), 75 - sort);
		else if sort = SORT_BY_SEEN then
		     call sort_items_indirect_$fixed_bin (addr (v), addr (idxs));
		else call sort_items_indirect_$general (addr (v), addr (idxs), compare_fb71);

		if ascending then
		     do i = 1 to no_selected;
			call ioa_ ("^a", name_array (idxs.vector (i)));
		     end;
		else do i = no_selected to 1 by -1;
		     call ioa_ ("^a", name_array (idxs.vector (i)));
		end;
	     end;

	end;
	return;
     end name_list_;

compare_fb71:
     proc (p1, p2) returns (fixed bin (1));

declare	(p1, p2)			ptr unaligned,
	fb71			fixed bin (71) based;

	if p1 -> fb71 > p2 -> fb71 then return (1);
	else if p1 -> fb71 = p2 -> fb71 then return (0);
	else return (-1);

     end compare_fb71;


print_name_header:
     proc ();

	call ioa_ ("^[Eligible u^;U^]sers of the ^a>^a meeting.", eligible_switch, forum_dir, forum_name);
	if names_only | total_switch | eligible_switch then return;

	trans_pic = user_list.transaction_count;
	call ioa_("Flags  Person                        Last [^a]^52tLast time attended", ltrim (trans_pic));

	return;
     end print_name_header;
%page;
cleanup_handler:
     proc ();

	if forum_opened then call forum_$close_forum (temp_idx, (0));
	if user_list_ptr ^= null () then free user_list;
	if forum_trans_list_ptr ^= null () then free forum_trans_list;
	if command then call ssu_$destroy_invocation (ssu_ptr);

	return;
     end cleanup_handler;

punt:
     proc ();

	goto EXIT;

     end punt;

     end forum_list_users;
  



		    forum_mailer_.pl1               04/27/92  1054.2r w 04/27/92  1032.0      157491


/****^  **************************************************************
        *                                                            *
        * Copyright, (C) BULL HN Information Systems Inc., 1990      *
        *                                                            *
        * Copyright, (C) Massachusetts Institute of Technology, 1983 *
        *                                                            *
        ************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-03,Margolin), install(86-08-16,MR12.0-1128):
     Renamed -subject to -new_subject to avoid conflict with trans_spec
     ctl_arg.  Removed dont_compress_sw from filling.
  2) change(91-09-05,Huen), approve(91-09-05,MCR8249),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20946: Generate correct info for mailed unproc trans header.
                                                   END HISTORY COMMENTS */


forum_mailer_$mail:
     proc (P_ssu_ptr, P_passport_info_ptr);

/* This module contains the Forum request to mail transactions.

   Jay Pattin 6/24/83 */

	declare (P_ssu_ptr,
	        P_passport_info_ptr)	 ptr parameter;

	declare acknowledge		 bit (1) aligned,
	        address_ptr		 ptr,
	        arg_count		 fixed bin,
	        arg_idx		 fixed bin,
	        arg_ptr		 ptr,
	        arg_len		 fixed bin (21),
	        arg		 char (arg_len) based (arg_ptr),
	        brief		 bit (1) aligned,
	        code		 fixed bin (35),
	        fill		 bit (1) aligned,
	        forum_idx		 fixed bin,
	        header		 char (256),
	        header_len		 fixed bin (21),
	        idx		 fixed bin,
	        line_len		 fixed bin,
	        local_bcc		 ptr,
	        local_cc		 ptr,
	        local_reply_to	 ptr,
	        local_to		 ptr,
	        name		 char (32) varying,
	        ssu_ptr		 ptr,
	        subject		 char (256),
	        trans_pic		 pic "zz9999",
	        trans_time		 fixed bin (71),
	        user		 char (32) varying;

	declare 1 fdoc		 aligned like format_document_options,
	        1 (aufp, dufp, tufp)	 aligned like message_user_field_parameter,
	        1 mbsp		 aligned like message_body_section_parameter,
	        1 do		 aligned like deliver_options,
	        1 pca		 aligned like parse_ca_options,
	        1 ri		 aligned,
		2 header		 like recipients_info.header,
		2 lists		 (3) like recipients_info.lists;

	declare (addr, index, ltrim, null, rtrim, string, substr)
				 builtin,
	        cleanup		 condition;

	declare (error_table_$bad_conversion,
	        error_table_$badopt,
	        error_table_$noarg,
	        error_table_$recoverable_error)
				 fixed bin (35) external;

	declare cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35)),
	        format_document_$string entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35)),
	        forum_trans_specs_$parse_specs
				 entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*),
				 char (*), ptr),
	        forum_trans_util_$read_trans entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	        ioa_$rsnnl		 entry options (variable),
	        mail_system_$add_address entry (ptr, ptr, char (8), fixed bin (35)),
	        mail_system_$add_user_field entry (ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)),
	        mail_system_$create_message entry (char (8), ptr, fixed bin (35)),
	        mail_system_$create_user_mailbox_address
				 entry (char (*) varying, char (*) varying, char (*) varying, ptr,
				 fixed bin (35)),
	        mail_system_$deliver_message entry (ptr, ptr, ptr, fixed bin (35)),
	        mail_system_$free_address_list
				 entry (ptr, fixed bin (35)),
	        mail_system_$free_message entry (ptr, fixed bin (35)),
	        mail_system_$get_user_field_id
				 entry (char (*) varying, bit (36) aligned, char (*) varying, fixed bin (35)),
	        mail_system_$replace_bcc entry (ptr, ptr, fixed bin (35)),
	        mail_system_$replace_body entry (ptr, ptr, fixed bin (35)),
	        mail_system_$replace_cc entry (ptr, ptr, fixed bin (35)),
	        mail_system_$replace_reply_to entry (ptr, ptr, fixed bin (35)),
	        mail_system_$replace_subject entry (ptr, char (*), fixed bin (35)),
	        mail_system_$replace_to entry (ptr, ptr, fixed bin (35)),
	        mail_system_$replace_user_field
				 entry (ptr, fixed bin, ptr, bit (1) aligned, fixed bin (35)),
	        mlsys_utils_$free_delivery_results
				 entry (ptr, fixed bin (35)),
	        mlsys_utils_$parse_address_list_control_args
				 entry (ptr, fixed bin, ptr, char (8), ptr, ptr, fixed bin (35)),
	        mlsys_utils_$print_delivery_results
				 entry (ptr, bit (1) aligned, ptr, fixed bin (35)),
	        pathname_		 entry (char (*), char (*)) returns (char (168)),
	        ssu_$abort_line	 entry options (variable),
	        ssu_$arg_count	 entry (ptr, fixed bin),
	        ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin (21));
%page;
%include forum_passport;
%page;
%include forum_trans_list;
%page;
%include forum_user_trans;
%page;
%include format_document_options;
%page;
%include mlsys_message;
%page;
%include mlsys_address_list;
%page;
%include mlsys_deliver_info;
%page;
%include mlsys_parse_ca_options;
%page;
	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;

	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count = 0 then
USAGE:	     call ssu_$abort_line (ssu_ptr, 0, "Usage:  mail {trans_specs} -control_args");

	forum_idx = passport.forum_idx;
	acknowledge, brief, fill = "0"b;
	subject = "";
	line_len = 72;

	local_to, local_cc, local_bcc, local_reply_to, address_list_ptr, forum_trans_list_ptr, message_ptr = null ();
	ri.version = "";				/* prevents free_delivery_results from doing anything */
	on cleanup call cleanup_handler ();

	pca.version = PARSE_CA_OPTIONS_VERSION_1;
	pca.logbox_creation_mode = CREATE_AND_ANNOUNCE_MAILBOX;
	pca.savebox_creation_mode = QUERY_TO_CREATE_MAILBOX;
	string (pca.flags) = ""b;
	pca.validate_addresses, pca.abort_on_errors = "1"b;

	parse_flags_word = DISALLOW_MTG | DISALLOW_REV | DEFAULT_TO_UNPROC | DISALLOW_BYCHAIN | DISALLOW_CMSG;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, args, 0, "", "",
	     forum_trans_list_ptr);

	call mail_system_$create_message (MESSAGE_VERSION_2, message_ptr, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to create message.");

	call mail_system_$replace_to (message_ptr, local_to, code);
	if code ^= 0 then
	     call ssu_$abort_line (code, ssu_ptr, "Unable to initalize To field.");

	call mail_system_$replace_cc (message_ptr, local_cc, code);
	if code ^= 0 then
	     call ssu_$abort_line (code, ssu_ptr, "Unable to initalize cc field.");

	call mail_system_$replace_bcc (message_ptr, local_bcc, code);
	if code ^= 0 then
	     call ssu_$abort_line (code, ssu_ptr, "Unable to initalize bcc field.");

	call mail_system_$replace_reply_to (message_ptr, local_reply_to, code);
	if code ^= 0 then
	     call ssu_$abort_line (code, ssu_ptr, "Unable to initalize reply_to field.");

	aufp.version, dufp.version, tufp.version = MESSAGE_USER_FIELD_PARAMETER_VERSION_2;

	call mail_system_$get_user_field_id ("Forum-Transaction", tufp.field_id, user, code);
	if code ^= 0 then
BADID:	     call ssu_$abort_line (code, ssu_ptr, "Unable to get user field id.");
						/* phx20946: Generate correct info for mailed unproc trans header. */
	if forum_trans_list.trans_num (1) = 0 & passport_info_ptr -> unprocessed_trans_ptr ^= null () then
	     call mail_system_$get_user_field_id ("Transaction-Written-Date", dufp.field_id, user, code);
	else call mail_system_$get_user_field_id ("Transaction-Entered-Date", dufp.field_id, user, code);

	if code ^= 0 then goto BADID;

	if forum_trans_list.trans_num (1) = 0 & passport_info_ptr -> unprocessed_trans_ptr ^= null () then
	     call mail_system_$get_user_field_id ("Transaction-Written-By", aufp.field_id, user, code);
	else call mail_system_$get_user_field_id ("Transaction-Entered-By", aufp.field_id, user, code);

	if code ^= 0 then goto BADID;

	tufp.field_type = MESSAGE_TEXT_USER_FIELD;
	addr (tufp.user_field) -> message_text_user_field.text_ptr = addr (header);
	addr (tufp.user_field) -> message_text_user_field.text_lth = 0;

	dufp.field_type = MESSAGE_DATE_USER_FIELD;
	addr (dufp.field_type) -> message_date_user_field.date_time = 0;

	aufp.field_type = MESSAGE_ADDRESS_LIST_USER_FIELD;
	addr (aufp.user_field) -> message_address_list_user_field.address_list_ptr = null ();
						/* add dummies so that we can replace them for each piece of mail */
	call mail_system_$add_user_field (message_ptr, addr (tufp), 1, "0"b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to initialize transaction header.");

	call mail_system_$add_user_field (message_ptr, addr (aufp), 2, "0"b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to initialize author header.");

	call mail_system_$add_user_field (message_ptr, addr (dufp), 3, "0"b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to initialize date header.");

	mbsp.version = MESSAGE_BODY_SECTION_PARAMETER_VERSION_2;
	mbsp.section_type = MESSAGE_PREFORMATTED_BODY_SECTION;

	ri.area_ptr = passport.area_ptr;
	ri.expanded_recipients_result_list_ptr = null ();
	idx = 1;
	ri.lists (1).address_list_ptr = message.to;
	ri.lists (1).recipients_result_list_ptr = null ();

	if message.cc -> address_list.n_addresses > 0 then do;
		idx = idx + 1;
		ri.lists (idx).address_list_ptr = message.cc;
		ri.lists (idx).recipients_result_list_ptr = null ();
	     end;
	if message.bcc -> address_list.n_addresses > 0 then do;
		idx = idx + 1;
		ri.lists (idx).address_list_ptr = message.bcc;
		ri.lists (idx).recipients_result_list_ptr = null ();
	     end;
	ri.n_lists = idx;
	ri.version = RECIPIENTS_INFO_VERSION_2;

	do.version = DELIVER_OPTIONS_VERSION_2;
	do.delivery_mode = ORDINARY_DELIVERY;
	do.queueing_mode = ALWAYS_QUEUE_FOREIGN;
	do.queued_notification_mode = NOTIFY_ON_ERROR;

	string (do.flags) = ""b;
	do.abort, do.recipient_notification = "1"b;
	do.acknowledge = acknowledge;

	if fill then do;
		fdoc.version_number = format_document_version_2;
		fdoc.line_length = line_len;
		fdoc.indentation = 0;
		string (fdoc.switches) = ""b;
		fdoc.galley_sw, fdoc.literal_sw, fdoc.dont_break_indented_lines_sw = "1"b;
	     end;

	do idx = 1 to forum_trans_list.size;
	     call send_the_mail (forum_trans_list.trans_num (idx));
	end;

	call cleanup_handler ();
	return;
%page;
args:
     proc (P_arg_idx);

	declare P_arg_idx		 fixed bin parameter;

	arg_idx = P_arg_idx;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	if index (arg, "-") ^= 1 then goto USAGE;
	if arg = "-acknowledge" | arg = "-ack" then acknowledge = "1"b;
	else if arg = "-no_acknowlege" | arg = "-nack" then acknowledge = "0"b;
	else if arg = "-fill" | arg = "-fi" then fill = "1"b;
	else if arg = "-no_fill" | arg = "-nfi" then fill = "0"b;
	else if arg = "-brief" | arg = "-bf" then brief = "1"b;
	else if arg = "-long" | arg = "-lg" then brief = "0"b;

	else if arg = "-new_subject" | arg = "-newsj" then do;
		arg_idx = arg_idx + 1;
		if arg_idx > arg_count then
NOARG:		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
		subject = arg;
	     end;
	else if arg = "-line_length" | arg = "-ll" then do;
		arg_idx = arg_idx + 1;
		if arg_idx > arg_count then goto NOARG;
		fill = "1"b;

		call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
		line_len = cv_dec_check_ (arg, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, error_table_$bad_conversion, "^a", arg);
		if line_len < 40 then
		     call ssu_$abort_line (ssu_ptr, 0, "The line length must be at least 40.");
	     end;

	else if arg = "-to" then call collect_addresses (local_to);
	else if arg = "-bcc" then call collect_addresses (local_bcc);
	else if arg = "-cc" then call collect_addresses (local_cc);
	else if arg = "-reply_to" then call collect_addresses (local_reply_to);
	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);

	P_arg_idx = arg_idx;
	return;

collect_addresses:
     proc (address_list_ptr);

	declare address_list_ptr	 ptr parameter;

	arg_idx = arg_idx + 1;

	call mlsys_utils_$parse_address_list_control_args (ssu_ptr, arg_idx, addr (pca), ADDRESS_LIST_VERSION_2,
	     address_list_ptr, local_bcc, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Parsing addresses following ^a.", arg);

	arg_idx = arg_idx - 1;
	return;
     end collect_addresses;

     end args;
%page;
send_the_mail:
     proc (trans_idx);

	declare trans_idx		 fixed bin;
	declare clock		 builtin;

	call forum_trans_util_$read_trans (passport_info_ptr, forum_idx, trans_idx, forum_user_trans_ptr, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Reading transaction #^d.", trans_idx);

	if trans_idx = 0 then do;			/* we have an unprocessed transaction */
		call ioa_$rsnnl ("[????] **UNPROCESSED** in the ^a meeting", header, header_len,
		     pathname_ (passport.forum_dir, no_suffix_name));
	     end;
	else do;
		trans_pic = trans_idx;
		call ioa_$rsnnl ("[^a] in the ^a meeting", header, header_len, ltrim (trans_pic),
		     pathname_ (passport.forum_dir, no_suffix_name));
	     end;

	addr (tufp.user_field) -> message_text_user_field.text_lth = header_len;
	call mail_system_$replace_user_field (message_ptr, 1, addr (tufp), "0"b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to set transaction header.");

	if trans_idx = 0 then do;			/* we have an unprocessed transaction */
		trans_time = clock ();		/* unproc. trans. gets current date */
	     end;
	else do;
		trans_time = forum_user_trans.time;
	     end;

	addr (dufp.user_field) -> message_date_user_field.date_time = trans_time;
	call mail_system_$replace_user_field (message_ptr, 3, addr (dufp), "0"b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to set date header.");

	if substr (forum_user_trans.person_id, 1, 1) = "*" then do;
		user = "anonymous";
		name = rtrim (forum_user_trans.person_id);
	     end;
	else do;
		user = forum_user_trans.person_id;
		name = "";
	     end;

	user = rtrim (user) || "." || rtrim (forum_user_trans.project_id);
	call mail_system_$create_user_mailbox_address (user, name, "", address_ptr, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to create author header.");

	call mail_system_$add_address (address_list_ptr, address_ptr, ADDRESS_LIST_VERSION_2, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to create address list header.");

	addr (aufp.user_field) -> message_address_list_user_field.address_list_ptr = address_list_ptr;
	call mail_system_$replace_user_field (message_ptr, 2, addr (aufp), "0"b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to set author header.");

	if subject = "" then
	     call mail_system_$replace_subject (message_ptr, forum_user_trans.subject, code);
	else call mail_system_$replace_subject (message_ptr, subject, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to set mail subject.");

	begin;
	     declare text		      char (2 * forum_user_trans.text_length);

	     if ^fill then do;
		     addr (mbsp.section) -> message_preformatted_body_section.text_ptr = addr (forum_user_trans.text);
		     addr (mbsp.section) -> message_preformatted_body_section.text_lth = forum_user_trans.text_length;
		end;
	     else do;
		     call format_document_$string (forum_user_trans.text, text, header_len, addr (fdoc), code);
		     if code ^= 0 then
			if code ^= error_table_$recoverable_error then
			     call ssu_$abort_line (ssu_ptr, code, "Filling transaction.");

		     addr (mbsp.section) -> message_preformatted_body_section.text_ptr = addr (text);
		     addr (mbsp.section) -> message_preformatted_body_section.text_lth = header_len;
		end;

	     call mail_system_$replace_body (message_ptr, addr (mbsp), code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to set message text.");
	end;					/* BEGIN block */

	call mail_system_$deliver_message (message_ptr, addr (ri), addr (do), code);
	call mlsys_utils_$print_delivery_results (ssu_ptr, brief, addr (ri), (0));
	call mlsys_utils_$free_delivery_results (addr (ri), (0));
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Message not sent.");

	call mail_system_$free_address_list (address_list_ptr, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Unable to free Entered-By address list.");

	return;
     end send_the_mail;
%page;
cleanup_handler:
     proc ();

	if forum_trans_list_ptr ^= null () then free forum_trans_list;

	if local_to ^= null () then
	     call mail_system_$free_address_list (local_to, (0));
	if local_cc ^= null () then
	     call mail_system_$free_address_list (local_cc, (0));
	if local_bcc ^= null () then
	     call mail_system_$free_address_list (local_bcc, (0));
	if local_reply_to ^= null () then
	     call mail_system_$free_address_list (local_reply_to, (0));

	if address_list_ptr ^= null () then
	     call mail_system_$free_address_list (address_list_ptr, (0));

	if message_ptr ^= null () then
	     call mail_system_$free_message (message_ptr, (0));

	call mlsys_utils_$free_delivery_results (addr (ri), (0));

	return;
     end cleanup_handler;

     end forum_mailer_$mail;
 



		    forum_misc_requests_.pl1        09/28/92  1718.2r w 09/28/92  1714.0      235089


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) BULL HN Information Systems Inc., 1992       *
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7356),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added rechain and unchain requests.
  2) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Note adjourned switch in . request.  Speed up chairman request and don't
     return .* in cm name.
  3) change(91-08-29,Huen), approve(91-08-29,MCR8248),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     Fix several TRs (phx21375, 21376, 21377) related to the current trans.
  4) change(92-09-10,Zimmerman), approve(92-09-10,MCR8258),
     audit(92-09-22,WAAnderson), install(92-09-28,MR12.5-1020):
     Problem with current being set to deleted txn., or being set to -1.
                                                   END HISTORY COMMENTS */


forum_misc_requests_$dot_request:
     procedure (P_ssu_ptr, P_passport_info_ptr);

/* Miscellaneous requests of the forum subsystem as follows: 

 dot:  print forum version number, and info about current forum, if any.
 forum_dir: print/return pathname of master directory.
 chairman: print/return chairman of current (or specified) forum.
 current_meeting: print/return pathname of current forum.
 switch_(off on) set/reset arbitrary switches.
 (delete retrieve)_participant
 expunge: garbage collect meetings
 rechain/unchain: modify transaction chains.

 Initial coding:	10 March 1980 by M. Auerbach
 rewritten for version 4 06/21/81 Jay Pattin
 modified for ssu_ 08/21/81 Jay Pattin
 renamed forum_misc_requests_ 01/21/82 Jay Pattin
 modified for chairman gate 4/28/82 Jay Pattin
 added switch_(on off) 5/21/82 Jay Pattin
 added (delete retrieve)_participant and expunge 6/24/82 Jay Pattin */

	dcl     (P_ssu_ptr, P_passport_info_ptr)
				 pointer parameter;

	declare active_fnc_err_$af_suppress_name
				 entry options (variable),
	        command_query_	 entry options (variable),
	        com_err_		 entry options (variable),
	        com_err_$suppress_name entry options (variable),
	        forum_$change_chairman entry (char (*), char (*), char (*), fixed bin (35)),
	        forum_$change_chairman_idx entry (fixed bin, char (*), fixed bin (35)),
	        forum_$v1_expunge	 entry (fixed bin, bit (36) aligned, fixed bin, fixed bin, fixed bin, fixed bin,
				 fixed bin (35)),
	        forum_$expunge	 entry (fixed bin, bit (36) aligned, fixed bin, fixed bin, fixed bin (35)),
	        forum_$forum_limits	 entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, bit (36) aligned,
				 fixed bin (35)),
	        forum_$forum_info	 entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35)),
	        forum_$forum_info_idx	 entry (fixed bin, char (*), fixed bin (71), ptr, fixed bin (35)),
	        forum_$rechain	 entry (fixed bin, fixed bin, fixed bin, char (*), fixed bin (35)),
	        forum_$set_seen_switch entry (fixed bin, char (*), fixed bin, bit (1) aligned, fixed bin (35)),
	        forum_$set_switch	 entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35)),
	        forum_$set_switch_idx	 entry (fixed bin, char (*), char (*), bit (1) aligned, fixed bin (35)),
	        forum_requests_$find_forum entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	        forum_trans_specs_$parse_specs
				 entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*), ptr),
	        forum_trans_util_$clear_cache entry (ptr),
	        forum_trans_util_$read_trans entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	        cu_$af_return_arg_rel	 entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr),
	        cu_$arg_list_ptr	 entry returns (ptr),
	        (ioa_, ioa_$rsnnl)	 entry () options (variable),
	        ssu_$abort_line	 entry () options (variable),
	        ssu_$arg_list_ptr	 entry (ptr) returns (ptr),
	        ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin (21)),
	        ssu_$get_abbrev_info	 entry (ptr, ptr, ptr, bit (1) aligned),
	        ssu_$get_invocation_count entry (ptr, fixed bin, fixed bin),
	        ssu_$get_subsystem_name entry (ptr) returns (char (32)),
	        ssu_$get_subsystem_and_request_name
				 entry (ptr) returns (char (72) varying),
	        ssu_$print_message	 entry options (variable),
	        ssu_$return_arg	 entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21));

	declare arg		 char (arg_len) based (arg_ptr),
	        new_subject		 char (new_subject_len) based (new_subject_ptr),
	        ret_arg		 char (ret_len) varying based (ret_ptr);

	declare (addr, after, char, index, null, rtrim, substr)
				 builtin,
	        cleanup		 condition,
	        absolute		 bit (1) aligned,
	        answer		 char (168),
	        arg_count		 fixed bin,
	        arg_idx		 fixed bin,
	        arg_len		 fixed bin (21),
	        (arg_list_ptr, arg_ptr, new_subject_ptr, ssu_ptr)
				 ptr,
	        brief		 bit (1) aligned,
	        delete		 bit (1) aligned,
	        force_switch	 bit (1) aligned,
	        me		 char (72) varying,
	        forum_idx		 fixed bin,
	        forum_dir		 char (168),
	        (forum_name, full_forum_name) char (32),
	        name		 char (32) varying,
	        (first, last, last_seen, new_count, level, pref, chain_idx)
				 fixed bin,
	        (users_deleted, trans_deleted)
				 fixed bin,
	        no_lines		 fixed bin,
	        (command, active_function, temp_forum, have_unproc)
				 bit (1) aligned init ("0"b),
	        new_subject_len	 fixed bin (21),
	        rechain_switch	 bit (1) aligned,
	        ret_len		 fixed bin (21),
	        ret_ptr		 ptr,
	        string		 char (256),
	        switch		 bit (1) aligned,
	        switch_name		 char (32),
	        to_trans_list_ptr	 ptr,
	        user_name		 char (22),
	        (users, transactions)	 bit (1) aligned,
	        code		 fixed bin (35);

	declare 1 auto_forum_info	 aligned like forum_info;
	declare NL		 char (1) static options (constant) init ("
");

	declare (error_table_$not_act_fnc,
	        error_table_$noarg,
	        error_table_$badopt,
	        forum_et_$no_forum,
	        forum_et_$not_eligible,
	        forum_et_$switch_not_changed
	        )			 fixed bin (35) external;
%page;
%include forum_passport;
%page;
%include forum_info;
%page;
%include forum_user_trans;
%page;
%include forum_flags;
%page;
%include forum_trans_list;
%page;
%include query_info;
%page;
	call setup_request ();			/* set common variables */

	if forum_idx ^= 0 then do;			/* if we have forum, get stats */
		call forum_$forum_limits (forum_idx, (0), last_seen, first, last, new_count, forum_flags_word, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Getting meeting limits.");
	     end;

	no_lines = 0;				/* find out about unprocessed transactions */
	forum_user_trans_ptr = unprocessed_trans_ptr;
	if forum_user_trans_ptr ^= null () then begin;

		declare text		 char (forum_user_trans.text_length);
		have_unproc = "1"b;
		text = forum_user_trans.text;
		do no_lines = 0 repeat no_lines + 1 while (text ^= "");
		     text = after (text, NL);
		end;
	     end;

	name = ssu_$get_subsystem_name (ssu_ptr);
	call ssu_$get_invocation_count (ssu_ptr, level, (0));
	call ssu_$get_abbrev_info (ssu_ptr, null (), null (), switch);

	if passport.brief_sw then do;
		if passport.forum_idx ^= 0 then
		     call ioa_ (
			"^a ^a^[ (abbrev)^]^[ (level ^i)^;^s^]:  ^a^[ (RO)^]^[ (ADJ)^] ^d new, ^d last^[, ^d current^;^s^] ^[(^d line^[s^] unprocessed^[ in ^a^].)^;^4s^]",
			name, forum_data_$version_string, switch, (level > 1), level,
			forum_name, forum_flags.read_only, forum_flags.adjourned, new_count, last,
			(passport.current_trans ^= 0), passport.current_trans, have_unproc, no_lines, (no_lines ^= 1),
			(passport.unprocessed_forum_name ^= full_forum_name), passport.unprocessed_forum_name);
		else call ioa_ ("^a ^a^[ (level ^i)^;^s^]^[: (^i line^[s^] unprocessed in ^a)^;^2s^]", name,
			forum_data_$version_string, (level > 1),
			level, have_unproc, no_lines, (no_lines ^= 1), passport.unprocessed_forum_name);
		return;
	     end;

	call ioa_ ("^a ^a^[ (abbrev)^]^[ (level ^d)^;^s^]^[:  ^d new, ^d last^[, ^d current^;^s^]^[ (You are the chairman)^]^[ (Read-only)^]^[ (Adjourned)^].^/Attending the ^a>^a meeting.^]",
	     name, forum_data_$version_string, switch, (level > 1),
	     level, (forum_idx ^= 0), new_count, last, (passport.current_trans ^= 0), passport.current_trans,
	     forum_flags.chairman, forum_flags.read_only, forum_flags.adjourned, forum_dir, forum_name);

	if have_unproc then call ioa_ ("^d line^[s^] unprocessed^[ in the ^a meeting^;^s^].^/Subject: ^a",
		no_lines, (no_lines ^= 1), (passport.unprocessed_forum_name ^= full_forum_name),
		substr (passport.unprocessed_forum_name, 1, passport.unprocessed_name_len), forum_user_trans.subject);

	return;
%page;
chairman_request:					/* Entry to print out chairman name */
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();

	user_name = "";
	force_switch = "0"b;

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then do;
		     if ^active_function & arg = "-set" then do;
			     if arg_idx = arg_count then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following -set.");
			     arg_idx = arg_idx + 1;
			     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
			     user_name = arg;
			     if index (user_name, ".") = 0 then
				call ssu_$abort_line (ssu_ptr, 0, "User name must be Person.Project. ^a", user_name);
			end;
		     else if ^active_function & (arg = "-force" | arg = "-fc") then force_switch = "1"b;
		     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
		end;
	     else if ^temp_forum & user_name = "" then call get_forum (arg);
	     else
CM_USAGE:		call ssu_$abort_line (ssu_ptr, 0, "Usage:  cm {meeting_name} {-control_args}");
	end;

	if forum_idx = 0 & ^temp_forum then
	     call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	if temp_forum & user_name ^= "" then
	     call ssu_$abort_line (ssu_ptr, 0, "A meeting_name may not be specified with -set.");

	if user_name = "" then do;			/* return current name */
		forum_info_ptr = addr (auto_forum_info);
		forum_info.version = forum_info_version_2;

/* forum_info goes faster if you pass in name of non-attendee, hence XYZZY.QUUX */
		if temp_forum then
		     call forum_$forum_info (forum_dir, full_forum_name, "XYZZY.QUUX.*", (0), forum_info_ptr, code);
		else call forum_$forum_info_idx (forum_idx, "XYZZY.QUUX.*", (0), forum_info_ptr, code); /* get his name */
		if code ^= 0 & code ^= forum_et_$not_eligible then call ssu_$abort_line (ssu_ptr, code);

		if active_function then do;
			if forum_info.chairman.project = "*" then ret_arg = forum_info.chairman.username;
			else ret_arg = rtrim (forum_info.chairman.username) || "." || rtrim (forum_info.chairman.project);
			return;
		     end;

		call ioa_ ("^a.^a", forum_info.chairman.username, forum_info.chairman.project);
	     end;

	else do;					/* change the chairman */
		query_info.version = query_info_version_5;
		query_info.yes_or_no_sw = "1"b;
		if ^force_switch then do;
			call command_query_ (addr (query_info), answer, me,
			     "Do you really want to change the chairman of the ^a meeting to ^a ?", forum_name, user_name);
			if substr (answer, 1, 2) = "no" then return;
		     end;

		if temp_forum then
		     call forum_$change_chairman (forum_dir, full_forum_name, user_name, code);
		else call forum_$change_chairman_idx (forum_idx, user_name, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Changing chairman.");
	     end;
ABORT:
	return;
%page;
forum_misc_requests_$switch_off:
     entry (P_ssu_ptr, P_passport_info_ptr);

	switch = "0"b;
	goto SWITCH_COMMON;

forum_misc_requests_$switch_on:
     entry (P_ssu_ptr, P_passport_info_ptr);

	switch = "1"b;

SWITCH_COMMON:
	user_name = "";				/* defaults to this user */
	brief = "0"b;
	call setup_request ();

	arg_idx = 1;

	if arg_count = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage:  sw^[n^;f^] switch_name {-control_args}", switch);
	call ssu_$arg_ptr (ssu_ptr, 1, arg_ptr, arg_len);
	switch_name = arg;

	if switch_name = "seen" then do;
		call seen_switch ();
		return;
	     end;

	do arg_idx = 2 to arg_count;
	     call switch_arg (arg_idx);
	end;

	if forum_idx = 0 & ^temp_forum then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	if (switch_name = "meeting_eligibility_messages" | switch_name = "mtg_emsg" |
	     switch_name = "in_session" | switch_name = "ins") & user_name ^= "" then
	     call ssu_$abort_line (ssu_ptr, 0,
		"The -user control argument may not be used with the ""^a"" switch.", switch_name);

	if temp_forum then
	     call forum_$set_switch (forum_dir, full_forum_name, user_name, switch_name, switch, code);
	else call forum_$set_switch_idx (forum_idx, user_name, switch_name, switch, code);
	if code ^= 0 then do;
		if code = forum_et_$switch_not_changed then
		     if ^passport.brief_sw & ^brief then
			call ssu_$print_message (ssu_ptr, code, """^a"" switch^[ for user ^a^;^s^] in the ^a meeting.",
			     switch_name, (user_name ^= ""), user_name, forum_name);
		     else ;
		else call ssu_$abort_line (ssu_ptr, code, """^a"" switch^[ for user ^a^;^s^] in the ^a meeting.",
			switch_name, (user_name ^= ""), user_name, forum_name);
	     end;

	return;
%page;
seen_switch:
     proc ();

	forum_trans_list_ptr = null ();
	on cleanup begin;
		if forum_trans_list_ptr ^= null () then free forum_trans_list;
	     end;

	parse_flags_word = NON_NULL | DISALLOW_UNPROC | DISALLOW_MTG | DISALLOW_REV | DISALLOW_INITIAL |
	     DISALLOW_CMSG | DISALLOW_BYCHAIN;

	call forum_trans_specs_$parse_specs (passport_info_ptr, 2, parse_flags_word, switch_arg, 0, "", "",
	     forum_trans_list_ptr);

	do arg_idx = 1 to forum_trans_list.size;
	     call forum_$set_seen_switch (forum_idx, user_name, forum_trans_list.trans_num (arg_idx), switch, code);
	     if code ^= 0 then do;
		     if code = forum_et_$switch_not_changed then
			if ^passport.brief_sw & ^brief then
			     call ssu_$print_message (ssu_ptr, code, "Seen switch for transaction ^d^[ for user ^a^;^s^].",
				forum_trans_list.trans_num (arg_idx), (user_name ^= ""), user_name);
			else ;
		     else call ssu_$abort_line (ssu_ptr, code, "Seen switch for transaction ^d^[ for user ^a^;^s^].",
			     forum_trans_list.trans_num (arg_idx), (user_name ^= ""), user_name);
		end;
	end;

	free forum_trans_list;
	return;
     end seen_switch;
%page;
switch_arg:
     proc (P_arg_idx);

	declare P_arg_idx		 fixed bin;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if char (arg, 1) ^= "-" then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage:  sw^[n^;f^] switch_name {-control_args}", switch);

	if arg = "-brief" | arg = "-bf" then brief = "1"b;
	else if arg = "-user" then do;
		if user_name ^= "" then
		     call ssu_$abort_line (ssu_ptr, 0, "Only one user name may be given.");
		if P_arg_idx = arg_count then
NOARG:		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		P_arg_idx = P_arg_idx + 1;
		call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
		user_name = arg;
		if index (user_name, "*") > 0 | index (user_name, ".") > 0 then
		     call ssu_$abort_line (ssu_ptr, 0, "User names may not contain ""."" or ""*"".");
	     end;
	else if arg = "-meeting" | arg = "-mtg" then do;
		if switch_name = "seen" then
		     call ssu_$abort_line (ssu_ptr, 0, "-meeting may not be used with the seen switch.");
		if temp_forum then call ssu_$abort_line (ssu_ptr, 0, "Only one meeting name may be given.");
		if P_arg_idx = arg_count then goto NOARG;
		P_arg_idx = P_arg_idx + 1;
		call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
		call get_forum (arg);
	     end;
	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, arg);

	return;
     end switch_arg;
%page;
forum_misc_requests_$delete_participant:
     entry (P_ssu_ptr, P_passport_info_ptr);

	delete = "1"b;
	goto DLRT_COMMON;

forum_misc_requests_$retrieve_participant:
     entry (P_ssu_ptr, P_passport_info_ptr);

	delete = "0"b;
DLRT_COMMON:
	call setup_request ();

	if arg_count = 0 then call ssu_$abort_line (ssu_ptr, 0, "Usage: ^[dl^;rt^]pt user_names {-control_args}", delete);
	if forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	brief = passport.brief_sw;
	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then do;
		     if arg = "-brief" | arg = "-bf" then brief = "1"b;
		     else if arg = "-long" | arg = "-lg" then brief = "0"b;
		     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
		end;
	end;

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") ^= 1 then do;
		     if index (arg, ".") > 0 then
			call ssu_$abort_line (ssu_ptr, 0, "A user id may not contain a ""."".  ""^a""", arg);

		     call forum_$set_switch_idx (forum_idx, arg, "deleted", delete, code);
		     if code ^= 0 then
			if ^brief | code ^= forum_et_$switch_not_changed then
			     call ssu_$print_message (ssu_ptr, code, "^[Res^;S^]etting deleted switch for ^a.", ^delete, arg);
		end;
	end;
	return;
%page;
forum_misc_requests_$expunge:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();
	brief = passport.brief_sw;
	force_switch, users, transactions = "0"b;

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then do;
		     if arg = "-brief" | arg = "-bf" then brief = "1"b;
		     else if arg = "-force" | arg = "-fc" then force_switch = "1"b;
		     else if arg = "-long" | arg = "-lg" then brief = "0"b;
		     else if arg = "-participants" | arg = "-part" then users = "1"b;
		     else if arg = "-transactions" | arg = "-trans" then transactions = "1"b;
		     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
		end;
	     else call ssu_$abort_line (ssu_ptr, 0, "Usage:  expunge {-control_args}");
	end;

	if ^(users | transactions) then users, transactions = "1"b;

	if ^force_switch then do;
		call ioa_$rsnnl ("Expunging the meeting will destroy all records of deleted^[ transactions^]^[ and^]^[ participants^].^/Do you really want to expunge the ^a meeting?",
		     string, arg_len, transactions, users & transactions, users, forum_name);
		query_info.version = query_info_version_5;
		query_info.yes_or_no_sw = "1"b;
		query_info.explanation_ptr = addr (string);
		query_info.explanation_len = arg_len;
		call command_query_ (addr (query_info), answer, me, substr (string, 1, arg_len));
		if substr (answer, 1, 2) = "no" then return;
	     end;

	if forum_idx < 0 then
	     call forum_$expunge (forum_idx, transactions || users, users_deleted, trans_deleted, code);
	else call forum_$v1_expunge (forum_idx, transactions || users, users_deleted, trans_deleted, (0), (0),
		code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Expunging ^a meeting.", forum_name);
	if brief then return;

	if users then do;
		if users_deleted = 0 then call ioa_ ("There were no deleted participants to expunge.");
		else call ioa_ ("^d participant^[s^] expunged.", users_deleted, users_deleted ^= 1);
	     end;

	if transactions then do;
		if trans_deleted = 0 then call ioa_ ("There were no deleted transactions to expunge.");
		else call ioa_ ("^d transaction^[s^] expunged.", trans_deleted, trans_deleted ^= 1);
	     end;

	return;
%page;
forum_misc_requests_$forum_dir_request:			/* Entry to print/return pathname of forum central dir */
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();
	arg_list_ptr = ssu_$arg_list_ptr (ssu_ptr);
	goto cmd_common;

forum_dir:					/* This is also externally available */
fd:  entry options (variable);

	arg_list_ptr = cu_$arg_list_ptr ();
	command = "1"b;

cmd_common:
	me = "forum_dir";
	call cu_$af_return_arg_rel (arg_count, ret_ptr, ret_len, code, arg_list_ptr);
	if code = 0 then active_function = "1"b;
	else if code ^= error_table_$not_act_fnc then do;
		if command then call com_err_ (code, me);
		else call ssu_$abort_line (code, me);
		return;
	     end;

	if arg_count ^= 0 then do;
		if ^command then call ssu_$abort_line (ssu_ptr, 0, "Usage: ^[[^]fd^[]^]", active_function, active_function);
		else if active_function then call active_fnc_err_$af_suppress_name (0, me, "Usage: [fd]");
		else call com_err_$suppress_name (0, me, "Usage: fd");
		return;
	     end;

	if active_function then
	     ret_arg = forum_data_$central_directory;
	else call ioa_ ("The central forum directory is ^a.", forum_data_$central_directory);

	return;
%page;
current_meeting:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();

	absolute = "0"b;
	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if arg = "-absolute_pathname" | arg = "-absp" then absolute = "1"b;
	     else if arg = "-entry" | arg = "-et" then absolute = "0"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, arg);
	end;

	if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	if active_function then do;
		if absolute then ret_arg = rtrim (forum_dir) || ">" || rtrim (full_forum_name);
		else ret_arg = rtrim (no_suffix_name);
	     end;
	else call ioa_ ("The current meeting is ^[^a>^a^;^2s^a^].", absolute, forum_dir, full_forum_name,
		no_suffix_name);

	return;
%page;
forum_misc_requests_$rechain:
     entry (P_ssu_ptr, P_passport_info_ptr);

	rechain_switch = "1"b;
	goto CHAIN_COMMON;

forum_misc_requests_$unchain:
     entry (P_ssu_ptr, P_passport_info_ptr);

	rechain_switch = "0"b;
CHAIN_COMMON:
	call setup_request ();

	forum_trans_list_ptr, to_trans_list_ptr = null ();
	on cleanup begin;
		if forum_trans_list_ptr ^= null () then free forum_trans_list;
		if to_trans_list_ptr ^= null () then free to_trans_list_ptr -> forum_trans_list;
	     end;

	chain_idx, pref, new_subject_len = 0;
	new_subject_ptr = addr (new_subject_len);	/* keep from faulting in call. Ignored if newsj_len = 0 */

	parse_flags_word = DISALLOW_MTG | DISALLOW_UNPROC | DISALLOW_REV | DISALLOW_CMSG | DISALLOW_BYCHAIN;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, chain_args, 0, "", "",
	     forum_trans_list_ptr);

	if rechain_switch then do;
		if chain_idx = 0 then
		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "The -to control argument is required.");
		parse_flags_word = parse_flags_word | ONLY_ONE | NON_NULL;
		call forum_trans_specs_$parse_specs (passport_info_ptr, chain_idx, parse_flags_word, chain_args, 0,
		     "", "", to_trans_list_ptr);
		pref = to_trans_list_ptr -> forum_trans_list.trans_num (1);
		free to_trans_list_ptr -> forum_trans_list;
	     end;

	if new_subject_ptr = null () then do;
		call forum_trans_util_$read_trans (passport_info_ptr, 0, pref, forum_user_trans_ptr, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Transaction #^d.", pref);

		new_subject_ptr = addr (forum_user_trans.subject);
		new_subject_len = forum_user_trans.subject_length;
	     end;

	do first = 1 to forum_trans_list.size;
	     call forum_$rechain (forum_idx, forum_trans_list.trans_num (first), pref, new_subject, code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Chaining ^d to ^d.", forum_trans_list.trans_num (first), pref);
	end;

	if new_subject_len > 0 then call forum_trans_util_$clear_cache (passport_info_ptr);
	free forum_trans_list;
	return;
%page;
chain_args:
     procedure (P_arg_idx);

	declare P_arg_idx		 fixed bin parameter;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if arg = "-new_subject" | arg = "-newsj" then do;
		new_subject_ptr = null ();
		if P_arg_idx = arg_count then
		     if rechain_switch then return;
		     else goto NOARG;
		P_arg_idx = P_arg_idx + 1;
		call ssu_$arg_ptr (ssu_ptr, P_arg_idx, new_subject_ptr, new_subject_len);
		if rechain_switch & index (new_subject, "-") = 1 then do;
			new_subject_ptr = null ();
			P_arg_idx = P_arg_idx - 1;
		     end;
	     end;
	else if rechain_switch & arg = "-to" then do;
		if chain_idx > 0 then
		     call ssu_$abort_line (ssu_ptr, 0, "-to may only be specified once.");
		if P_arg_idx = arg_count then
NOARG:		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		chain_idx = P_arg_idx + 1;
		P_arg_idx = arg_count + 1;
	     end;
	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
     end chain_args;
%page;
/* This internal procedure sets up to execute a request */

setup_request:
     procedure ();

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	forum_idx = passport.forum_idx;
	forum_dir = passport.forum_dir;
	full_forum_name = passport.forum_name;
	forum_name = no_suffix_name;
	call ssu_$return_arg (ssu_ptr, arg_count, active_function, ret_ptr, ret_len);
	me = ssu_$get_subsystem_and_request_name (ssu_ptr);
	return;

     end setup_request;

get_forum:
     proc (forum);

	declare forum		 char (*),
	        name_len		 fixed bin;

	temp_forum = "1"b;

	call forum_requests_$find_forum (forum, forum_dir, full_forum_name, name_len, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Getting meeting path.");
	forum_name = substr (full_forum_name, 1, name_len);

	return;
     end get_forum;

     end forum_misc_requests_$dot_request;
   



		    forum_output_requests_.pl1      04/27/92  1054.2r w 04/27/92  1032.0      319077


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Fixed bugs in formatted writes involving form-feeds and
       multi-line subjects.
     Added -trailer_format to print and write.
     Changed to use date_time_$format
     Added -no_header.
     Changed list to mark deleted transactions.
     Report pref of unprocessed.
  2) change(91-08-29,Huen), approve(91-08-29,MCR8248),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     Fix several TRs (phx21375, 21376, 21377) relatled to current trans.
  3) change(91-08-29,Huen), approve(91-08-29,MCR8249),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx21386: Fix the "list" request to generate correct summary for unproc
     trans.
                                                   END HISTORY COMMENTS */


forum_output_requests_$write_transactions:
     procedure (P_ssu_ptr, P_passport_info_ptr);

/* This module implements the following forum requests:

   1) 'print' to print specified transactions on users terminal.
   2) 'write' to write specified transactions to a segment.
   3) 'list' to list specified transactions on users terminal.
   4) 'delete' and 'retrieve' to allow the chairman to logically remove
       transactions from a forum and retrieve them later.
   5) 'reset' to change the current and last-seen transactions.

   Initial coding:	10 March 1980 by M. Auerbach
   rewritten for version 4  6/19/81 Jay Pattin
   modified for ssu_ 08/21/81 Jay Pattin
   renamed for forum, added -bf, -lg, -sep, -nsep, -line_len to write Jay Pattin 1/82
   added cmsg to write, print, delete 5/14/82 Jay Pattin
   made list work as active function, use format_document_ for filling 6/25/82 Jay Pattin
   added reset_more in print request 9/24/82 Jay Pattin
   added -new, -next to reset, -bf, -lg to list 10/20/82 Jay Pattin
   simple formatted write 12/31/82 Jay Pattin */

	declare (P_ssu_ptr, P_passport_info_ptr)
				 pointer parameter;

	declare argument_idx	 fixed bin,
	        active_function	 bit (1) aligned,
	        ret_val		 char (ret_len) varying based (ret_ptr),
	        ret_ptr		 ptr,
	        ret_len		 fixed bin (21),
	        (arg_count, arg_len)	 fixed bin,
	        arg_ptr		 ptr,
	        (tidx, forum_idx)	 fixed bin,
	        code		 fixed bin (35),
	        forum_dir		 char (168),	/* where the current forum is */
	        forum_name		 char (32),	/* and what it is called */
	        fill_index		 fixed bin,	/* to fill, or not to fill ... */
	        (write_switch, extend_switch, header_switch, list_switch, temp_forum, delete_switch, formatted,
	        current_switch, print_switch, update_current, dont_truncate, long_switch)
				 bit (1) aligned,
	        trans_pic		 pic "zz9999",	/* pretty picture of trans no */
	        trans_time		 char (24),	/* mm/dd/yy etc. of trans */
	        fmt_trans_time	 char (250) varying,/* header uses date_time_$format */
	        iocb_ptr		 ptr,		/* used for print & write */
	        no_lines		 fixed bin,	/* length of transaction in lines */
	        owner		 char (72),	/* temp seg owner */
	        current_line	 fixed bin,
	        page_len		 fixed bin,
	        page_number		 fixed bin,
	        page_header		 char (256),
	        page_subject	 char (72),	/* first sj on page */
	        temp_idx		 fixed bin,
	        (text_ptr, prseg_ptr)	 ptr,
	        fill_len		 fixed bin (21),
	        fill_seg		 char (1044480) based (prseg_ptr),
	        text		 char (fill_len) based (text_ptr),
	        control		 char (80) varying, /* used for ioa_ */
	        message		 char (256),	/* used by ioa_$rs */
	        messlen		 fixed bin (21),
	        separator		 char (256) varying,
	        (sep_switch, sep_switch_given)
				 bit (1) aligned,
	        ssu_ptr		 ptr,
	        trailer_format	 fixed bin,
	        user_dir		 char (168),	/* where write segment is */
	        user_entry		 char (32),	/* and what it is called */
	        i			 fixed bin,
	        sj_width		 fixed bin,
	        line_len		 fixed bin;

	declare arg		 char (arg_len) based (arg_ptr);
	declare 1 fdoc		 aligned like format_document_options;
	declare NL		 char (1) static options (constant) init ("
");
	declare FF		 char (1) static options (constant) init ("");

	declare (error_table_$bad_conversion,
	        error_table_$badopt,
	        error_table_$bigarg,
	        error_table_$inconsistent,
	        error_table_$noarg,
	        error_table_$noentry,
	        error_table_$recoverable_error,
	        forum_et_$invalid_trans_idx,
	        forum_et_$trans_reaped) fixed bin (35) external;

	declare iox_$user_output	 external pointer;

	declare iox_$close		 entry (pointer, fixed binary (35)),
	        iox_$control	 entry (ptr, char (*), ptr, fixed bin (35)),
	        iox_$detach_iocb	 entry (pointer, fixed binary (35)),
	        iox_$attach_name	 entry (char (*), pointer, char (*), pointer, fixed binary (35)),
	        iox_$destroy_iocb	 entry (ptr, fixed bin (35)),
	        cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35)),
	        get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin (17)),
	        hcs_$status_minf	 entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)),
	        iox_$open		 entry (pointer, fixed binary, bit (1) aligned, fixed binary (35)),
	        expand_pathname_	 entry (char (*), char (*), char (*), fixed bin (35)),
	        expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	        date_time_		 entry (fixed binary (71), char (*)),
	        date_time_$format	 entry (char (*), fixed bin (71), char (*), char (*))
				 returns (char (250) varying),
	        get_temp_segment_	 entry (char (*), ptr, fixed bin (35)),
	        release_temp_segment_	 entry (char (*), ptr, fixed bin (35)),
	        request_id_		 entry (fixed bin (71)) returns (char (19)),
	        ipc_$cutoff		 entry (fixed binary (71), fixed binary (35)),
	        ipc_$reconnect	 entry (fixed binary (71), fixed binary (35)),
	        ioa_		 entry options (variable),
	        ioa_$rsnnl		 entry options (variable),
	        ioa_$ioa_switch	 entry options (variable),
	        ioa_$ioa_switch_nnl	 entry options (variable),
	        format_document_$string entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35)),
	        forum_$close_forum	 entry (fixed bin, fixed bin (35)),
	        forum_$forum_limits	 entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
				 fixed bin, bit (36) aligned, fixed bin (35)),
	        forum_$get_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$set_delete_sw	 entry (fixed bin, fixed bin, bit (1) aligned, fixed bin (35)),
	        forum_$set_last_seen_idx entry (fixed bin, fixed bin, bit (1) aligned, fixed bin (35)),
	        forum_$set_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$set_seen_switch entry (fixed bin, char (*), fixed bin, bit (1) aligned, fixed bin (35)),
	        forum_$trans_ref_info	 entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, bit (1) aligned,
				 fixed bin (35)),
	        forum_trans_specs_$parse_specs
				 entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*), ptr),
	        forum_trans_util_$read_trans entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	        ssu_$abort_line	 entry options (variable),
	        ssu_$return_arg	 entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)),
	        ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin),
	        ssu_$get_subsystem_and_request_name
				 entry (ptr) returns (char (72) varying),
	        ssu_$print_message	 entry options (variable);

	declare (addcharno, addr, char, index, length, max, null, clock, ltrim, maxlength, min, rtrim, string, substr)
				 builtin,
	        cleanup		 condition;
%page;
%include forum_trans_list;
%page;
%include forum_user_trans;
%page;
%include forum_passport;
%page;
%include format_document_options;
%page;
	call setup_request ();

	if arg_count = 0 then call ssu_$abort_line (ssu_ptr, 0, "Usage:  w trans_specs {-control_args}");

	extend_switch, header_switch, sep_switch = "1"b;	/* add to existing segment by default */
	write_switch = "1"b;
	long_switch = ^passport.brief_sw;
	fill_index = 0;
	page_len = 60;
	page_number = 0;
	formatted, sep_switch_given = "0"b;
	separator = "^|";
	iocb_ptr = null ();
	on cleanup call cleanup_handler ();

	parse_flags_word = DEFAULT_TO_UNPROC | NON_NULL;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, write_args, temp_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	if temp_idx ^= 0 then do;
		temp_forum = "1"b;			/* remember so we can clean up */
		forum_idx = temp_idx;
	     end;

	if user_entry = "" then /* default to [wd]>forum_name.trans */
	     call expand_pathname_$add_suffix (forum_name, "trans", user_dir, user_entry, (0));

	if formatted & (sep_switch_given | ^header_switch) then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-formatted"" and ""-separator"" or ""-no_header""");

	if formatted then do;
		page_len = page_len - 4;
		current_line = page_len + 1;		/* force page break */
		if line_len = 0 then line_len = 80;
		else if line_len < 65 then
		     call ssu_$abort_line (ssu_ptr, 0, "Formatted write must have a line length of at least 65.");
		fmt_trans_time = date_time_$format ("date_time", clock (), "", "");
		call ioa_$rsnnl ("^a^5x^a^vtPage: ^^3d^/^v(_^)", page_header, (0), fmt_trans_time, forum_name, line_len - 8, line_len);
	     end;
	else do;
		if line_len = 0 then line_len = 72;
		if ^header_switch then trailer_format = TFMT_none;
	     end;
	goto print_write_common;


write_args:					/* process write's arguments */
     proc (L_arg_idx);

	declare L_arg_idx		 fixed bin;

	argument_idx = L_arg_idx;
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);

	if arg = "-pathname" | arg = "-pn" then do;
		argument_idx = argument_idx + 1;
		if argument_idx > arg_count then
		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Pathname of segment.");
		call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);
		call expand_pathname_$add_suffix (arg, "trans", user_dir, user_entry, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Expanding ^a.", arg);
	     end;

	else if arg = "-brief" | arg = "-bf" then long_switch = "0"b;
	else if arg = "-long" | arg = "-lg" then long_switch = "1"b;
	else if arg = "-truncate" | arg = "-tc" then extend_switch = "0"b;
	else if arg = "-extend" then extend_switch = "1"b;
	else if arg = "-fill" | arg = "-fi" then fill_index = 1;
	else if arg = "-format" | arg = "-fmt" then do;
		formatted = "1"b;
		sep_switch = "0"b;
	     end;
	else if arg = "-no_format" | arg = "-nfmt" then formatted = "0"b;
	else if arg = "-header" | arg = "-he" then header_switch = "1"b;
	else if arg = "-no_header" | arg = "-nhe" then header_switch = "0"b;
	else if arg = "-line_length" | arg = "-ll" then do;
		line_len = get_numeric_arg ();
		if line_len < 40 then call ssu_$abort_line (ssu_ptr, 0, "Line length must be at least 40.");
		if fill_index = 0 then fill_index = 1;
	     end;
	else if arg = "-page_length" | arg = "-pl" then do;
		page_len = get_numeric_arg ();
		if page_len < 20 then call ssu_$abort_line (ssu_ptr, 0, "Page length must be at least 20");
	     end;
	else if arg = "-no_fill" | arg = "-nfi" then fill_index = 2;
	else if arg = "-separator" | arg = "-sep" then do;
		if argument_idx = arg_count then
		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ""^a"".", arg);
		argument_idx = argument_idx + 1;
		call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);
		if arg_len > maxlength (separator) then call
			ssu_$abort_line (ssu_ptr, error_table_$bigarg, "The separator must be less than ^d characters.",
			maxlength (separator));
		separator = arg;
		sep_switch, sep_switch_given = "1"b;
	     end;
	else if arg = "-no_separator" | arg = "-nsep" then sep_switch = "0"b;
	else if arg = "-trailer_format" | arg = "-tfmt" then trailer_format = get_trailer_format ();

	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, arg);
	L_arg_idx = argument_idx;
	return;

     end write_args;

get_numeric_arg:
     procedure returns (fixed bin);

	declare x			 fixed bin;

	argument_idx = argument_idx + 1;
	if argument_idx > arg_count then
	     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ""^a"".", arg);
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);
	x = cv_dec_check_ (arg, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, error_table_$bad_conversion, "^a", arg);
	return (x);
     end get_numeric_arg;
%page;
list_transactions:					/* Entry to list out trans numbers, authors, and date/times */
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();

	iocb_ptr = iox_$user_output;			/* list only goes to terminal */
	fill_index = 0;
	list_switch, update_current = "1"b;
	header_switch = "1"b;			/* print header by default */
	sep_switch = "0"b;
	long_switch = ^passport.brief_sw;

	parse_flags_word = DEFAULT_TO_ALL | DISALLOW_CMSG;
	if active_function then parse_flags_word = parse_flags_word | ALLOW_IHE;

	on cleanup call cleanup_handler ();
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, list_args, temp_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	if temp_idx ^= 0 then do;
		temp_forum = "1"b;			/* remember so we can clean up */
		forum_idx = temp_idx;
	     end;

	if active_function then do;
		ret_val = "";
		do i = 1 to forum_trans_list.size;
		     if forum_trans_list.trans_num (i) = 0 then ret_val = ret_val || "unprocessed ";
		     else ret_val = ret_val || ltrim (char (forum_trans_list.trans_num (i))) || " ";
		end;
		call cleanup_handler ();
		return;
	     end;

	goto print_write_common;


list_args:					/* process list's arguments */
     proc (L_arg_idx);

	declare L_arg_idx		 fixed bin;

	argument_idx = L_arg_idx;
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);

	if active_function then goto BADOPT;
	if arg = "-brief" | arg = "-bf" then long_switch = "0"b;
	else if arg = "-header" | arg = "-he" then header_switch = "1"b;
	else if arg = "-no_header" | arg = "-nhe" then header_switch = "0"b;
	else if arg = "-long_subject" | arg = "-lgsj" then dont_truncate = "1"b;
	else if arg = "-output_file" | arg = "-of" then do;
		argument_idx = argument_idx + 1;
		if argument_idx > arg_count then
		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Pathname of output file.");
		call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);
		call expand_pathname_ (arg, user_dir, user_entry, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Expanding ^a.", arg);
		extend_switch = "1"b;
	     end;
	else if arg = "-fill" | arg = "-fi" then fill_index = 1;
	else if arg = "-line_length" | arg = "-ll" then do;
		line_len = get_numeric_arg ();
		if line_len < 40 then call ssu_$abort_line (ssu_ptr, 0, "Line length must be at least 40.");
		if fill_index = 0 then fill_index = 1;
	     end;
	else if arg = "-long" | arg = "-lg" then long_switch = "1"b;
	else if arg = "-no_fill" | arg = "-nfi" then fill_index = 2;
	else if arg = "-no_update" | arg = "-nud" then update_current = "0"b;
	else if arg = "-update" | arg = "-ud" then update_current = "1"b;
	else
BADOPT:	     call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);

	L_arg_idx = argument_idx;
	return;
     end list_args;
%page;
print_transactions:					/* Entry to print specified portions of proceedings */
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();

	fill_index, page_len = 0;
	print_switch, header_switch = "1"b;
	separator = "";
	sep_switch = "0"b;
	iocb_ptr = iox_$user_output;			/* only sends to terminal */
	code = 0;

	on cleanup call cleanup_handler ();
	parse_flags_word = DEFAULT_TO_UNPROC;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, print_args, temp_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	if temp_idx ^= 0 then do;
		temp_forum = "1"b;			/* remember so we can cleanup */
		forum_idx = temp_idx;
	     end;
	goto print_write_common;

print_args:					/* process print's arguments */
     proc (L_arg_idx);

	declare L_arg_idx		 fixed bin;

	argument_idx = L_arg_idx;
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);
	if arg = "-fill" | arg = "-fi" then fill_index = 1;
	else if arg = "-line_length" | arg = "-ll" then do;
		line_len = get_numeric_arg ();
		if line_len < 40 then call ssu_$abort_line (ssu_ptr, 0, "Line length must be at least 40.");
		if fill_index = 0 then fill_index = 1;
	     end;
	else if arg = "-no_fill" | arg = "-nfi" then fill_index = 2;
	else if arg = "-trailer_format" | arg = "-tfmt" then trailer_format = get_trailer_format ();

	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, arg);
	L_arg_idx = argument_idx;
	return;
     end print_args;
%page;
print_write_common:

	if ^write_switch then do;
		if line_len = 0 then do;
			line_len = get_line_length_$switch (iocb_ptr, code);
			if code ^= 0 | line_len < 72 then do;
				line_len = 72;
				dont_truncate = "1"b;
				code = 0;
			     end;
		     end;
		if long_switch then sj_width = line_len - 56;
		else sj_width = line_len - 18 - forum_trans_list.max_personid_len;
		sj_width = max (sj_width, 6);
	     end;

	call ipc_$cutoff (passport.public_channel, (0));	/* Inhibit 'New transaction' messages */

	if should_be_filled ("0"b) then
	     call get_temp_segment_ ((owner), prseg_ptr, (0)); /* fill needs some working space */
	else prseg_ptr = null ();

	if write_switch then do;			/* open output segment */
		call hcs_$status_minf (user_dir, user_entry, (0), (0), (0), code);
		if code = error_table_$noentry then extend_switch = "0"b;
		code = 0;
		call open_iocb ();

		if long_switch then
		     call ioa_ ("^[Append^;Writ^]ing ^d transaction^[s^] to ^a>^a.", extend_switch, forum_trans_list.size,
			(forum_trans_list.size > 1), user_dir, user_entry);
		if extend_switch & formatted then call ioa_$ioa_switch_nnl (iocb_ptr, "^|");
	     end;
	else if user_entry ^= "" then call open_iocb ();

	if list_switch then do;
		if header_switch then do;
			if long_switch then call ioa_$ioa_switch (iocb_ptr, "Trans#  Lines    Date   Time   Author^56tSubject");
			else call ioa_$ioa_switch (iocb_ptr, "Trans#  Lines  Author^vtSubject", line_len - sj_width);
		     end;

		if update_current then do;
			do tidx = 1 to forum_trans_list.size while (update_current);
			     if forum_trans_list.trans_num (tidx) = passport.current_trans then update_current = "0"b;
			end;
			if update_current & forum_trans_list.trans_num (1) > 0 then
			     passport.current_trans = forum_trans_list.trans_num (1);
		     end;
	     end;

	fdoc.version_number = format_document_version_2;
	fdoc.indentation = 0;
	fdoc.line_length = line_len;
	string (fdoc.switches) = ""b;
	fdoc.galley_sw, fdoc.literal_sw, fdoc.dont_break_indented_lines_sw = "1"b;
	fdoc.syllable_size = 3;			/* Make fdoc happy */

	do tidx = 1 to forum_trans_list.size;		/* do the output */
	     call output_transaction (iocb_ptr,
		forum_trans_list.trans_num (tidx),
		forum_trans_list.list.pref (tidx),
		forum_trans_list.list.nref (tidx),
		forum_trans_list.list.flags.deleted (tidx));
	end;
	if formatted then call new_page ("1"b, "0"b);	/* spit out footer */

	call cleanup_handler ();			/* cleanup everything else */
	return;

open_iocb:
     proc ();

	declare iocb_name		 char (32);

	call ioa_$rsnnl ("vfile_ ""^a>^a"" ^[-extend^]", message, messlen, user_dir, user_entry, (extend_switch));

	iocb_name = request_id_ (clock ()) || ".forum";
	call iox_$attach_name (iocb_name, iocb_ptr, message, null (), code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Attaching iocb.");

	call iox_$open (iocb_ptr, 2, ""b, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Opening iocb.");

	return;
     end open_iocb;
%page;
output_transaction:					/* Internal procedure to output specified transactions */
     procedure (iocb_ptr, trans_index, pref, nref, deleted);

	declare (iocb_ptr		 pointer,
	        trans_index		 fixed binary,
	        (nref, pref)	 fixed binary unaligned,
	        deleted		 bit (1) unaligned) parameter;

	declare (pref_pic, nref_pic)	 pic "zz9999";

	if trans_index = -1 then do;			/* Chairman message */
		call forum_$get_message (forum_idx, message, code);
		if code ^= 0 then call ssu_$abort_line (ssu_ptr, code);
		call ioa_$ioa_switch_nnl (iocb_ptr, "^a", message);
		return;
	     end;
						/* get the transaction */
	call forum_trans_util_$read_trans (passport_info_ptr, temp_idx, trans_index, forum_user_trans_ptr, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Transaction ^d.", trans_index);

	trans_pic = trans_index;
	call date_time_ (forum_user_trans.time, trans_time);
	fmt_trans_time = date_time_$format ("date_time", forum_user_trans.time, "", "");

	if should_be_filled (forum_user_trans.unfilled) then do;
		call format_document_$string (forum_user_trans.text, fill_seg, fill_len, addr (fdoc), code);
		if code ^= 0 & code ^= error_table_$recoverable_error then
		     call ssu_$abort_line (ssu_ptr, code, "Filling transaction.");
		text_ptr = prseg_ptr;
	     end;
	else do;
		fill_len = forum_user_trans.text_length;
		text_ptr = addr (forum_user_trans.text);
	     end;
	no_lines = line_count (text, fill_len);

	if ^list_switch then do;

		if ^temp_forum & trans_index ^= 0 then passport.current_trans = trans_index;
						/* don't set current to unproc */
		if formatted & current_line + no_lines + 4 >= page_len then call new_page ("0"b, "0"b);

		if header_switch then do;
			if trans_index = 0 then
			     call ioa_$ioa_switch (iocb_ptr, "^/[????] (^d line^[s^]) ^a.^a **UNPROCESSED**^[ ^a^]", no_lines,
				(no_lines ^= 1), forum_user_trans.person_id, forum_user_trans.project_id,
				^formatted, substr (passport.unprocessed_forum_name, 1, passport.unprocessed_name_len));

			else call ioa_$ioa_switch (iocb_ptr, "^/[^a] (^i line^[s^]) ^a.^a ^a^[ ^a^]", ltrim (trans_pic), no_lines,
				(no_lines ^= 1), forum_user_trans.person_id, forum_user_trans.project_id, fmt_trans_time, ^formatted, forum_name);

			if forum_user_trans.subject ^= "" then do;
				if forum_user_trans.subject_length > line_len - 10 then call format_subject ();
				else call ioa_$ioa_switch (iocb_ptr, "Subject:  ^a", forum_user_trans.subject);
			     end;
		     end;

		if formatted &
		     ((no_lines > page_len - 4) | (index (text, FF) > 0)) then call print_split ();
		else do;
			call ioa_$ioa_switch_nnl (iocb_ptr, "^a", text);
			current_line = current_line + no_lines + 4;
		     end;

		if trans_index = 0 then pref = passport.unprocessed_reply_trans;
		pref_pic = pref;
		nref_pic = nref;
		call ioa_$ioa_switch_nnl (iocb_ptr, "^[---[^[^s????^;^a^]]---^[ (^[pref = [^a]^[, nref = [^a]) ^;^s) ^]^;^s^snref = [^a]) ^]^;^4s^]^[ (more)^]^;^8s^]^[" || separator || "^;^[^/^]^]",
		     (trailer_format > TFMT_none),
		     (trans_index = 0), ltrim (trans_pic),
		     ((pref ^= 0) | (nref ^= 0)) & trailer_format = TFMT_reference,
		     (pref ^= 0), ltrim (pref_pic), (nref ^= 0), ltrim (nref_pic),
		     ((trailer_format = TFMT_more) & (nref ^= 0)),
		     sep_switch, (trailer_format > TFMT_none));

		if print_switch then call iox_$control (iox_$user_output, "reset_more", null (), (0));

		if trans_index ^= 0 then do;
			if forum_idx < 0 then
			     call forum_$set_seen_switch (forum_idx, "", trans_index, "1"b, code);
			else call forum_$set_last_seen_idx (forum_idx, trans_index, "0"b, code);
			if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Setting seen switch.");
		     end;

	     end;					/* ^list */

	else do;					/* list */
		if ^long_switch then control = "[^[????^s^;^a^]]^[*^s^;^[!^; ^]^]^9t(^d)^16t^3s^a^s^vt^[^a^s^;^s^a^v.0t<More>^]";
		else do;
						/* TR21386: Fix list request to generate valid summary for unproc trans */
			if trans_index = 0 then control = "^4s[????]   (^d)^16t**UNPROCESSED**^32t^3s";
			else control = "^s[^a]^[*^s^;^[!^; ^]^]^9t(^i)^16t^8a ^2a:^2a  ";
			control = control || "^a.^a^s^56t^[^a^s^;^s^a^v.0t<More>^]";
		     end;
		call ioa_$ioa_switch (iocb_ptr, control, (trans_index = 0), ltrim (trans_pic),
		     (trans_index = passport.current_trans), deleted, no_lines, substr (trans_time, 1, 8),
		     substr (trans_time, 11, 2), substr (trans_time, 13, 2), forum_user_trans.person_id,
		     forum_user_trans.project_id, line_len - sj_width,
		     (length (rtrim (forum_user_trans.subject)) <= sj_width | dont_truncate),
		     forum_user_trans.subject, substr (forum_user_trans.subject, 1, sj_width - 6), sj_width);
	     end;
	return;
     end output_transaction;
%page;
print_split:
     proc ();

	declare (idx, jdx)		 fixed bin,
	        found_ff		 bit (1) aligned;

	idx = split (text, fill_len, page_len - 4);	/* header already printed */
	current_line = current_line + 3;

	do while ("1"b);
	     jdx = index (substr (text, 1, idx), FF);
	     if jdx > 0 then do;
		     found_ff = "1"b;
		     idx = jdx - 1;
		     do while (substr (text, jdx + 1, 1) = NL);
			jdx = jdx + 1;		/* Skip NL's after FF, not needed. */
		     end;
		     current_line = current_line + line_count (text, (idx));
		end;
	     else do;
		     jdx = idx;
		     found_ff = "0"b;
		end;

	     call ioa_$ioa_switch_nnl (iocb_ptr, "^a", substr (text, 1, idx));
	     if jdx = fill_len then do;
		     current_line = line_count (text, (idx)) + 2;
		     return;
		end;

	     call new_page ("0"b, ^found_ff);
	     call ioa_$ioa_switch (iocb_ptr, "");	/* blank line after header */
	     current_line = 1;
	     text_ptr = addcharno (text_ptr, jdx);
	     fill_len = fill_len - jdx;
	     idx = split (text, fill_len, page_len - 2);
	end;
     end print_split;

line_count:
     proc (string, len) returns (fixed bin);

	declare string		 char (*),
	        (len, kdx)		 fixed bin (21),
	        P_max		 fixed bin,
	        (count, max)	 fixed bin,
	        (idx, jdx)		 fixed bin;

	max = 100000;
	goto COMMON;

split: entry (string, len, P_max) returns (fixed bin);

	max = P_max;
COMMON:

/* 524288 = 128K words of characters */

	if len > 524288 then return (max);
	idx, count = 0;
	kdx = len;

	begin;

	     declare 1 text,
		     2 used	      char (idx),
		     2 after	      char (kdx);

	     text = string;
	     do while (kdx > 0 & count < max);
		jdx = index (after, NL);
		if jdx = 0 then kdx = -1;
		else do;
			idx = idx + jdx;
			kdx = kdx - jdx;
			count = count + 1;
		     end;
	     end;
	end;
	if max = 100000 then return (count);
	if kdx = -1 then idx = len;
	return (idx);

     end line_count;


new_page:
     proc (last_page, in_trans);

	declare (last_page, in_trans)	 bit (1) aligned,
	        blanks		 fixed bin;

	if page_number > 0 then do;			/* write footer */
		if in_trans then blanks = 1;
		else blanks = page_len - current_line;
		call ioa_$ioa_switch_nnl (iocb_ptr, "^v(^/^)^v(_^)^/Subject: ^a^[^|^]", blanks, line_len,
		     substr (page_subject, 1, min (72, line_len) - 9), ^last_page);
	     end;

	if last_page then return;
	page_number = page_number + 1;
	current_line = 0;
	page_subject = forum_user_trans.subject;
	call ioa_$ioa_switch (iocb_ptr, rtrim (page_header), page_number);

	return;
     end new_page;
%page;
format_subject:
     proc ();

	declare 1 fdo		 aligned like format_document_options,
	        subject_lines	 fixed bin,
	        temp		 char (2 * forum_user_trans.subject_length),
	        temp_len		 fixed bin (21);

	fdo.version_number = format_document_version_2;
	fdo.indentation = 10;
	fdo.line_length = line_len - 10;
	string (fdo.switches) = ""b;
	fdo.literal_sw, fdo.galley_sw, fdo.dont_compress_sw, fdo.dont_break_indented_lines_sw = "1"b;
	fdo.syllable_size = 3;			/* Make fdoc happy */

	call format_document_$string (forum_user_trans.subject, temp, temp_len, addr (fdo), code);
	if (code ^= 0) & code ^= error_table_$recoverable_error then
	     call ssu_$abort_line (ssu_ptr, code, "Unable to format subject.");

	if formatted then do;			/* account for multi-line subject */
		subject_lines = line_count (temp, temp_len) - 1; /* -1 because we already counted subject as one line */
		current_line = current_line + subject_lines;
		no_lines = no_lines + subject_lines;
	     end;

	call ioa_$ioa_switch (iocb_ptr, "Subject:  ^a", substr (temp, 11, temp_len - 11));
	return;
     end format_subject;
%page;
delete_transactions:				/* Entry to allow chairman to logically remove */
     entry (P_ssu_ptr, P_passport_info_ptr);		/* and retrieve transactions */

	delete_switch = "1"b;
	goto DLRT_COMMON;

retrieve_transactions:
     entry (P_ssu_ptr, P_passport_info_ptr);

	delete_switch = "0"b;
DLRT_COMMON:
	call setup_request ();

	on cleanup call cleanup_handler ();
	parse_flags_word = NON_NULL | DISALLOW_MTG | DISALLOW_REV | DISALLOW_IDL | DISALLOW_BYCHAIN;

	if ^delete_switch then
	     parse_flags_word = parse_flags_word | MUST_BE_DELETED | DISALLOW_UNPROC | DISALLOW_CMSG;
	else parse_flags_word = parse_flags_word | ALLOW_DELETED;

	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, delete_args, temp_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	current_switch = "0"b;
	do tidx = 1 to forum_trans_list.size;
	     i = forum_trans_list.trans_num (tidx);
	     if i = 0 then call delete_unproc ();
	     else if i = -1 then do;
		     call forum_$set_message (forum_idx, "", code);
		     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Deleting message.");
		end;
	     else do;
		     call forum_$set_delete_sw (forum_idx, i, delete_switch, code);
		     if code ^= 0 then
			call ssu_$print_message (ssu_ptr, code, "Setting delete switch on transaction ^d.", i);
		     if delete_switch then
			if i = passport.current_trans then current_switch = "1"b; /* oops, deleted current */
		end;
	end;

	if current_switch then do;			/* set current to next undeleted transaction */
		do tidx = passport.current_trans repeat tidx + 1 while (current_switch & delete_switch);
		     call forum_$trans_ref_info (forum_idx, tidx, (0), (0), (0), delete_switch, code);
		     if code = forum_et_$invalid_trans_idx then current_switch = "0"b;
		     else if code = forum_et_$trans_reaped
		     then do;
			     delete_switch = "1"b;	/* expluge is very deleted */
			     current_switch = "0"b;
			end;
		     else if code ^= 0 then call ssu_$abort_line (ssu_ptr, code);
		end;
		if current_switch then passport.current_trans = tidx - 1;
		else do;
			passport.current_trans = 0;
			call forum_$forum_limits (forum_idx, ONLY_UNDELETED, (0), (0), tidx, (0), ("0"b), code);
			if code ^= 0 then do;
				call ssu_$abort_line (ssu_ptr, code);
			     end;
		     end;
	     end;

	call cleanup_handler;
	return;
%page;
delete_args:					/* process dl/rt args - there aren't any */
     proc (L_arg_idx);

	declare L_arg_idx		 fixed bin;

	call ssu_$arg_ptr (ssu_ptr, L_arg_idx, arg_ptr, arg_len);
	call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	return;
     end delete_args;


delete_unproc:
     proc ();

	free passport.unprocessed_trans_ptr -> forum_user_trans;
	passport.unprocessed_reply_trans = 0;
	passport.unprocessed_forum_dir = "";
	passport.unprocessed_forum_name = "";
	return;
     end delete_unproc;
%page;
reset_transaction:					/* Entry to allow user to reset current trans index */
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request ();

	current_switch = "1"b;			/* reset current by default */

	parse_flags_word = ONLY_ONE | NON_NULL | DISALLOW_MTG | DISALLOW_REV | DISALLOW_IDL | DISALLOW_UNPROC |
	     DISALLOW_BYCHAIN | DISALLOW_CMSG;
	i = 0;

	on cleanup call cleanup_handler ();

	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, reset_args, temp_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	tidx = forum_trans_list.trans_num (1);

	if i = 0 then passport.current_trans = tidx;
	else if i = 2 then passport.current_trans = tidx - 1;
	else do;
		if i = 1 then tidx = tidx + 1;
		if forum_idx > 0 then do;
			call forum_$set_last_seen_idx (forum_idx, tidx - 1, "1"b, code);
			if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Setting highest seen.");
		     end;
		else call ssu_$abort_line (ssu_ptr, 0, "reset -^[highest^;new^] is obsolete, use seen switches instead.",
			i = 1);
	     end;
	call cleanup_handler ();
	return;

reset_args:					/* process reset's arg */
     proc (L_arg_idx);

	declare L_arg_idx		 fixed bin;

	argument_idx = L_arg_idx;
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);

	if arg = "-current" then i = 0;
	else if arg = "-highest" then i = 1;
	else if arg = "-next" then i = 2;
	else if arg = "-new" then i = 3;
	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, arg);
	return;
     end reset_args;
%page;
should_be_filled:
     proc (filled_bit) returns (bit (1));

	declare filled_bit		 bit (1) aligned;

	if fill_index = 1 then return ("1"b);
	if fill_index = 2 then return ("0"b);
	if passport.print_fill then return (^filled_bit);
	return ("0"b);

     end;

get_trailer_format:
     procedure () returns (fixed bin);

	if argument_idx = arg_count then
	     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
	argument_idx = argument_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, argument_idx, arg_ptr, arg_len);

	if arg = "none" then return (TFMT_none);
	else if arg = "number" | arg = "nb" then return (TFMT_number);
	else if arg = "more" then return (TFMT_more);
	else if arg = "references" | arg = "refs" then return (TFMT_reference);
	else call ssu_$abort_line (ssu_ptr, 0, "Invalid trailer format: ^a.", arg);

     end get_trailer_format;
%page;
setup_request:
     procedure ();

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	call ssu_$return_arg (ssu_ptr, arg_count, active_function, ret_ptr, ret_len);
	owner = ssu_$get_subsystem_and_request_name (ssu_ptr);

	forum_idx = passport.forum_idx;
	forum_name = no_suffix_name;
	temp_forum, formatted, dont_truncate = "0"b;
	temp_idx = 0;
	line_len = passport.output_fill_width;
	write_switch, print_switch, list_switch = "0"b;
	user_entry = "";
	forum_trans_list_ptr, iocb_ptr, prseg_ptr = null ();
	trailer_format = passport.trailer_format;
	return;

     end setup_request;
%page;
cleanup_handler:
     procedure ();

	if temp_forum then call forum_$close_forum (forum_idx, (0));

	if iocb_ptr ^= iox_$user_output & iocb_ptr ^= null () then do;
		call iox_$close (iocb_ptr, (0));
		call iox_$detach_iocb (iocb_ptr, (0));
		call iox_$destroy_iocb (iocb_ptr, (0));
	     end;

	call ipc_$reconnect (passport.public_channel, (0));
	if prseg_ptr ^= null then call release_temp_segment_ (owner, prseg_ptr, (0));

	if forum_trans_list_ptr ^= null () then free forum_trans_list;

	return;
     end cleanup_handler;

     end forum_output_requests_$write_transactions;
   



		    forum_request_tables_.alm       11/05/86  1559.6r w 11/04/86  1038.6      220779


" ***************************************************************
" *                                                             *
" * Copyright, (C) Massachusetts Institute of Technology, 1986  *
" *                                                             *
" * Copyright (c) 1982 by Massachusetts Institute of Technology *
" *                                                             *
" ***************************************************************

" HISTORY COMMENTS:
"  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
"     audit(86-08-03,Margolin), install(86-08-16,MR12.0-1128):
"     added bref request.
"  2) change(86-07-29,Pattin), approve(86-07-29,MCR7356),
"     audit(86-08-03,Margolin), install(86-08-16,MR12.0-1128):
"     Added rechain and unchain requests.
"                                                      END HISTORY COMMENTS


name      forum_request_tables_

" requests for forum
" modified 9/24/82 Jay Pattin to remove standard ssu_ requests.

          include   ssu_request_macros

          begin_table	user_requests

	request	.,
		forum_misc_requests_$dot_request,
		(),
		(Print current status.)

          request   goto,
                    forum_requests_$goto_request,
                    (g,go),
                    (Enter a meeting.),
                    flags.allow_command

          request   list,
                    forum_output_requests_$list_transactions,
                    (ls),
                    (List the specified transactions.),
		flags.allow_both

          request   print,
                    forum_output_requests_$print_transactions,
                    (p,pr),
                    (Print the specified transactions.),
                    flags.allow_command

          request   quit,
                    forum_requests_$quit_request,
                    (q),
                    (Exit forum.)

	request	add_meeting,
		forum_add_meeting$add_meeting,
		(am),
		(Add meetings to the "forum" search path.)

	request	announce_meeting,
		forum_create$announce_meeting,
		(anm),
		(Place an announcement of this meeting in another meeting.)

	request	announcement_info,
		forum_add_meeting$announcement_info,
		(ai),
		(Extract information from a meeting announcement.),
		flags.allow_both

	request	apply,
		forum_input_requests_$apply_request,
		(ap),
		(Apply a Multics command to the unprocessed transaction.)

	request	chairman,
		forum_misc_requests_$chairman_request,
		(cm),
                    (Print/return the name of the chairman of the meeting.),
		flags.allow_both

	request	check_meetings,
		forum_list_meetings$check_meetings,
		(ckm),
		(Builds a list of changed meetings.)

          request   current_meeting,
                    forum_misc_requests_$current_meeting,
                    (cmtg),
                    (Print/return the name of the current meeting.),
		flags.allow_both

          request   delete,
                    forum_output_requests_$delete_transactions,
                    (dl,d),
                    (Delete specified transactions entered by you.),

          request   delete_participant,
                    forum_misc_requests_$delete_participant,
                    (dlpt),
                    (Delete the specified participants.),
                    flags.allow_command+flags.dont_summarize+flags.dont_list

	request	enter,
		forum_input_requests_$enter_request,
		(en,send),
		(Enter the unprocessed transaction.)

	request	expunge,
		forum_misc_requests_$expunge,
		(),
		(Physically remove deleted participants and transactions.),
		flags.allow_command+flags.dont_list+flags.dont_summarize

	request	fill,
		forum_input_requests_$fill_request,
		(fi),
		(Format unprocessed tranaction to fit in a given width.)

	request	forum_dir,
		forum_misc_requests_$forum_dir_request,
		(fd),
		(Print/return pathname of central forum directory.),
		flags.allow_both

	request	list_meetings,
		forum_list_meetings$forum_list_request,
		(lsm),
		(Print information about meetings.),
		flags.allow_both

	request	list_users,
		forum_list_users$list_users_request,
		(lsu),
		(Print information about meeting participants.),
		flags.allow_both

	request	mail,
		forum_mailer_$mail,
		(),
		(Mail specified transactions.)

	request	next_meeting,
		forum_list_meetings$next_meeting,
		(nm),
		(Goto the next meeting in the changed meetings list.),
		flags.allow_both

	request	qedx,
		forum_input_requests_$qedx_request,
		(qx),
		(Edit the unprocessed transaction.)

	request	rechain,
		forum_misc_requests_$rechain,
		(),
		(Move a transaction to another chain.),
		flags.allow_command+flags.dont_list+flags.dont_summarize

	request	remove_meeting,
		forum_add_meeting$remove_meeting,
		(rm),
		(Remove a meeting from the "forum" search path.)

	request	reply,
		forum_input_requests_$reply_request,
		(rp),
		(Enter a reply to the specified transaction.)

          request   reset,
                    forum_output_requests_$reset_transaction,
                    (rs),
		(Change current or highest seen transaction indices.)

          request   retrieve,
                    forum_output_requests_$retrieve_transactions,
                    (rt),
		(Retrieve transactions deleted by you.),

	request	retrieve_participants,
		forum_misc_requests_$retrieve_participant,
		(rtpt),
		(Retrieve deleted participants.),
	          flags.allow_command+flags.dont_summarize+flags.dont_list

	request	set_message,
		forum_input_requests_$set_message,
		(),
		(Set a greeting message for the meeting.),
	          flags.allow_command+flags.dont_summarize+flags.dont_list

	request	subject,
		forum_input_requests_$subject_request,
		(sj),
		(Print/modify/return subject of unprocessed transaction.),
		flags.allow_both

	request	switch_off,
		forum_misc_requests_$switch_off,
		(swf),
		(Resets various switches.),

	request	switch_on,
		forum_misc_requests_$switch_on,
		(swn),
		(Sets various switches.),

	request	talk,
		forum_input_requests_$talk_request,
		(t),
		(Enter a new transaction.)

	request	ted,
		forum_input_requests_$ted_request,
		(),
		(Invoke ted to edit the unprocessed transaction.)

	request	unchain,
		forum_misc_requests_$unchain,
		(),
		(Remove a transaction from its chain.),
		flags.allow_command+flags.dont_list+flags.dont_summarize

          request   write,
                    forum_output_requests_$write_transactions,
                    (w),
                    (Write the specified transactions to a segment.)

	request	add_participant,
		forum_add_participant$add_participant,
		(apt),
		(Allow a user to participate in the meeting.),
		flags.allow_command+flags.dont_list+flags.dont_summarize
	
	request	add_project,
		forum_add_participant$add_project,
		(apj),
		(Allow all users on a project to participate in the meeting.),
		flags.allow_command+flags.dont_list+flags.dont_summarize
	
	request	remove_participant,
		forum_add_participant$remove_participant,
		(rpt),
		(Restrict a user from participating in the meeting.),
		flags.allow_command+flags.dont_list+flags.dont_summarize
	
	request	remove_project,
		forum_add_participant$remove_project,
		(rpj),
		(Restrict a project from participating in the meeting.),
		flags.allow_command+flags.dont_list+flags.dont_summarize
	
	request	make_public,
		forum_add_participant$make_public,
		(mp),
		(Allow all users to participate in the meeting.),
		flags.allow_command+flags.dont_list+flags.dont_summarize
	
	request	unmake_public,
		forum_add_participant$unmake_public,
		(ump),
		(Restrict the meeting to specified users only.),
		flags.allow_command+flags.dont_list+flags.dont_summarize

          request   first,
                    forum_trans_specs_$first_request,
                    (f),
                    (Print/return the index of the first transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   last,
                    forum_trans_specs_$last_request,
                    (l),
                    (Print/return the index of the last transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   previous,
                    forum_trans_specs_$previous_request,
                    (prev,prior),
                    (Print/return the index of the previous transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   next,
                    forum_trans_specs_$next_request,
                    (),
                    (Print/return the index of the next transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   current,
                    forum_trans_specs_$current_request,
                    (c),
                    (Print/return the index of the current transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   firstref,
                    forum_trans_specs_$fref_request,
                    (fref),
                    (Print/return the index of the first transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   lastref,
                    forum_trans_specs_$lref_request,
                    (lref),
                    (Print/return the index of the last transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   previousref,
                    forum_trans_specs_$pref_request,
                    (priorref,pref),
                    (Print/return the index of the previous transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   nextref,
                    forum_trans_specs_$nref_request,
                    (nref),
                    (Print/return the index of the next transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   all,
                    forum_trans_specs_$all_request,
                    (),
                    (Print/return the index of all transactions.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   new,
                    forum_trans_specs_$new_request,
                    (),
                    (Print/return the indices of all new transactions.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   allref,
                    forum_trans_specs_$aref_request,
                    (aref),
                    (Print/return the indices of all transactions in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

	request	restref,
		forum_trans_specs_$rref_request,
		(rref),
		(Print/return the indices of the rest of the transactions in the current chain.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	beforeref,
		forum_trans_specs_$bref_request,
		(bref),
		(Print/return the indices of all previous transactions in the current chain.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	seen,
		forum_trans_specs_$seen_request,
		(),
		(Print/return the indices of all seen transactions.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	first_seen,
		forum_trans_specs_$first_seen_request,
		(fs),
		(Print/return the index of the first seen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	next_seen,
		forum_trans_specs_$next_seen_request,
		(ns),
		(Print/return the index of the next seen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	previous_seen,
		forum_trans_specs_$prev_seen_request,
		(ps),
		(Print/return the index of the transactions.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	last_seen,
		forum_trans_specs_$last_seen_request,
		(),
		(Print/return the index of the highest seen transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

	request	unseen,
		forum_trans_specs_$unseen_request,
		(),
		(Print/return the indices of all unseen transactions.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	first_unseen,
		forum_trans_specs_$first_unseen_request,
		(fu),
		(Print/return the index of the first unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	next_unseen,
		forum_trans_specs_$next_unseen_request,
		(nu),
		(Print/return the index of the next unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	previous_unseen,
		forum_trans_specs_$prev_unseen_request,
		(pu),
		(Print/return the index of the previous unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	last_unseen,
		forum_trans_specs_$last_unseen_request,
		(lu),
		(Print/return the index of the last unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

"	unknown_request	debug_mode

          end_table		user_requests

          begin_table	chairman_requests

	request	.,
		forum_misc_requests_$dot_request,
		(),
		(Print current status.)

          request   goto,
                    forum_requests_$goto_request,
                    (g,go),
                    (Enter a meeting.),
                    flags.allow_command

          request   list,
                    forum_output_requests_$list_transactions,
                    (ls),
                    (List the specified transactions.),
		flags.allow_both

          request   print,
                    forum_output_requests_$print_transactions,
                    (p,pr),
                    (Print the specified transactions.)

          request   quit,
                    forum_requests_$quit_request,
                    (q),
                    (Exit forum.)

	request	add_meeting,
		forum_add_meeting$add_meeting,
		(am),
		(Add meetings to the "forum" search path.)

	request	announce_meeting,
		forum_create$announce_meeting,
		(anm),
		(Place an announcement of this meeting in another meeting.)

	request	announcement_info,
		forum_add_meeting$announcement_info,
		(ai),
		(Extract information from a meeting announcement.),
		flags.allow_both

	request	apply,
		forum_input_requests_$apply_request,
		(ap),
		(Apply a Multics command to the unprocessed transaction.)

	request	chairman,
		forum_misc_requests_$chairman_request,
		(cm),
                    (Print/return the name of the chairman of the meeting.),
		flags.allow_both

	request	check_meetings,
		forum_list_meetings$check_meetings,
		(ckm),
		(Builds a list of changed meetings.)

          request   current_meeting,
                    forum_misc_requests_$current_meeting,
                    (cmtg),
                    (Print/return the name of the current meeting.),
		flags.allow_both

          request   delete,
                    forum_output_requests_$delete_transactions,
                    (dl,d),
                    (Delete the specified transactions.)

          request   delete_participant,
                    forum_misc_requests_$delete_participant,
                    (dlpt),
                    (Delete the specified participants.)

	request	enter,
		forum_input_requests_$enter_request,
		(en,send),
		(Enter the unprocessed transaction.)

	request	expunge,
		forum_misc_requests_$expunge,
		(),
		(Physically remove deleted participants and transactions.)

	request	fill,
		forum_input_requests_$fill_request,
		(fi),
		(Format unprocessed tranaction to fit in a given width.)

	request	forum_dir,
		forum_misc_requests_$forum_dir_request,
		(fd),
		(Print/return pathname of central forum directory.),
		flags.allow_both

	request	list_meetings,
		forum_list_meetings$forum_list_request,
		(lsm),
		(Print information about meetings.),
		flags.allow_both

	request	list_users,
		forum_list_users$list_users_request,
		(lsu),
		(Print information about meeting participants.),
		flags.allow_both

	request	mail,
		forum_mailer_$mail,
		(),
		(Mail specified transactions.)

	request	next_meeting,
		forum_list_meetings$next_meeting,
		(nm),
		(Goto the next meeting in the changed meetings list.),
		flags.allow_both

	request	qedx,
		forum_input_requests_$qedx_request,
		(qx),
		(Edit the unprocessed transaction.)

	request	rechain,
		forum_misc_requests_$rechain,
		(),
		(Move a transaction to another chain.)

	request	remove_meeting,
		forum_add_meeting$remove_meeting,
		(rm),
		(Remove a meeting from the "forum" search path.)

	request	reply,
		forum_input_requests_$reply_request,
		(rp),
		(Enter a reply to the specified transaction.)

          request   reset,
                    forum_output_requests_$reset_transaction,
                    (rs),
		(Change current or highest seen transaction indices.)

          request   retrieve,
                    forum_output_requests_$retrieve_transactions,
                    (rt),
		(Retrieve specified deleted transactions.)

	request	retrieve_participants,
		forum_misc_requests_$retrieve_participant,
		(rtpt),
		(Retrieve deleted participants.)

	request	set_message,
		forum_input_requests_$set_message,
		(),
		(Set a greeting message for the meeting.)

	request	subject,
		forum_input_requests_$subject_request,
		(sj),
		(Print/modify/return subject of unprocessed transaction.),
		flags.allow_both

	request	switch_off,
		forum_misc_requests_$switch_off,
		(swf),
		(Resets various switches.),

	request	switch_on,
		forum_misc_requests_$switch_on,
		(swn),
		(Sets various switches.),

	request	talk,
		forum_input_requests_$talk_request,
		(t),
		(Enter a new transaction.),

	request	ted,
		forum_input_requests_$ted_request,
		(),
		(Invoke ted to edit the unprocessed transaction.)

	request	unchain,
		forum_misc_requests_$unchain,
		(),
		(Remove a transaction from its chain.)

          request   write,
                    forum_output_requests_$write_transactions,
                    (w),
                    (Write the specified transactions to a segment.)

	request	add_participant,
		forum_add_participant$add_participant,
		(apt),
		(Allow a user to participate in the meeting.),
		flags.allow_command
	
	request	add_project,
		forum_add_participant$add_project,
		(apj),
		(Allow all users on a project to participate in the meeting.),
		flags.allow_command
	
	request	remove_participant,
		forum_add_participant$remove_participant,
		(rpt),
		(Restrict a user from participating in the meeting.),
		flags.allow_command
	
	request	remove_project,
		forum_add_participant$remove_project,
		(rpj),
		(Restrict a project from participating in the meeting.),
		flags.allow_command
	
	request	make_public,
		forum_add_participant$make_public,
		(mp),
		(Allow all users to participate in the meeting.),
		flags.allow_command
	
	request	unmake_public,
		forum_add_participant$unmake_public,
		(ump),
		(Restrict the meeting to specified users only.),
		flags.allow_command

          request   first,
                    forum_trans_specs_$first_request,
                    (f),
                    (Print/return the index of the first transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   last,
                    forum_trans_specs_$last_request,
                    (l),
                    (Print/return the index of the last transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   previous,
                    forum_trans_specs_$previous_request,
                    (prev,prior),
                    (Print/return the index of the previous transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   next,
                    forum_trans_specs_$next_request,
                    (),
                    (Print/return the index of the next transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   current,
                    forum_trans_specs_$current_request,
                    (c),
                    (Print/return the index of the current transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   firstref,
                    forum_trans_specs_$fref_request,
                    (fref),
                    (Print/return the index of the first transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   lastref,
                    forum_trans_specs_$lref_request,
                    (lref),
                    (Print/return the index of the last transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   previousref,
                    forum_trans_specs_$pref_request,
                    (priorref,pref),
                    (Print/return the index of the previous transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   nextref,
                    forum_trans_specs_$nref_request,
                    (nref),
                    (Print/return the index of the next transaction in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   all,
                    forum_trans_specs_$all_request,
                    (),
                    (Print/return the index of all transactions.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   new,
                    forum_trans_specs_$new_request,
                    (),
                    (Print/return the indices of all new transactions.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

          request   allref,
                    forum_trans_specs_$aref_request,
                    (aref),
                    (Print/return the indices of all transactions in the current chain.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

	request	restref,
		forum_trans_specs_$rref_request,
		(rref),
		(Print/return the indices of the rest of the transactions in the current chain.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	beforeref,
		forum_trans_specs_$bref_request,
		(bref),
		(Print/return the indices of all previous transactions in the current chain.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	seen,
		forum_trans_specs_$seen_request,
		(),
		(Print/return the indices of all seen transactions.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	first_seen,
		forum_trans_specs_$first_seen_request,
		(fs),
		(Print/return the index of the first seen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	next_seen,
		forum_trans_specs_$next_seen_request,
		(ns),
		(Print/return the index of the next seen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	previous_seen,
		forum_trans_specs_$prev_seen_request,
		(ps),
		(Print/return the index of the transactions.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	last_seen,
		forum_trans_specs_$last_seen_request,
		(),
		(Print/return the index of the highest seen transaction.),
                    flags.allow_both+flags.dont_list+flags.dont_summarize

	request	unseen,
		forum_trans_specs_$unseen_request,
		(),
		(Print/return the indices of all unseen transactions.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	first_unseen,
		forum_trans_specs_$first_unseen_request,
		(fu),
		(Print/return the index of the first unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	next_unseen,
		forum_trans_specs_$next_unseen_request,
		(nu),
		(Print/return the index of the next unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	previous_unseen,
		forum_trans_specs_$prev_unseen_request,
		(pu),
		(Print/return the index of the previous unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

	request	last_unseen,
		forum_trans_specs_$last_unseen_request,
		(lu),
		(Print/return the index of the last unseen transaction.),
		flags.allow_both+flags.dont_list+flags.dont_summarize

"	unknown_request	debug_mode

          end_table		chairman_requests

          end
 



		    forum_requests_.pl1             09/28/92  1718.2r w 09/28/92  1715.0      203157


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) BULL HN Information Systems Inc., 1992       *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(91-09-05,Huen), approve(91-09-05,MCR8248),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     Fix several TRs (phx21375, 21376, 21377) related to the current trans.
  2) change(92-09-10,Zimmerman), approve(92-09-10,MCR8258),
     audit(92-09-22,WAAnderson), install(92-09-28,MR12.5-1020):
     Problem with current being set to deleted txn., or being set to -1.
                                                   END HISTORY COMMENTS */


/* This module contains the following forum requests:

   goto   quit

and the useful routine find_forum for turning a string into a forum path.

Originally coded by J. Spencer Love and Jay Pattin 6/81
modified for ssu_ 8/21/81 Jay Pattin
changed search path searching to fix forum bug 7 6/27/82 Jay Pattin
new request table management 11/3/82 Jay Pattin
Make notifications work with multiple invocations. 11/15/84 Jay Pattin
*/

forum_requests_$set_forum:
     procedure (P_passport_info_ptr, P_forum_spec, P_status);

	declare P_passport_info_ptr	 ptr,
	        P_ssu_ptr		 ptr,
	        P_forum_spec	 char (*),
	        P_forum_idx		 fixed bin,
	        P_forum_dir		 char (*),
	        P_forum_name	 char (*),
	        P_forum_name_len	 fixed bin,
	        P_status		 fixed bin (35);

	declare (addr, codeptr, length, min, null, rtrim, search, string, substr)
				 builtin;

	declare cleanup		 condition;

	declare answer		 char (8) varying,
	        arg_count		 fixed bin,
	        arg_idx		 fixed bin,
	        arg_len		 fixed bin (21),
	        arg_ptr		 ptr,
	        egress		 label variable,
	        force_switch	 bit (1) aligned,
	        forum_arg_count	 fixed bin,
	        forum_arg_len	 fixed bin (21),
	        forum_arg_ptr	 ptr,
	        forum_dir		 char (168),
	        forum_idx		 fixed bin,
	        full_forum_name	 char (32),	/* has suffix on it */
	        forum_name_len	 fixed bin,
	        message		 char (256),
	        return_switch	 bit (1) aligned,
	        ssu_ptr		 ptr,
	        user_name		 char (32),
	        status		 fixed bin (35),
	        want_forum		 bit (1) aligned;

	declare static_event_channel	 fixed bin (71) static init (0),
	        static_passport_list_ptr pointer static init (null ());

	declare 1 event_call_info	 aligned based (event_info_ptr),
		2 channel_id	 fixed bin (71),
		2 forum_message,
		  3 forum_uid	 bit (36) aligned,	/* what happened? */
		  3 offset	 bit (18),	/* who did it? */
		2 pad		 fixed bin (71),	/* we don't care about this */
		2 data_ptr	 ptr;		/* pointer to our passport */

	declare arg		 char (arg_len) based (arg_ptr),
	        forum_arg		 char (forum_arg_len) based (forum_arg_ptr),
	        forum_name		 char (forum_name_len) based (addr (full_forum_name));

	declare (
	        forum_et_$blank_forum_name,
	        forum_et_$forum_deleted,
	        forum_et_$long_forum_name,
	        forum_et_$not_in_search_list,
	        forum_et_$no_such_forum,
	        forum_et_$old_format,
	        forum_request_tables_$chairman_requests,
	        forum_request_tables_$user_requests,
	        error_table_$badopt,
	        error_table_$entlong,
	        error_table_$noarg,
	        error_table_$noaccess,
	        error_table_$no_info,
	        error_table_$notadir)	 fixed bin (35) external;

	declare iox_$user_output	 ptr external;

	declare command_query_	 entry () options (variable),
	        forum_trans_util_$clear_cache entry (ptr),
	        forum_$close_forum	 entry (fixed bin, fixed bin (35)),
	        forum_$convert_attendee_idx entry (fixed bin, bit (18), char (*), fixed bin (35)),
	        forum_$get_forum_path	 entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	        forum_$get_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$forum_limits	 entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
				 bit (36) aligned, fixed bin (35)),
	        forum_$list_v1_forum_acl entry (char (*), char (*), ptr, ptr, fixed bin, fixed bin (35)),
	        forum_$list_forum_acl	 entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)),
	        forum_$open_forum	 entry (char (*), char (*), fixed bin, fixed bin (35)),
	        forum_$set_event_channel_idx
				 entry (fixed bin, fixed bin (71), fixed bin (35)),
	        forum_$set_switch_idx	 entry (fixed bin, char (*), char (*), bit (1) aligned, fixed bin (35)),
	        forum_$validate_uid	 entry (fixed bin, bit (36) aligned, fixed bin (35)),
	        convert_ipc_code_	 entry (fixed bin (35)),
	        expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	        get_system_free_area_	 entry returns (ptr),
	        (ioa_, ioa_$nnl)	 entry options (variable),
	        iox_$control	 entry (ptr, char (*), ptr, fixed bin (35)),
	        ipc_$create_ev_chn	 entry (fixed bin (71), fixed bin (35)),
	        ipc_$decl_ev_call_chn	 entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35)),
	        ipc_$delete_ev_chn	 entry (fixed bin (71), fixed bin (35)),
	        search_paths_$get	 entry (char (*), bit (36), char (*), ptr, ptr, fixed bin, ptr, fixed bin (35)),
	        ssu_$abort_line	 entry options (variable),
	        ssu_$abort_subsystem	 entry options (variable),
	        ssu_$arg_count	 entry (ptr, fixed bin),
	        ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin (21)),
	        ssu_$list_request_tables entry (ptr, ptr, fixed bin, ptr, fixed bin (35)),
	        ssu_$print_message	 entry options (variable),
	        ssu_$set_request_tables entry (ptr, ptr, fixed bin (35));
%page;
%include query_info;
%page;
%include forum_passport;
%page;
%include forum_flags;
%page;
%include forum_user_trans;
%page;
%include ssu_request_tables_list;
%page;
%include sl_info;
%include sl_control_s;
%page;
/* forum_requests_$set_forum:  procedure (P_subsystem_info_ptr, P_forum_spec, P_status);			*/

	passport_info_ptr = P_passport_info_ptr;
	ssu_ptr = passport.ssu_ptr;

	forum_idx = 0;
	egress = SET_MEETING_EXIT;

	call find_forum_path (P_forum_spec);

	on cleanup call clean_up_goto (passport.forum_idx);

	call forum_$open_forum (forum_dir, full_forum_name, forum_idx, status);
	if status ^= 0 then call error (status);

	call make_forum_current ();

	P_status = 0;

	return;

SET_MEETING_EXIT:
	call clean_up_goto (passport.forum_idx);

	P_status = status;

	return;
%page;
forum_requests_$open_forum:
     entry (P_forum_spec, P_forum_idx, P_forum_dir, P_forum_name, P_status);

	egress = OPEN_MEETING_EXIT;
	forum_idx = 0;
	passport_info_ptr = null ();

	call find_forum_path (P_forum_spec);

	on cleanup call clean_up_goto (P_forum_idx);

	call forum_$open_forum (forum_dir, full_forum_name, forum_idx, status);
	if status ^= 0 then call error (status);

	P_forum_idx = forum_idx;
	P_forum_dir = forum_dir;
	P_forum_name = substr (full_forum_name, 1, forum_name_len);
	P_status = 0;

	return;

OPEN_MEETING_EXIT:
	call clean_up_goto (P_forum_idx);

	P_forum_dir = "";
	P_forum_name = "";
	P_status = status;

	return;
%page;
forum_requests_$goto_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;

	call ssu_$arg_count (ssu_ptr, arg_count);

	forum_arg_count = 0;
	return_switch, want_forum = "0"b;

	do arg_idx = 1 to arg_count;

	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	     if want_forum | substr (arg, 1, min (1, arg_len)) ^= "-" then do;
		     forum_arg_ptr = arg_ptr;
		     forum_arg_len = arg_len;
		     forum_arg_count = forum_arg_count + 1;
		     want_forum = "0"b;
		end;
	     else do;
		     if arg = "-meeting" | arg = "-mtg" then do;
			     if arg_idx = arg_count then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
			     else want_forum = "1"b;
			end;
		     else if arg = "-return_on_error" | arg = "-roe" then return_switch = "1"b;
		     else if arg = "-no_return_on_error" | arg = "-nroe" then return_switch = "0"b;
		     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
		end;
	end;

	if forum_arg_count ^= 1 then call ssu_$abort_line (ssu_ptr, 0, "Usage:  g meeting_name {-control_arg}");

	egress = GOTO_EXIT;
	forum_idx = 0;

	on cleanup call clean_up_goto (passport.forum_idx);

	if ^return_switch then call close_old_forum ();

	call find_forum_path (forum_arg);

	call forum_$open_forum (forum_dir, full_forum_name, forum_idx, status);
	if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "^a^[>^]^a", forum_dir, forum_dir ^= ">", forum_name);

	if return_switch then call close_old_forum ();

	call make_forum_current ();

	if passport.unprocessed_trans_ptr ^= null () then
	     if passport.forum_name ^= passport.unprocessed_forum_name then
		call ssu_$print_message (ssu_ptr, 0, "Warning, there is an unprocessed transaction in the ^a meeting.",
		     substr (passport.unprocessed_forum_name, 1, passport.unprocessed_name_len));

	return;

GOTO_EXIT:
	call ssu_$abort_line (ssu_ptr, status, "^a", forum_arg);
%page;
forum_requests_$find_forum:
     entry (P_forum_spec, P_forum_dir, P_forum_name, P_forum_name_len, P_status);

	egress = FIND_MEETING_EXIT;

	call find_forum_path (P_forum_spec);

	P_forum_dir = forum_dir;
	P_forum_name = full_forum_name;
	P_forum_name_len = forum_name_len;

	P_status = 0;
	return;

FIND_MEETING_EXIT:
	P_status = status;
	return;
%page;
find_forum_path:
     procedure (arg);

	declare (before, index, reverse) builtin;
	declare arg		 char (*);
	declare idx		 fixed bin,
	        old_path		 bit (1) aligned,
	        real_dir		 char (168),
	        real_entry		 char (32);

	if search (arg, "<>") - 1 >= 0 then do;
		if index (arg, ".") > 0 & before (reverse (rtrim (arg)), ".") = "lortnoc" then goto V1PATH;
		call expand_pathname_$add_suffix (arg, "forum", forum_dir, full_forum_name, status);
		if status ^= 0 then
PATHERR:		     if status = error_table_$entlong
		     then call error (forum_et_$long_forum_name);
		     else call error (status);
		call forum_$get_forum_path (forum_dir, full_forum_name, real_dir, real_entry, status);
		if status = 0 then
		     forum_name_len = length (rtrim (real_entry)) - length (".forum");
		else if status ^= forum_et_$no_such_forum & status ^= error_table_$noaccess &
		     status ^= error_table_$no_info then
		     call error (status);
		else do;
V1PATH:			call expand_pathname_$add_suffix (arg, "control", forum_dir, full_forum_name, status);
			if status ^= 0 then goto PATHERR;
			call forum_$get_forum_path (forum_dir, full_forum_name, real_dir, real_entry, status);
			if status ^= 0 then call error (status);
			forum_name_len = length (rtrim (real_entry)) - length (".control");
		     end;

		full_forum_name = real_entry;
		forum_dir = real_dir;
		return;
	     end;

	forum_name_len = length (rtrim (arg));
	old_path = "0"b;

	if forum_name_len > length (".forum") then
	     if substr (arg, forum_name_len - length (".forum") + 1) = ".forum" then
		forum_name_len = forum_name_len - length (".forum");

	if forum_name_len > length (".control") then
	     if substr (arg, forum_name_len - length (".control") + 1) = ".control" then do;
		     forum_name_len = forum_name_len - length (".control");
		     old_path = "1"b;
		end;

	if forum_name_len < 1 then call error (forum_et_$blank_forum_name);
	if forum_name_len > 26 then call error (forum_et_$long_forum_name);

	forum_name = substr (arg, 1, forum_name_len);	/* Assign only the "interesting" part through the overlay.	*/
	if old_path then substr (full_forum_name, forum_name_len + 1) = ".control";
	else substr (full_forum_name, forum_name_len + 1) = ".forum";

	sl_info_p = null ();
	on cleanup begin;
		if sl_info_p ^= null () then free sl_info;
	     end;

	call search_paths_$get ("forum", sl_control_default, "", null (), get_system_free_area_ (), sl_info_version_1,
	     sl_info_p, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting ""forum"" search path.");

	forum_dir = "";
	if old_path then goto V1ENT;

	status = 1;
	do idx = 1 to sl_info.num_paths while (status ^= 0);
	     if sl_info.paths (idx).code = 0 then
		call forum_$get_forum_path (sl_info.pathname (idx), full_forum_name, real_dir, real_entry, status);
	     if status ^= 0 then
		if status ^= forum_et_$no_such_forum & status ^= error_table_$noaccess &
		     status ^= error_table_$no_info & status ^= error_table_$notadir then
		     call error (status);
	end;

	if status = 0 then
	     forum_name_len = length (rtrim (real_entry)) - length (".forum");
	else if status = forum_et_$no_such_forum | status = error_table_$notadir | status = error_table_$no_info |
	     status = error_table_$notadir then do;
		full_forum_name = forum_name || ".control";
V1ENT:		status = 1;
		do idx = 1 to sl_info.num_paths while (status ^= 0);
		     if sl_info.paths (idx).code = 0 then
			call forum_$get_forum_path (sl_info.pathname (idx), full_forum_name, real_dir,
			     real_entry, status);
		end;
		if status ^= 0 then call error (forum_et_$not_in_search_list);
		forum_name_len = length (rtrim (real_entry)) - length (".control");
	     end;
	else call error (status);

	free sl_info;
	forum_dir = real_dir;
	full_forum_name = real_entry;

	return;

     end find_forum_path;
%page;
make_forum_current:
     procedure ();

	declare last_seen_trans	 fixed bin,	/* highest seen only */
	        first_trans		 fixed bin,
	        last_trans		 fixed bin,
	        new_trans		 fixed bin;


	call forum_$forum_limits (forum_idx, ONLY_UNDELETED, last_seen_trans, first_trans, last_trans, new_trans, forum_flags_word,
	     status);
	if status ^= 0 then call error (status);

	passport.forum_idx = forum_idx;
	passport.forum_dir = forum_dir;
	passport.forum_name = full_forum_name;
	passport.forum_name_len = forum_name_len;
	passport.current_trans = last_seen_trans;

	passport.read_only = forum_flags.read_only;

	if passport.public_channel = 0 then
	     passport.public_channel = get_event_channel ();

	call forum_$set_event_channel_idx (forum_idx, passport.public_channel, status);
	if status ^= 0 then call error (status);

	if forum_flags.chairman then call set_request_tables (addr (forum_request_tables_$chairman_requests));
	else call set_request_tables (addr (forum_request_tables_$user_requests));

	if ^passport.brief_sw then
	     call ioa_ ("^a meeting:  ^d new, ^d last^[ (You are the chairman)^]^[ (Read-only)^].", forum_name,
		new_trans, last_trans, forum_flags.chairman, forum_flags.read_only);

	if forum_flags.adjourned then call ioa_ ("** The meeting has been adjourned. **");
	if forum_flags.print_acl_message then call print_acl_message ();
	if forum_flags.print_cm_message then do;
		call forum_$get_message (forum_idx, message, status);
		if status = 0 then call ioa_$nnl ("^a", message);
		call forum_$set_switch_idx (forum_idx, "", "message_seen", "1"b, (0));
	     end;
	passport.print_message = ^forum_flags.print_cm_message;

	return;

     end make_forum_current;
%page;
print_acl_message:
     proc ();

	declare acl_ptr		 ptr,
	        acl_count		 fixed bin,
	        (person, project)	 fixed bin,
	        1 acl		 (acl_count) aligned based (acl_ptr),
		2 access_name	 char (32),
		2 modes		 bit (36),
		2 xmodes		 bit (36),
		2 code		 fixed bin (35);

	acl_ptr = null ();
	on cleanup begin;
		if acl_ptr ^= null () then free acl;
	     end;

	call forum_$list_forum_acl (forum_dir, full_forum_name, passport.area_ptr, acl_ptr, null (), acl_count, status);
	if status ^= 0 then
	     if status = forum_et_$old_format then do;
		     call forum_$list_v1_forum_acl (forum_dir, full_forum_name, passport.area_ptr, acl_ptr, acl_count,
			status);
		     if status ^= 0 then goto PUNT;

		     do arg_idx = 1 to acl_count;
			acl.xmodes (arg_idx) = acl.modes (arg_idx);
		     end;
		end;
	     else do;
PUNT:		     call ssu_$print_message (ssu_ptr, status, "Listing ACL on meeting.");
		     return;
		end;

	if acl.access_name (acl_count) = "*.*.*" & acl.xmodes (acl_count) ^= ""b then
	     call ioa_ ("The meeting is public.");
	else do;
		person, project = 0;
		do arg_idx = 1 to acl_count while (substr (acl.access_name (arg_idx), 1, 2) ^= "*.");
		     if acl.xmodes (arg_idx) ^= ""b then person = person + 1;
		end;
		do arg_idx = arg_idx to acl_count;
		     if acl.xmodes (arg_idx) ^= ""b & acl.access_name (arg_idx) ^= "*.SysDaemon.*" then project = project + 1;
		end;
		call ioa_ ("There are ^d user^[s^] and ^d project^[s^] eligible to attend.", person, person ^= 1,
		     project, project ^= 1);
	     end;

	free acl;

	if forum_flags.acl_has_changed then do;
		call ioa_ ("Access to this meeting has changed, type ""list_users -eligible"".");
		call forum_$set_switch_idx (forum_idx, "", "access_changed", "0"b, status);
		if status ^= 0 then call ssu_$print_message (ssu_ptr, status, "Resetting access change switch.");
	     end;

	return;
     end print_acl_message;
%page;
clean_up_goto:
     procedure (P_forum_idx);

	declare P_forum_idx		 fixed bin;

	if forum_idx = 0 then return;

	if P_forum_idx = forum_idx then P_forum_idx = 0;

	call forum_$close_forum (forum_idx, (0));

	if passport_info_ptr ^= null () then
	     if passport.forum_idx = 0 then call set_request_tables (addr (forum_request_tables_$user_requests));

	return;

     end clean_up_goto;
%page;
forum_requests_$quit_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	force_switch = "0"b;

	call ssu_$arg_count (ssu_ptr, arg_count);

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if substr (arg, 1, 1) ^= "-" then call ssu_$abort_line (ssu_ptr, 0, "Usage: quit {-control_arg}");
	     if arg = "-force" | arg = "-fc" then force_switch = "1"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, arg);
	end;

	if ^force_switch & passport.unprocessed_trans_ptr ^= null () then do;
		query_info.version = query_info_version_5;
		string (query_info.switches) = "0"b;
		query_info.yes_or_no_sw = "1"b;
		query_info.status_code, query_info.query_code = 0;
		query_info.question_iocbp, query_info.answer_iocbp = null ();
		query_info.repeat_time = 0;
		call command_query_ (addr (query_info), answer, "forum (quit)",
		     "There is an unprocessed transaction.^/Do you still wish to quit?");
		if answer = "no" then return;
	     end;

	call ssu_$abort_subsystem (ssu_ptr);

	return;
%page;
close_old_forum:
     procedure ();

	if passport.forum_idx = 0 then return;

	call forum_trans_util_$clear_cache (passport_info_ptr);

	call forum_$close_forum (passport.forum_idx, status);
	if status ^= 0 then
	     if status = forum_et_$forum_deleted then
		call ssu_$print_message (ssu_ptr, status, "^a^[>^]^a", passport.forum_dir, passport.forum_dir ^= ">",
		     passport.forum_name);
	     else call ssu_$abort_line (ssu_ptr, status, "^a^[>^]^a", passport.forum_dir, passport.forum_dir ^= ">",
		     passport.forum_name);

	call set_request_tables (addr (forum_request_tables_$user_requests));

	passport.forum_name = "";
	passport.forum_dir = "";

	return;

     end close_old_forum;
%page;
set_request_tables:
     proc (rqt_ptr);

	declare rqt_ptr		 ptr;

	rtl_ptr = null ();
	on cleanup begin;
		if rtl_ptr ^= null () then free request_tables_list;
	     end;

	call ssu_$list_request_tables (ssu_ptr, passport.area_ptr, REQUEST_TABLES_LIST_VERSION_1, rtl_ptr, status);
	if status = 0 then
	     if request_tables_list.table_ptr (1) = rqt_ptr then return; /* No change, save work */

	request_tables_list.table_ptr (1) = rqt_ptr;

	call ssu_$set_request_tables (ssu_ptr, rtl_ptr, status);
	if status ^= 0 then call error (status);

	return;
     end set_request_tables;

get_event_channel:
     procedure () returns (fixed bin (71));

	declare event_channel	 fixed bin (71);

	if static_event_channel ^= 0 then return (static_event_channel);

	call ipc_$create_ev_chn (event_channel, status);
	call convert_ipc_code_ (status);
	if status ^= 0 then call error (status);

	call ipc_$decl_ev_call_chn (event_channel, codeptr (forum_requests_$wakeup_handler),
	     null (), 0, status);

	if status ^= 0 then do;
		call ipc_$delete_ev_chn (event_channel, (0));
		call convert_ipc_code_ (status);
		call error (status);
	     end;

	static_event_channel = event_channel;
	return (event_channel);

     end get_event_channel;
%page;
/* This is the procedure that is called when ring 2 sends a wakeup */

forum_requests_$wakeup_handler:
     entry (event_info_ptr);

	declare event_info_ptr	 ptr;

	if event_call_info.offset = ""b then return;	/* Yup, we are still here. */

	do passport_info_ptr = static_passport_list_ptr repeat passport.next_passport_ptr
	     while (passport_info_ptr ^= null ());

	     call forum_$validate_uid (passport.forum_idx, event_call_info.forum_uid,
		status);
	     if status = 0 then do;			/* This is the right meeting */
		     call forum_$convert_attendee_idx (passport.forum_idx,
			(event_call_info.offset), user_name, status);
		     if status ^= 0 then user_name = "<Unknown>";
		     call ioa_ ("A new transaction has been entered by ^a.", user_name);
		     call iox_$control (iox_$user_output, "start", null (), (0));
		     return;
		end;
	end;

	return;
%page;
forum_requests_$add_passport:
     entry (P_passport_info_ptr);

	passport_info_ptr = P_passport_info_ptr;
	passport.next_passport_ptr = static_passport_list_ptr;
	static_passport_list_ptr = passport_info_ptr;
	return;


forum_requests_$remove_passport:
     entry (P_passport_info_ptr);

	declare old_pp_ptr		 pointer;

	old_pp_ptr = null ();
	do passport_info_ptr = static_passport_list_ptr repeat passport.next_passport_ptr
	     while (passport_info_ptr ^= null ());
	     if passport_info_ptr = P_passport_info_ptr then do;
		     if old_pp_ptr = null () then static_passport_list_ptr = passport.next_passport_ptr;
		     else old_pp_ptr -> passport.next_passport_ptr = passport.next_passport_ptr;
		     return;
		end;
	end;
	return;


error:
     procedure (P_status);

	declare P_status		 fixed bin (35);

	status = P_status;

	go to egress;

     end error;

     end forum_requests_$set_forum;
   



		    forum_search_list_default_.cds  02/16/88  1456.2r w 02/16/88  1409.5       32922


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1984 *
   *                                                            *
   ************************************************************** */

/* This segment generates a database used to establish default search lists.

   Converted from alm to create_data_segment 11-Jul-78 by M. Davidoff.
   Added >unb to compose search list - EJW - Aug79
   Added declare (dcl) search list 07-Feb-80 by G. Dixon.
   Modified 03/27/80 by C. D. Tavares to add graphics paths.
   Modified 15 April 1980 by M. N. Davidoff to move >unb to last in compose
   search list.
   Modified 07/21/80 by CDT to add names "xxx.search" to final segment.
   Modified 29 May 1981 by J. Spencer Love to be the default for continuum only.
   Modified 01/21/82 Jay Pattin to change to forum.
   Modified 06/24/82 Jay Pattin to add [hd]>meetings
*/

forum_search_list_default_:
     procedure ();

/* automatic */

	declare code		 fixed binary (35);
	declare wdir		 char (168);

	declare 1 cdsa		 aligned like cds_args;

	declare 1 lists		 aligned,
		2 forum,
		  3 name_count	 fixed binary,
		  3 path_count	 fixed binary,
		  3 names		 (1) char (32),
		  3 paths		 (2) like search_path;

/* based */

	declare 1 search_path	 based,
		2 type		 fixed binary,
		2 pathname	 char (168);

/* builtin */

	declare addr		 builtin;
	declare hbound		 builtin;
	declare null		 builtin;
	declare size		 builtin;
	declare unspec		 builtin;

/* external */

	declare forum_data_$central_directory
				 char (168) external;

/* entry */

	declare com_err_		 entry options (variable);
	declare create_data_segment_	 entry (pointer, fixed binary (35));
	declare get_wdir_		 entry () returns (char (168));

%include sl_info;
%include cds_args;

/* program */

	lists.forum.name_count = hbound (lists.forum.names, 1);
	lists.forum.path_count = hbound (lists.forum.paths, 1);
	lists.forum.names (1) = "forum";
	lists.forum.paths (1).type = UNEXPANDED_PATH;
	lists.forum.paths (1).pathname = ">udd>[user project]>[user name]>meetings";
	lists.forum.paths (2).type = ABSOLUTE_PATH;
	lists.forum.paths (2).pathname = forum_data_$central_directory;

	unspec (cdsa) = ""b;
	cdsa.sections (1).p = addr (lists);
	cdsa.sections (1).len = size (lists);
	cdsa.sections (1).struct_name = "lists";
	cdsa.sections (2).p = null;
	cdsa.sections (2).struct_name = "";
	cdsa.seg_name = "forum_search_list_default_";
	cdsa.exclude_array_ptr = null;
	cdsa.switches.have_text = "1"b;

	call create_data_segment_ (addr (cdsa), code);
	if code ^= 0
	then do;
	     call com_err_ (code, "forum_search_list_default_");
	     return;
	end;

	wdir = get_wdir_ ();

	call add_search_names (lists.forum.names (*));

	return;

add_search_names:
     proc (name_array);

	declare name_array		 dimension (*) char (32) aligned parameter;

	declare hbound		 builtin;
	declare lbound		 builtin;

	declare error_table_$segnamedup
				 fixed bin (35) ext static;

	declare hcs_$chname_file	 entry (char (*), char (*), char (*), char (*), fixed bin (35));

	declare i			 fixed bin;
	declare extra_name		 char (32);

	do i = lbound (name_array, 1) to hbound (name_array, 1);
	     extra_name = rtrim (name_array (i)) || ".search";
	     call hcs_$chname_file (wdir, "forum_search_list_default_", "", extra_name, code);
	     if code ^= 0
	     then if code ^= error_table_$segnamedup
		then call com_err_ (code, "forum_search_list_default_", "Adding name ^a", extra_name);
	end;

	return;
     end add_search_names;

     end forum_search_list_default_;
  



		    forum_trans_specs_.pl1          09/28/92  1718.2r w 09/28/92  1714.3      482229


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) BULL HN Information Systems Inc., 1992       *
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added the bref transactiobn specifier.  Reorganized program to optimize
     performance, specifically by minimizing gate calls.  Added expand_list
     instead of allocating massive trans_list structure.   Fixed bug where
     arg_map was not being freed.  Remember deleted status in trans_list
     structure.   Fixed handling of \c in regexps.
  2) change(91-08-29,Huen), approve(91-08-29,MCR8248),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx21375: Set the initial value of current trans correctly.
     phx21376: Fxi the "delete" request to handle the current trans correctly
     so that the behavour will be consistent with the rdm "dl" request.
     phx21377: Same trans returned by the "c" request and "c" used as an arg.
  3) change(91-09-05,Huen), approve(91-09-05,MCR8249),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20579: Set inhibit_error if unproc trans is selected.
  4) change(91-09-05,Huen), approve(91-09-05,MCR8250),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20810: Do not output error if inhibit_error is used with the "list"
     active request.
  5) change(92-09-10,Zimmerman), approve(92-09-10,MCR8258),
     audit(92-09-22,WAAnderson), install(92-09-28,MR12.5-1020):
     Problem with current being set to deleted txn., or being set to -1.
                                                   END HISTORY COMMENTS */


/* format: style3,ifthen,ifthendo,ifthenstmt,^indnoniterdo,^inditerdo,idind30 */

forum_trans_specs_$parse_specs:
     procedure (P_passport_info_ptr, P_first_arg, P_parse_flags, P_ctl_arg_entry, P_forum_idx, P_forum_dir, P_forum_name,
	P_forum_trans_list_ptr);

/* Subroutine to parse and process transaction specifiers for forum
   Also includes requests to return transaction numbers for all specifiers */

/* original coding  06/17/81 Jay Pattin
   modified for ssu_ 08/22/81 Jay Pattin
   added chairman_message trans spec 05/14/82 Jay Pattin
   added highest (last_seen) trans spec 10/20/82 Jay Pattin
   changes for reading deleted transactions, added -idl, -odl, -ondl 10/23/82 Jay Pattin
   added seen/unseen and friends 1/8/83 Jay Pattin
   made spec requests call parse 6/29/83 Jay Pattin
   Modified 12/21/83 by Jeffrey I. Schiller to fix first_unseen to skip
   over expunged transactions.
   Speed improvements 11/30/85 Jay Pattin
   Added bref 12/22/85 Jay Pattin  */

dcl	(
	P_forum_idx		fixed bin,
	P_forum_dir		char (*),
	P_forum_name		char (*),
	P_forum_trans_list_ptr	pointer,
	P_first_arg		fixed bin,
	P_parse_flags		bit (36) aligned,
	P_ctl_arg_entry		entry (fixed bin) variable,
	P_passport_info_ptr		pointer,
	P_ssu_ptr			pointer
	)			parameter;

declare	value			fixed bin,	/* value of expression */
	(this_val, state, last_val)	fixed bin,
	(by_chain, list, no_current, reverse_sw, idl_given, temp_forum, initial, reset_current, expunged, inhibit_error,
	have_limits)		bit (1) aligned init ("0"b),
	(active_function, in_expr, cache, deleted, in_range)
				bit (1) aligned,
	(empty, blank, only_unproc)	bit (1) init ("1"b),
	first_char		char (1),
	me			char (22),
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	argmap_ptr		ptr,
	alloc_argmap_size		fixed bin,
	bit_map_len		fixed bin,
	bit_map_ptr		ptr,
	code			fixed bin (35),
	forum_idx			fixed bin,
	forum_dir			char (168),
	forum_name		char (32),
	message			char (256),
	request_name		char (32),
	ret_len			fixed bin (21),
	ret_ptr			ptr,
	ret_string		char (80) varying init (""),
	ssu_ptr			ptr,
	(current, nref, pref, first, last, last_seen, last_tri, last_sent)
				fixed bin,
	(idx, jdx, kdx, tidx, sign, select_type, type, arg_count)
				fixed bin,
	match_code		fixed bin (35);

declare	arg			char (arg_len) based (arg_ptr),
	bit_map			bit (bit_map_len) aligned based (bit_map_ptr);
declare	ret_val			char (ret_len) varying based (ret_ptr);
declare	argmap			bit (alloc_argmap_size) based (argmap_ptr);
						/* on if we look at it on pass 2 */

declare	(
	DIGITS			char (10) init ("1234567890"),
	LETTERS			char (53) init ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"),
	UC_ALPHA			char (26) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"),
	LC_ALPHA			char (26) init ("abcdefghijklmnopqrstuvwxyz")
	)			internal static options (constant);

declare	keywords			(55) char (16) internal static options (constant)
				init ("first", "f", "last", "l", "previous", "prev", "p", "next", "n", "current",
				"c", "firstref", "fref", "lastref", "lref", "previousref", "pref", "nextref",
				"nref", "allref", "aref", "all", "a", "new", "unprocessed", "unproc", "unp", "u",
				"restref", "rref", "chairman_message", "cmsg", "all_seen", "seen", "first_seen",
				"fs", "next_seen", "ns", "previous_seen", "ps", "last_seen", "ls", "highest",
				"all_unseen", "unseen", "first_unseen", "fu", "next_unseen", "nu",
				"previous_unseen", "pu", "last_unseen", "lu", "beforeref", "bref");

declare	key_val			(55) fixed bin
				init (1, 1, 2, 2, 3, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12,
				13, 13, 13, 13, 14, 14, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 21, 22,
				22, 23, 23, 24, 24, 25, 25, 26, 26, 15, 15);

declare	(
	FIRST			init (1),
	LAST			init (2),
	PREVIOUS			init (3),
	NEXT			init (4),
	CURRENT			init (5),
	FREF			init (6),
	LREF			init (7),
	PREF			init (8),
	NREF			init (9),
	AREF			init (10),
	ALL			init (11),
	NEW			init (12),
	UNPROC			init (13),
	RREF			init (14),
	BREF			init (15),
	CMSG			init (16),
	SEEN			init (17),
	FIRST_SEEN		init (18),
	NEXT_SEEN			init (19),
	PREV_SEEN			init (20),
	LAST_SEEN			init (21),
	UNSEEN			init (22),
	FIRST_UNSEEN		init (23),
	NEXT_UNSEEN		init (24),
	PREV_UNSEEN		init (25),
	LAST_UNSEEN		init (26)
	)			fixed bin internal static options (constant);

declare	(
	NEED_CURRENT		init ("00100111110001100011000110"b),
	NEED_LIMITS		init ("11011000001100001111111111"b),
	MULTIPLE			init ("00000000011101101000010000"b),
	UNPROC_OK			init ("00000111010001100000000000"b)
	)			bit (26) static options (constant);

declare	(
	ANYTHING			init (0),
	MUST_BE_ARITH		init (1),
	MUST_BE_REGEXP		init (2),
	MUST_BE_USERID		init (3)
	)			fixed bin internal static options (constant);

declare	(
	AFTER			init (1),
	BEFORE			init (2),
	ON_OR_BEFORE		init (3),
	DATE			init (4)
	)			fixed bin static options (constant);

declare	THERE_IS_NO		char (32) static options (constant) init ("There is no ^a transaction.");

declare	1 trans_specs		aligned,
	  2 flags			aligned,
	    3 selected		bit (1) unaligned,	/* on if any transactions selected */
	    3 regexp_given		bit (1) unaligned,
	    3 no_match_sj		bit (1) unaligned,	/* don't match regexp against subject */
	    3 no_match_text		bit (1) unaligned,	/* ditto for text */
	    3 id_given		bit (1) unaligned,
	    3 date_given		bit (1) unaligned,
	    3 pad			bit (30) unaligned,
	  2 low_date		fixed bin (71),
	  2 high_date		fixed bin (71),
	  2 regexp_len		fixed bin (21),
	  2 regexp		char (256),	/* select by regexp matching */
	  2 person_id		char (22);	/* Used for selecting by person_id */

declare	saved_regexp		char (256) varying internal static init ("");

declare	(fixed, substr, verify, translate, null, string, length, min, hbound, index, after, before, char, ltrim, rtrim,
	unspec, max, addr, reverse)	builtin;
declare	(area, cleanup)		condition;

declare	convert_date_to_binary_	entry (char (*), fixed bin (71), fixed bin (35)),
	decode_clock_value_		entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin (71), fixed bin,
				char (3)),
	encode_clock_value_		entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
				fixed bin (71), fixed bin, char (3), fixed bin (71), fixed bin (35)),
	ioa_			entry () options (variable),
	user_info_$whoami		entry (char (*), char (*), char (*)),
	search_file_$silent		entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21),
				fixed bin (21), fixed bin (21), fixed bin (35)),
	forum_$forum_limits		entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
				bit (36) aligned, fixed bin (35)),
	forum_$get_transaction_map_idx
				entry (fixed bin, char (*), bit (*) aligned, fixed bin (35)),
	forum_$next_transaction	entry (fixed bin, fixed bin, fixed bin, fixed bin (35)),
	forum_$previous_transaction	entry (fixed bin, fixed bin, fixed bin, fixed bin (35)),
	forum_$trans_ref_info	entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, bit (1) aligned,
				fixed bin (35)),
	forum_$trans_time_info	entry (fixed bin, fixed bin (71), fixed bin (71), fixed bin, fixed bin,
				fixed bin (35)),
	forum_$check_user		entry (fixed bin, char (*), fixed bin, fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$get_message		entry (fixed bin, char (*), fixed bin (35)),
	forum_requests_$open_forum	entry (char (*), fixed bin, char (*), char (*), fixed bin (35)),
	forum_trans_util_$clear_cache entry (ptr),
	forum_trans_util_$read_trans	entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	forum_trans_util_$reverse	entry (ptr, ptr),
	forum_trans_util_$sort_by_chain
				entry (ptr, fixed bin, ptr, fixed bin),
	ssu_$abort_line		entry options (variable),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin (21)),
	ssu_$get_request_name	entry (ptr) returns (char (32)),
	ssu_$print_message		entry options (variable),
	ssu_$return_arg		entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21));

declare	(
	error_table_$badopt,
	error_table_$inconsistent,
	error_table_$noarg,
	error_table_$nomatch,
	forum_et_$bad_trans_spec,
	forum_et_$no_forum,
	forum_et_$no_current,
	forum_et_$old_format,
	forum_et_$missing_spec,
	forum_et_$too_many_trans,
	forum_et_$too_many_regexps,
	forum_et_$too_many_personids,
	forum_et_$key_not_allowed,
	forum_et_$no_trans_for_user,
	forum_et_$no_transactions,
	forum_et_$trans_deleted,
	forum_et_$trans_reaped,
	forum_et_$trans_not_deleted,
	forum_et_$unproc_not_allowed,
	forum_et_$null_range_spec,
	forum_et_$invalid_trans_idx
	)			fixed bin (35) external;
%page;
%include forum_trans_list;
%page;
%include forum_user_trans;
%page;
%include forum_passport;
%page;
	passport_info_ptr = P_passport_info_ptr;
	ssu_ptr = passport.ssu_ptr;

	P_forum_idx = 0;
	parse_flags_word = P_parse_flags;
	forum_idx = passport.forum_idx;		/* assume current forum */
	current = passport.current_trans;
	if current = 0 then no_current = "1"b;

	argmap_ptr, bit_map_ptr, forum_trans_list_ptr = null ();
	code, last_tri = 0;
	cache = "1"b;				/* Use the cache (we are in current forum) */

	on cleanup call cleanup_handler;

	string (trans_specs.flags) = ""b;
	trans_specs.low_date, trans_specs.high_date = 0;
	trans_specs.regexp = "";
	trans_specs.regexp_len = 0;
	trans_specs.person_id = "";

	if parse_flags.must_be_deleted then select_type = ONLY_DELETED;
	else if parse_flags.allow_deleted then select_type = INCLUDE_DELETED;
	else select_type = ONLY_UNDELETED;

	call ssu_$return_arg (ssu_ptr, arg_count, active_function, (null ()), (0));

	alloc_argmap_size = arg_count;
	allocate argmap in (forum_area);		/* tells if args are processed on pass 1 */

	state = ANYTHING;
	do idx = P_first_arg to arg_count;		/* Pass 1, ctl args, ids, regexps */
	     call ssu_$arg_ptr (ssu_ptr, idx, arg_ptr, arg_len);
	     if substr (arg, 1, 1) = "-" & index (DIGITS, substr (arg, 2, 1)) = 0 & state = ANYTHING then do;
						/* control arg */
		if ^parse_flags.disallow_meeting & (arg = "-meeting" | arg = "-mtg") then do;
		     idx = idx + 1;
		     if idx > arg_count then
NOARG:
			call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ""^a"".", arg);
		     call ssu_$arg_ptr (ssu_ptr, idx, arg_ptr, arg_len);
		     call forum_requests_$open_forum (arg, forum_idx, forum_dir, forum_name, code);
		     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Opening meeting ""^a"".", arg);

		     temp_forum = "1"b;
		     if forum_idx ^= passport.forum_idx then cache = "0"b;
		end;

		else if ^parse_flags.disallow_idl & (arg = "-include_deleted" | arg = "-idl") then
		     select_type = INCLUDE_DELETED;
		else if ^parse_flags.disallow_idl & (arg = "-only_deleted" | arg = "-odl") then
		     select_type = ONLY_DELETED;
		else if ^parse_flags.disallow_idl & (arg = "-only_non_deleted" | arg = "-ondl") then
		     select_type = ONLY_UNDELETED;

		else if parse_flags.allow_inhibit_error & (arg = "-inhibit_error" | arg = "-ihe") then
		     inhibit_error = "1"b;
		else if parse_flags.allow_inhibit_error & (arg = "-no_inhibit_error" | arg = "-nihe") then
		     inhibit_error = "0"b;
		else if ^parse_flags.disallow_initial & arg = "-initial" then initial = "1"b;
		else if ^parse_flags.disallow_by_chain & arg = "-by_chain" then by_chain = "1"b;
		else if ^parse_flags.disallow_reverse & (arg = "-reverse" | arg = "-rv") then reverse_sw = "1"b;
		else if ^parse_flags.dont_read then do;
		     if arg = "-after" | arg = "-af" then call get_date (AFTER, "1"b);
		     else if arg = "-after_time" | arg = "-aft" then call get_date (AFTER, "0"b);
		     else if arg = "-before" | arg = "-be" then call get_date (BEFORE, "1"b);
		     else if arg = "-before_time" | arg = "-bet" then call get_date (BEFORE, "0"b);
		     else if arg = "-between" | arg = "-bt" then do;
			call get_date (AFTER, "1"b);
			call get_date (ON_OR_BEFORE, "1"b);
		     end;
		     else if arg = "-between_time" | arg = "-btt" then do;
			call get_date (AFTER, "0"b);
			call get_date (BEFORE, "0"b);
		     end;
		     else if arg = "-date" | arg = "-dt" then call get_date (DATE, "1"b);
		     else if arg = "-from" | arg = "-fm" then do;
			if idx = arg_count then goto NOARG;
			state = MUST_BE_USERID;
		     end;
		     else if arg = "-subject" | arg = "-sj" then do;
			if idx = arg_count then goto NOARG;
			state = MUST_BE_REGEXP;
			trans_specs.no_match_text = "1"b;
		     end;
		     else if arg = "-text" | arg = "-tx" then do;
			if idx = arg_count then goto NOARG;
			state = MUST_BE_REGEXP;
			trans_specs.no_match_sj = "1"b;
		     end;
		     else call P_ctl_arg_entry (idx);
		end;
		else call P_ctl_arg_entry (idx);
	     end;					/* control arg */
	     else do;
		empty = "0"b;
		substr (argmap, idx, 1) = "1"b;	/* process it on pass 2 */
		if index (arg, ":") = 0 | index (arg, "/") ^= 0 then
		     call pass1 (arg);		/* range not given */
		else do;
		     only_unproc = "0"b;
		end;
		state = ANYTHING;
	     end;
	end;					/* pass1 */

	if reverse_sw & by_chain then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-reverse"" and ""-by_chain""");
	if trans_specs.high_date < trans_specs.low_date & trans_specs.high_date ^= 0 then
	     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "Invalid range in date specification.");

/* TR20810: If inhibit_error is set, do not output error */
	if last_sent = 0 & trans_specs.id_given & ^inhibit_error then
	     call ssu_$abort_line (ssu_ptr, forum_et_$no_trans_for_user, "^a", arg);
	if ^parse_flags.default_to_unproc then
	     only_unproc = only_unproc & ^empty;	/* if something given, then isn't only unproc */
	else only_unproc = only_unproc & (passport.unprocessed_trans_ptr ^= null ());

	if ^only_unproc & forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	if only_unproc then last = 0;			/* unproc doesn't require a forum */
	else if temp_forum then call get_limits ();

	alloc_trans_list_size = 100;

RETRY_ATL:
	on area
	     begin;
		call forum_trans_util_$clear_cache (passport_info_ptr);
		goto RETRY_ATL;
	     end;

	allocate forum_trans_list in (forum_area);
	forum_trans_list.max_size = 100;
	forum_trans_list.size, forum_trans_list.max_personid_len = 0;

	revert area;

	do idx = P_first_arg to arg_count;		/* pass 2 */
	     if substr (argmap, idx, 1) then do;
		call ssu_$arg_ptr (ssu_ptr, idx, arg_ptr, arg_len);
		in_range = "0"b;
		jdx = index (arg, ":");
		if jdx ^= 0 then do;
		     if jdx = 1 | jdx = arg_len then
			call ssu_$abort_line (ssu_ptr, 0, "Null value before or after a "":"". ^a", arg);
		     in_range = "1"b;
		     call pass2 (before (arg, ":"));
		     last_val = value;
		     call pass2 (after (arg, ":"));
		     call do_range ();		/* add transactions in the range */
		end;
		else call pass2 (arg);
	     end;
	end;

	if ^trans_specs.selected then do;		/* noone home */
	     if ^blank then
		if ^inhibit_error then
		     call ssu_$abort_line (ssu_ptr, forum_et_$no_transactions);
		else ;
	     else if trans_specs.regexp_given | trans_specs.id_given | trans_specs.date_given then call get_all ();
	     else if parse_flags.non_null then call ssu_$abort_line (ssu_ptr, forum_et_$missing_spec);
	     else if parse_flags.default_to_none then inhibit_error = "1"b;
	     else if parse_flags.default_to_all then call get_all ();
						/* TR20810, 20579: Set inhibit_error if unproc trans is selected */
	     else if parse_flags.default_to_unproc
		& (parse_flags.create_unproc | passport.unprocessed_trans_ptr ^= null ()) then do;
		if passport.unprocessed_trans_ptr = null () then
		     inhibit_error = "1"b;
		else do;
		     deleted = "0"b;
		     kdx = UNPROC;			/* Yet another kludge */
		     call allocate_num (0);
		end;
	     end;
	     else do;
		if current > 0 then this_val = current; /* TR21375-6: Try setting current first. */
		else if current = 0 then do;
		     call set_current ();		/* TR21377: Same trans returned by "c" request and "c" used as an arg */
		     passport.current_trans = this_val;
		     current = this_val;
		end;
		if current = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_current);
		call get_tri (current, "0"b, 0, (0));
		if ^initial | pref = 0 then call allocate_num (current);
	     end;
	end;
	if bit_map_ptr ^= null () then free bit_map;
	if argmap_ptr ^= null () then free argmap;

	if ^trans_specs.selected & ^inhibit_error then	/* still noone home */
	     call ssu_$abort_line (ssu_ptr, forum_et_$no_transactions);

	if forum_trans_list.size > 1 then
	     if reverse_sw then call forum_trans_util_$reverse (passport_info_ptr, forum_trans_list_ptr);
	     else if by_chain then
		call forum_trans_util_$sort_by_chain (passport_info_ptr, forum_idx, forum_trans_list_ptr, select_type)
		     ;

	if temp_forum then do;			/* if -meeting was given, tell our caller */
	     P_forum_idx = forum_idx;
	     P_forum_name = forum_name;
	     P_forum_dir = forum_dir;
	end;
	P_forum_trans_list_ptr = forum_trans_list_ptr;
	return;
%page;
/* Now the entries that return values for all the keywords */
first_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (FIRST, "0"b);

last_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (LAST, "0"b);

previous_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (PREVIOUS, "1"b);

next_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (NEXT, "1"b);

current_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (CURRENT, "0"b);

fref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (FREF, "1"b);

lref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (LREF, "1"b);

pref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (PREF, "1"b);

nref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (NREF, "1"b);

aref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (AREF, "1"b);

rref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (RREF, "1"b);

bref_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (BREF, "1"b);

new_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (NEW, "0"b);

all_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (ALL, "0"b);

seen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (SEEN, "0"b);

unseen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (UNSEEN, "0"b);

first_seen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (FIRST_SEEN, "0"b);

first_unseen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (FIRST_UNSEEN, "0"b);

next_seen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (NEXT_SEEN, "1"b);

next_unseen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (NEXT_UNSEEN, "1"b);

prev_seen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (PREV_SEEN, "1"b);

prev_unseen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (PREV_UNSEEN, "1"b);

last_seen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (LAST_SEEN, "0"b);

last_unseen_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call common (LAST_UNSEEN, "0"b);

MAIN_RETURN:
	return;

common:
     proc (P_type, allow_spec);

declare	P_type			fixed bin,
	allow_spec		bit (1) aligned;

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	type = P_type;
	forum_idx = passport.forum_idx;
	if forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	current = passport.current_trans;
	if current = 0 then no_current = "1"b;
	list = "1"b;
	temp_forum = "0"b;
	last_tri = 0;
	argmap_ptr, bit_map_ptr, forum_trans_list_ptr = null ();
	select_type = ONLY_UNDELETED;
	request_name = ssu_$get_request_name (ssu_ptr);
	call ssu_$return_arg (ssu_ptr, arg_count, active_function, ret_ptr, ret_len);

	on cleanup call cleanup_handler ();

	if arg_count > 0 & allow_spec then do;
	     parse_flags_word =
		ONLY_ONE | DISALLOW_MTG | DISALLOW_REV | DISALLOW_INITIAL | DONT_READ | DISALLOW_CMSG
		| DISALLOW_BYCHAIN;
	     if ^substr (UNPROC_OK, type, 1) then parse_flags_word = parse_flags_word | DISALLOW_UNPROC;

	     call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, dummy, (0), (""), (""),
		forum_trans_list_ptr);
	     current = forum_trans_list.trans_num (1);
	     if current = 0 then do;
		if ^substr (UNPROC_OK, type, 1) then
		     call ssu_$abort_line (ssu_ptr, 0, "The unprocessed transaction is not a reply.");
		current = passport.unprocessed_reply_trans;
		if type = PREF then current = -current; /* PREF of unproc is weird */
	     end;
	     free forum_trans_list;
	end;

	do idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then do;
		if arg = "-include_deleted" | arg = "-idl" then select_type = INCLUDE_DELETED;
		else if arg = "-only_deleted" | arg = "-odl" then select_type = ONLY_DELETED;
		else if arg = "-only_non_deleted" | arg = "-ondl" then select_type = ONLY_UNDELETED;
		else if ^allow_spec then call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	     end;
	     else if ^allow_spec then call ssu_$abort_line (ssu_ptr, 0, "Usage:  ^a {-control_args}", request_name);
	end;

	if substr (NEED_LIMITS, type, 1) then do;
	     call forum_$forum_limits (forum_idx, select_type, last_seen, first, last, (0), ("0"b), code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Getting meeting status.");
	     if first = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_transactions);
	end;

	if type >= SEEN then do;
	     bit_map_len = last;
	     allocate bit_map in (forum_area);
	     call forum_$get_transaction_map_idx (forum_idx, "", bit_map, code);
	     if code ^= 0 then
		if code = forum_et_$old_format then do;
		     if type ^= LAST_SEEN then
			call ssu_$abort_line (ssu_ptr, 0, "Version 1 meetings do not have seen maps.");
		end;
		else call ssu_$abort_line (ssu_ptr, code, "Getting transaction map.");
	end;

	if last_seen > 0 & current = 0 & substr (NEED_CURRENT, type, 1) then
	     call ssu_$abort_line (ssu_ptr, forum_et_$no_current);

	unspec (trans_specs) = "0"b;

	if type = AREF then call add_aref ("1"b);
	else if type = RREF then call add_rref ();
	else if type = BREF then call add_aref ("0"b);
	else if type = NEW then call add_new ();
	else if type = ALL then call get_all ();
	else if type = SEEN then call get_seen ("1"b);
	else if type = UNSEEN then call get_seen ("0"b);
	else do;
	     if type = CURRENT then do;
		if current > 0 then this_val = current; /* TR21375-6: Try setting current first. */
		else if current = 0 then do;
		     call set_current ();		/* TR21377: Same trans returned by "c" request and "c" used as an arg */
		     passport.current_trans = this_val;
		     current = this_val;
		end;

		if current = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_current);
	     end;
	     else if type = FIRST then this_val = first;
	     else if type = LAST then this_val = last;
	     else if type = PREVIOUS then call get_prev ();
	     else if type = NEXT then call get_next ();
	     else if type = FREF then call get_fref ();
	     else if type = LREF then call get_lref ();
	     else if type = NREF then call get_nref ();
	     else if type = PREF then call get_pref ();
	     else if type = FIRST_SEEN then call get_first_seen ();
	     else if type = FIRST_UNSEEN then call get_first_unseen ();
	     else if type = NEXT_SEEN then call get_next_seen ();
	     else if type = NEXT_UNSEEN then call get_next_unseen ();
	     else if type = PREV_SEEN then call get_prev_seen ();
	     else if type = PREV_UNSEEN then call get_prev_unseen ();
	     else if type = LAST_SEEN then call get_last_seen ();
	     else if type = LAST_UNSEEN then call get_last_unseen ();
	     trans_specs.selected = "1"b;
	     ret_string = ltrim (char (this_val));	/* and put it in a string */
	end;
	call cleanup_handler ();

	if ^trans_specs.selected then call ssu_$abort_line (ssu_ptr, forum_et_$no_transactions);

	if active_function then
	     ret_val = ret_val || ret_string;
	else call ioa_ ("^a", ret_string);
	goto MAIN_RETURN;

dummy:
     entry (P_arg_idx);

declare	P_arg_idx			fixed bin;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	return;

     end common;
%page;
cleanup_handler:
     proc;

	if forum_trans_list_ptr ^= null () then free forum_trans_list;
	if bit_map_ptr ^= null () then free bit_map;
	if argmap_ptr ^= null () then free argmap;
	if temp_forum then call forum_$close_forum (forum_idx, (0));
	return;
     end;

add_to_string:					/* routine to build return string for all, aref, new */
     proc (number);

declare	number			fixed bin;

	trans_specs.selected = "1"b;			/* remember if we found any */
	if active_function then
	     ret_val = ret_val || ltrim (char (number)) || " ";
	else do;
	     if length (ret_string) > 72 then do;
		call ioa_ (ret_string);		/* print out one line */
		ret_string = "";
	     end;
	     ret_string = ret_string || ltrim (char (number)) || " ";
	end;
	return;
     end add_to_string;

get_limits:
     proc ();

	call forum_$forum_limits (forum_idx, select_type, last_seen, first, last, (0), (""b), code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code);
	if first = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_transactions);
	if temp_forum then do;
	     current = last_seen;
	     no_current = "0"b;
	end;

	have_limits = "1"b;
     end get_limits;
%page;
get_date:
     proc (type, truncate);

declare	type			fixed bin,
	truncate			bit (1) aligned,
	(month, day, year)		fixed bin,
	time_stamp		fixed bin (71),
	ONE_DAY_MINUS_A_MICROSECOND	init (86399999999) fixed bin (71) static options (constant);

	if idx = arg_count then goto NOARG;
	idx = idx + 1;
	call ssu_$arg_ptr (ssu_ptr, idx, arg_ptr, arg_len);
	call convert_date_to_binary_ (arg, time_stamp, code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "^a", arg);

	if truncate then do;
	     call decode_clock_value_ (time_stamp, month, day, year, (0), (0), (""));
	     call encode_clock_value_ (month, day, year, 0, 0, 0, 0, 0, "", time_stamp, (0));
	end;

	trans_specs.date_given = "1"b;
	if type = BEFORE then trans_specs.high_date = time_stamp;
	else if type = ON_OR_BEFORE then trans_specs.high_date = time_stamp + ONE_DAY_MINUS_A_MICROSECOND;
	else if type = AFTER then trans_specs.low_date = time_stamp;
	else do;
	     trans_specs.low_date = time_stamp;
	     trans_specs.high_date = time_stamp + ONE_DAY_MINUS_A_MICROSECOND;
	end;

	return;
     end get_date;
%page;
get_tri:
     proc (idx, ignore_reaped, direction, next);

declare	(idx, direction, next)	fixed bin,
	ignore_reaped		bit (1) aligned;

	if idx ^= last_tri then do;
	     call forum_$trans_ref_info (forum_idx, idx, select_type, pref, nref, deleted, code);
	     if code ^= 0 then
		if (code ^= forum_et_$trans_reaped) | ^ignore_reaped then
		     call ssu_$abort_line (ssu_ptr, code, "Transaction ^d.", idx);
	end;

	expunged = (code ^= 0);
	if code = 0 then next = idx + direction;
	else if direction = 1 then next = find_next (idx);
	else if direction = -1 then next = find_previous (idx);

	last_tri = idx;
	return;
     end get_tri;

find_next:
     proc (idx) returns (fixed bin);

declare	(idx, next)		fixed bin;

	if forum_idx > 0 then return (idx + 1);

	call forum_$next_transaction (forum_idx, idx, next, code);
	if code ^= 0 then
	     if code = forum_et_$no_transactions then
		next = (2 ** 17) - 1;		/* bbig number, > last, hopefully */
	     else call ssu_$abort_line (ssu_ptr, code, "Transaction ^d.", idx);
	return (next);
     end find_next;


find_previous:
     proc (idx) returns (fixed bin);

declare	(idx, previous)		fixed bin;

	if forum_idx > 0 then return (idx - 1);

	call forum_$previous_transaction (forum_idx, idx, previous, code);
	if code ^= 0 then
	     if code = forum_et_$no_transactions then
		previous = -1;
	     else call ssu_$abort_line (ssu_ptr, code, "Transaction ^d.", idx);
	return (previous);
     end find_previous;


lookup_word:
     proc (word) returns (fixed bin);

declare	word			char (*) parameter,
	idx			fixed bin;

	word = translate (word, LC_ALPHA, UC_ALPHA);	/* ignore case */

	do idx = 1 to hbound (keywords, 1);
	     if word = keywords (idx) then return (key_val (idx));
	end;

	return (0);
     end lookup_word;
%page;
/* Deal with regexps and userids, check for bad characters */
pass1:
     proc (spec);

declare	spec			char (*);
declare	pos			fixed bin init (1);
declare	spec_len			fixed bin;

	spec_len = length (spec);
	if spec_len = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$null_range_spec, "^a", arg);
	in_expr = "0"b;

	do while (pos <= spec_len);
	     first_char = substr (spec, pos, 1);

	     if state = MUST_BE_REGEXP & first_char ^= "/" then
		call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec,
		     "Missing regexp following -subject or -text.");
	     if state = MUST_BE_USERID then do;
		jdx = spec_len - pos + 1;
		goto USERID;
	     end;

	     if first_char = "+" | first_char = "-" then do;
		if pos = spec_len then
		     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "Trailing '+' or '-'.");
		pos = pos + 1;
		in_expr = "1"b;
		first_char = substr (spec, pos, 1);
	     end;
	     else if state = MUST_BE_ARITH then call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, spec);
	     else if pos > 1 then call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "^a", spec);

/* skip over numbers */
	     if index (DIGITS, first_char) ^= 0 then do;
		only_unproc = "0"b;
		jdx = verify (substr (spec, pos), DIGITS);
		if jdx = 0 then
		     jdx = spec_len - pos + 1;
		else jdx = jdx - 1;
		pos = pos + jdx;
	     end;

	     else if first_char = "/" then do;		/* start of a regexp */
		if parse_flags.dont_read then
		     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec,
			"Regular expressions may not be used with this request.");
		if in_expr then call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, spec);
		if trans_specs.regexp_given then call ssu_$abort_line (ssu_ptr, forum_et_$too_many_regexps, spec);
		jdx = pos + 1;
REGEXP_LOOP:
		if jdx > spec_len then
BAD_REGEXP:
		     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec,
			"Missing trailing '/' after regexp ""^a"".", spec);
		kdx = index (substr (spec, jdx), "/");
		if kdx = 0 then goto BAD_REGEXP;	/* didn't find a '/' */
		if kdx >= 3 then
		     if substr (spec, jdx + kdx - 3, 2) = "\c" then do;
						/* \c makes / not terminator */
			substr (trans_specs.regexp, trans_specs.regexp_len + 1, kdx - 2) =
			     substr (spec, jdx, kdx - 3) || "/";
			trans_specs.regexp_len = trans_specs.regexp_len + kdx - 2;
			jdx = jdx + kdx;
			goto REGEXP_LOOP;
		     end;

		trans_specs.regexp_given = "1"b;
		if kdx > 1 then do;
		     substr (trans_specs.regexp, trans_specs.regexp_len + 1) = substr (spec, jdx, kdx - 1);
		     trans_specs.regexp_len = trans_specs.regexp_len + kdx - 1;
		     saved_regexp = trans_specs.regexp;
		end;
		else do;
		     if saved_regexp = "" then
			call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "No previous regexp for //.");
		     trans_specs.regexp_len = length (rtrim (saved_regexp));
		     trans_specs.regexp = saved_regexp;
		end;

		pos = jdx + kdx;
		only_unproc = "0"b;
		substr (argmap, idx, 1) = "0"b;	/* don't need to look here again */
	     end;					/* regexp */

	     else if index (LETTERS, first_char) ^= 0 then do;
						/* keyword or userid */
		jdx = verify (substr (spec, pos), LETTERS);
		if jdx = 0 then
		     jdx = spec_len - pos + 1;	/* rest of line */
		else jdx = jdx - 1;

		kdx = lookup_word (substr (spec, pos, min (32, jdx)));
		if kdx > 0 then goto GOT_WORD;

		if parse_flags.call_on_non_ctl_arg then do;
						/* Request wants to see this one */
		     substr (argmap, idx, 1) = ""b;
		     call P_ctl_arg_entry (idx);
		     return;
		end;				/* Nobody knows who this is. */
		call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "^a", arg);
USERID:
		if index (arg, ".") > 0 then
		     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec,
			"Person_id's may not contain ""."". ""^a""", arg);

		call forum_$check_user (forum_idx, arg, last_sent, (0));

		if trans_specs.id_given then call ssu_$abort_line (ssu_ptr, forum_et_$too_many_personids, arg);

		if parse_flags.dont_read then
		     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec,
			"Personids may not be used with this request. ^a.", arg);
		trans_specs.id_given = "1"b;
		trans_specs.person_id = arg;
		only_unproc = "0"b;
		substr (argmap, idx, 1) = "0"b;	/* don't need to look here on pass 2 */
		goto END_LOOP;


GOT_WORD:
		if kdx ^= UNPROC then only_unproc = "0"b;
END_LOOP:
		pos = pos + jdx;
		state = MUST_BE_ARITH;
	     end;					/* keyword or user id */
	     else if parse_flags.call_on_non_ctl_arg then do;
						/* Request wants to see this one */
		substr (argmap, idx, 1) = ""b;
		call P_ctl_arg_entry (idx);
		return;
	     end;
	     else call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "^a", spec);
						/* unknown special char */
	end;					/* token loop */

     end pass1;
%page;
/* This subroutine figures out which transactions were requested */
pass2:
     proc (spec);

declare	spec			char (*);
declare	pos			fixed bin init (1);
declare	spec_len			fixed bin;

	spec_len = length (spec);

	if index (spec, ":") ^= 0 then call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "^a", arg);
	value = 0;
	sign = 1;
	in_expr = "0"b;

	do while (pos <= spec_len);
	     this_val = 0;
	     first_char = substr (spec, pos, 1);
	     kdx = index ("++-", first_char);

	     if kdx ^= 0 then do;
		pos = pos + 1;
		if value = 0 & pos = 2 then value = current;
						/* leading + or - is relative to current */
		in_expr = "1"b;			/* next must be single numeric */
		sign = 2 - kdx;
		first_char = substr (spec, pos, 1);
	     end;
	     else if pos > 1 then call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "^a", spec);

	     if index (DIGITS, first_char) ^= 0 then do;
		jdx = index (DIGITS, first_char);
		jdx = verify (substr (spec, pos), DIGITS);
		if jdx = 0 then
		     jdx = spec_len - pos + 1;
		else jdx = jdx - 1;

		if jdx > 6 then call ssu_$abort_line (ssu_ptr, forum_et_$invalid_trans_idx, spec);
		this_val = fixed (substr (spec, pos, jdx));
		pos = pos + jdx;
	     end;

	     else if index (LETTERS, first_char) ^= 0 then do;
						/* keyword or userid */
		jdx = verify (substr (spec, pos), LETTERS);
		if jdx = 0 then
		     jdx = spec_len - pos + 1;	/* word is the rest of line */
		else jdx = jdx - 1;

		kdx = lookup_word (substr (spec, pos, min (32, jdx)));
		if kdx = 0 then
		     call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, substr (spec, pos, min (32, jdx)));

		if substr (MULTIPLE, kdx, 1) & (in_range | in_expr) then
BAD_WORD:
		     call ssu_$abort_line (ssu_ptr, forum_et_$key_not_allowed, "'^a' in '^a'",
			substr (spec, pos, min (32, jdx)), arg);

		if substr (NEED_CURRENT, kdx, 1) & no_current then
		     call ssu_$abort_line (ssu_ptr, forum_et_$no_current);

		if ^have_limits & substr (NEED_LIMITS, kdx, 1) then call get_limits ();

		if kdx >= SEEN & bit_map_ptr = null () then do;
		     bit_map_len = last;
		     allocate bit_map in (forum_area);
		     call forum_$get_transaction_map_idx (forum_idx, "", bit_map, code);
		     if code ^= 0 then
			if code = forum_et_$old_format then do;
			     if kdx ^= LAST_SEEN then
				call ssu_$abort_line (ssu_ptr, 0, "Version 1 meetings do not have seen maps.");
			end;
			else call ssu_$abort_line (ssu_ptr, code, "Getting transaction map.");
		end;

		if kdx = ALL then call get_all ();
		else if kdx = NEW then do;
		     in_range = "1"b;
		     call add_new ();
		end;

		else if kdx = AREF then do;
		     in_range = "1"b;
		     call add_aref ("1"b);
		end;

		else if kdx = RREF then do;
		     in_range = "1"b;
		     call add_rref ();
		end;

		else if kdx = BREF then do;
		     in_range = "1"b;
		     call add_aref ("0"b);
		end;

		else if kdx = CMSG then do;
		     if parse_flags.disallow_cmsg then
			call ssu_$abort_line (ssu_ptr, 0, "The chairman_message keyword may not be used.");
		     if in_range | in_expr then goto BAD_WORD;
		     call forum_$get_message (forum_idx, message, code);
		     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Getting chairman message.");
		     in_range = "1"b;
		     deleted = "0"b;
		     call allocate_num (-1);
		end;

		else if kdx = UNPROC then do;
		     if parse_flags.disallow_unproc then call ssu_$abort_line (ssu_ptr, forum_et_$unproc_not_allowed);
		     if in_range | in_expr then goto BAD_WORD;
		     in_range = "1"b;
		     deleted = "0"b;
		     call allocate_num (0);		/* unprocessed is transaction 0 */
		end;
		else if kdx = CURRENT then do;
		     if current > 0 then this_val = current;
						/* TR21375-6: Try setting current first. */
		     else if current = 0 then do;
			call set_current ();	/* TR21377: Same trans returned by "c" request and "c" used as an arg */
			passport.current_trans = this_val;
			current = this_val;
		     end;

		     if current = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_current);
		end;
		else if kdx = FIRST then this_val = first;
		else if kdx = LAST then this_val = last;
		else if kdx = PREVIOUS then call get_prev ();
		else if kdx = NEXT then call get_next ();
		else if kdx = FREF then call get_fref ();
		else if kdx = LREF then call get_lref ();
		else if kdx = NREF then call get_nref ();
		else if kdx = PREF then call get_pref ();
		else if kdx = SEEN then call get_seen ("1"b);
		else if kdx = FIRST_SEEN then call get_first_seen ();
		else if kdx = NEXT_SEEN then call get_next_seen ();
		else if kdx = PREV_SEEN then call get_prev_seen ();
		else if kdx = LAST_SEEN then call get_last_seen ();
		else if kdx = UNSEEN then call get_seen ("0"b);
		else if kdx = FIRST_UNSEEN then call get_first_unseen ();
		else if kdx = NEXT_UNSEEN then call get_next_unseen ();
		else if kdx = PREV_UNSEEN then call get_prev_unseen ();
		else if kdx = LAST_UNSEEN then call get_last_unseen ();

END_LOOP:
		pos = pos + jdx;
	     end;					/* keyword or user id */
	     else call ssu_$abort_line (ssu_ptr, forum_et_$bad_trans_spec, "^a", spec);
	     value = value + sign * this_val;		/* add up expression */
	     sign = 1;
	end;					/* token loop */

	if ^in_range then do;			/* add it to the list */
	     call get_tri (value, "1"b, 0, (0));
	     if ^(initial & pref ^= 0) then call allocate_num (value);
	end;
     end pass2;
%page;
get_seen:
     proc (seen);

declare	seen			bit (1) aligned,
	idx			fixed bin;

	in_range = "1"b;
	blank = "0"b;
	tidx = 1;
	do while (tidx <= bit_map_len);
	     idx = index (substr (bit_map, tidx), seen);
	     if idx = 0 then return;
	     tidx = tidx + idx - 1;
	     if tidx <= bit_map_len then do;
		call get_tri (tidx, "1"b, 1, idx);
		if check () then call add_from_multiple ();
		tidx = idx;
	     end;
	end;
     end get_seen;

get_first_seen:
     proc ();
dcl	(backward_sw, which_seen, next_sw)
				bit (1);

	backward_sw = "0"b;
	which_seen = "1"b;
	next_sw = "0"b;
	goto get_common;


get_first_unseen:
     entry ();
	which_seen = "0"b;
	backward_sw = "0"b;
	next_sw = "0"b;
	goto get_common;

get_last_unseen:
     entry ();
	backward_sw = "1"b;
	which_seen = "0"b;
	next_sw = "0"b;
	goto get_common;

set_current:
     entry ();

	if ^have_limits then call get_limits ();
	if bit_map_ptr = null () then do;
	     bit_map_len = last;
	     allocate bit_map in (forum_area);
	     call forum_$get_transaction_map_idx (forum_idx, "", bit_map, code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "Getting transaction map.");
	end;

	reset_current = "1"b;
	backward_sw = "1"b;
	which_seen = "1"b;
	next_sw = "0"b;
	goto get_common;

get_last_seen:
     entry ();
	if bit_map_ptr = null () then do;		/* v1 meeting */
	     this_val = last_seen;
	     return;
	end;
	backward_sw = "1"b;
	which_seen = "1"b;
	next_sw = "0"b;
	goto get_common;

get_next_seen:
     entry ();
	backward_sw = "0"b;
	which_seen = "1"b;
	next_sw = "1"b;
	goto get_common;

get_next_unseen:
     entry ();
	backward_sw = "0"b;
	which_seen = "0"b;
	next_sw = "1"b;
	goto get_common;

get_prev_seen:
     entry ();
	backward_sw = "1"b;
	which_seen = "1"b;
	next_sw = "1"b;
	goto get_common;

get_prev_unseen:
     entry ();
	backward_sw = "1"b;
	which_seen = "0"b;
	next_sw = "1"b;
	goto get_common;

get_common:
	if next_sw then do;				/* TR21375-6: If there is no seen trans, "c" is set to the first non_deleted */
	     if last_seen = 0 then
		this_val = first;
	     else this_val = current;
	end;
	else do;
	     if backward_sw then
		this_val = last;
	     else this_val = first;
	     if substr (bit_map, this_val, 1) = which_seen then
		if ^expungedp () then return;
	end;

/* TR21375-6: If current trans is deleted, "c" is skipped to the next non_deleted trans.  If there are no more non_deleted trans, c is undefined */
	do while ("1"b);
	     this_val = skip_some ();
	     if this_val = 0 then do;
		if next_sw then
		     call ssu_$abort_line (ssu_ptr, 0, "No ^[previous^;more^] ^[un^]seen transactions.", backward_sw,
			^which_seen);
		else if ^(reset_current) then
		     call ssu_$abort_line (ssu_ptr, 0, "^[No^;All^] transactions have been seen.", which_seen);

/* Reset current to first non_deleted trans if reset_current is set */
		else if (first > 0) then do;
		     this_val = first;
		     reset_current = "0"b;
		end;
	     end;
	     if ^expungedp () then return;
	end;

skip_some:
     proc () returns (fixed bin);
dcl	i			fixed bin;

	if backward_sw then do;
	     this_val = find_previous (this_val);
	     if this_val <= 0 then return (0);
	     i = index (reverse (substr (bit_map, 1, this_val)), which_seen);
	     if i = 0 then return (i);
	     i = this_val - i + 1;
	     return (i);
	end;
	else do;
	     this_val = find_next (this_val);
	     if this_val > last then return (0);
	     i = index (substr (bit_map, this_val), which_seen);
	     if i = 0 then return (i);
	     i = i + this_val - 1;
	     return (i);
	end;

     end skip_some;

expungedp:
     proc () returns (bit (1));

	call get_tri (this_val, "1"b, 0, (0));
	return (^check ());

     end expungedp;

     end get_first_seen;
%page;
get_nref:
     proc ();

	call get_tri (current, "0"b, 0, (0));
	if nref = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "There is no next transaction in this chain. ^[""^a""^]", ^list, arg);
	this_val = nref;
	return;
     end get_nref;

get_pref:						/* gets previous in chain of current */
     proc ();

	if current < 0 then
	     this_val = -current;			/* pref unproc */
	else do;
	     call get_tri (current, "0"b, 0, (0));
	     if pref = 0 then
		call ssu_$abort_line (ssu_ptr, 0, "There is no previous transaction in this chain. ^[""^a""^]", ^list,
		     arg);
	     this_val = pref;
	end;
	return;
     end get_pref;

get_lref:						/* gets last in current chain */
     proc ();

	do this_val = current repeat nref;
	     call get_tri (this_val, "1"b, 0, (0));
	     if nref = 0 then return;
	end;
     end get_lref;

get_fref:						/* gets first in current chain */
     proc;

	do this_val = current repeat pref;
	     call get_tri (this_val, "1"b, 0, (0));
	     if pref = 0 then return;
	end;
     end get_fref;

get_prev:						/* gets previous undeleted */
     proc;

declare	idx			fixed bin;

	do tidx = current - 1 repeat idx while (tidx > 0);
	     call get_tri (tidx, "1"b, -1, idx);
	     if check () then do;
		this_val = tidx;
		return;
	     end;
	end;
	call ssu_$abort_line (ssu_ptr, 0, THERE_IS_NO, "previous");
     end get_prev;

check:
     proc () returns (bit (1) aligned);

	return (^expunged & ((deleted & select_type ^= ONLY_UNDELETED) | (^deleted & select_type ^= ONLY_DELETED)));

     end check;

get_next:
     proc ();

declare	idx			fixed bin;

	do tidx = current + 1 repeat idx while (tidx <= last);
	     call get_tri (tidx, "1"b, 1, idx);
	     if check () then do;
		this_val = tidx;
		return;
	     end;
	end;
	call ssu_$abort_line (ssu_ptr, 0, THERE_IS_NO, "next");
     end get_next;


get_all:						/* gets all non-deleted */
     proc ();

declare	(low, high, idx)		fixed bin;

/* This can be called even if get_limits hasn't been called, if default_to_all
   or date/regexp */

	if ^have_limits then call get_limits ();

	in_range = "1"b;
	if trans_specs.date_given then do;
	     call forum_$trans_time_info (forum_idx, trans_specs.low_date, trans_specs.high_date, low, high, code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code);
	     if high + low = 0 then low = 1;		/* No transactions in range */
	end;
	else do;
	     low = first;
	     high = last;
	end;

	do tidx = low repeat idx while (tidx <= high);
	     call get_tri (tidx, "1"b, 1, idx);
	     if check () then call add_from_multiple ();
	end;
	return;
     end get_all;

add_from_multiple:
     proc ();

	if list then call add_to_string (tidx);
	else if ^(initial & pref ^= 0) then call allocate_num (tidx);

     end add_from_multiple;
%page;
/* This routine actually adds a transaction number to the list after making sure it is compatible */
/* with the flags given to parse_specs - deleted etc */

allocate_num:
     proc (tnum);

declare	tnum			fixed bin;

	blank = "0"b;
	if (tnum = 0 & kdx ^= UNPROC) | (tnum = -1 & kdx ^= CMSG) | tnum < -1 then
	     call ssu_$abort_line (ssu_ptr, forum_et_$invalid_trans_idx, "^d", tnum);

	if trans_specs.selected & parse_flags.only_one then call ssu_$abort_line (ssu_ptr, forum_et_$too_many_trans);
	if deleted & select_type = ONLY_UNDELETED then do;
	     if ^in_range then call ssu_$print_message (ssu_ptr, forum_et_$trans_deleted, "Transaction ^d.", tnum);
	     return;
	end;
	else if code = forum_et_$trans_reaped then do;
	     if ^in_range then call ssu_$print_message (ssu_ptr, code, "Transaction ^d.", tnum);
	     return;
	end;
	else if ^deleted & select_type = ONLY_DELETED then do;
	     if ^in_range then call ssu_$print_message (ssu_ptr, forum_et_$trans_not_deleted, "Transaction ^d.", tnum);
	     return;
	end;

	if ^parse_flags.dont_read & tnum ^= -1 then do;
	     if ^select (tnum) then return;		/* check if it matches username and/or regexp */
	     forum_trans_list.max_personid_len =
		max (forum_trans_list.max_personid_len, length (rtrim (forum_user_trans.person_id)));
	end;

	if forum_trans_list.size = forum_trans_list.max_size then call expand_list ();
	forum_trans_list.size = forum_trans_list.size + 1;
	forum_trans_list.list.trans_num (forum_trans_list.size) = tnum;
	if tnum <= 0 then do;
	     forum_trans_list.list.nref (forum_trans_list.size) = 0;
	     forum_trans_list.list.pref (forum_trans_list.size) = 0;
	end;
	else do;
	     forum_trans_list.list.nref (forum_trans_list.size) = nref;
	     forum_trans_list.list.pref (forum_trans_list.size) = pref;
	end;
	string (forum_trans_list.list.flags (forum_trans_list.size)) = ""b;
	forum_trans_list.list.flags.deleted (forum_trans_list.size) = deleted;

	trans_specs.selected = "1"b;
	return;
     end allocate_num;
%page;
expand_list:
     procedure ();

declare	idx			fixed bin,
	new_list_ptr		pointer,
	1 new_list		aligned like forum_trans_list based (new_list_ptr);

	new_list_ptr = null ();
	alloc_trans_list_size = forum_trans_list.max_size * 4;

	on cleanup
	     begin;
		if new_list_ptr ^= null then free new_list;
	     end;

RETRY:
	on area
	     begin;
		call forum_trans_util_$clear_cache (passport_info_ptr);
		goto RETRY;
	     end;

	allocate new_list in (forum_area);
	revert area;

	new_list.max_size = alloc_trans_list_size;
	new_list.size = forum_trans_list.size;
	new_list.max_personid_len = forum_trans_list.max_personid_len;

	do idx = 1 to new_list.size;
	     new_list.list (idx) = forum_trans_list.list (idx);
	end;

	free forum_trans_list;
	forum_trans_list_ptr = new_list_ptr;
	return;
     end expand_list;
%page;
/* This routine adds all transactions greater than last_seen not from this user to the list */
add_new:
     proc;

declare	idx			fixed bin;

	blank = "0"b;				/* KLUDGE - in case there aren't any new ones */
	call user_info_$whoami (me, "", "");
	if last_seen = 0 then
	     tidx = 1;
	else tidx = last_seen + 1;

	do tidx = tidx repeat idx while (tidx <= last);
	     call get_tri (tidx, "1"b, 1, idx);
	     if check () then do;
		call forum_trans_util_$read_trans (passport_info_ptr, forum_idx, tidx, forum_user_trans_ptr, (0));
		if forum_user_trans.person_id ^= me then call add_from_multiple ();
						/* if I sent it, it ain't new */
	     end;
	end;
	return;
     end add_new;


add_aref:						/* adds all in current chain */
     proc (P_all);

declare	(P_all, all)		bit (1) aligned;

	all = P_all;
	do tidx = current repeat pref;		/* back up to beginning of chain */
	     call get_tri (tidx, "1"b, 0, (0));
	     if pref = 0 then goto BEGIN_CHAIN;
	end;

add_rref:
     entry ();

	call get_tri (current, "0"b, 0, (0));
	if nref = 0 then call ssu_$abort_line (ssu_ptr, 0, "There are no more transactions in this chain.");
	tidx = nref;
	all = "1"b;

BEGIN_CHAIN:					/* and add moving forward */
	do tidx = tidx repeat nref;
	     call get_tri (tidx, "0"b, 0, (0));
	     if check () then call add_from_multiple ();
	     if nref = 0 | initial | (^all & nref = current) then return;
	end;
     end add_aref;


do_range:						/* add all non-deleted in a range */
     proc ();

declare	idx			fixed bin;

	if last_val > value then call ssu_$abort_line (ssu_ptr, forum_et_$null_range_spec, arg);
	blank = "0"b;
	do tidx = last_val repeat idx while (tidx <= value);
	     call get_tri (tidx, "1"b, 1, idx);
	     if check () then
		if ^(initial & pref ^= 0) then call allocate_num (tidx);
	end;
	return;
     end do_range;
%page;
/* This routine matches usernames and regexps */
select:
     proc (L_trans_num) returns (bit (1));

declare	L_trans_num		fixed bin;

	call forum_trans_util_$read_trans (passport_info_ptr, forum_idx, L_trans_num, forum_user_trans_ptr, (0));
	if forum_user_trans_ptr = null () then return ("0"b);

	if trans_specs.id_given then
	     if trans_specs.person_id ^= forum_user_trans.person_id then return ("0"b);

	if trans_specs.date_given then do;
	     if trans_specs.low_date >= forum_user_trans.time then return ("0"b);
	     if trans_specs.high_date ^= 0 & trans_specs.high_date <= forum_user_trans.time then return ("0"b);
	end;

	if trans_specs.regexp_given then do;
	     if ^trans_specs.no_match_sj then do;
		call search_file_$silent (addr (trans_specs.regexp), 1, trans_specs.regexp_len,
		     addr (forum_user_trans.subject), 1, (forum_user_trans.subject_length), (0), (0), match_code);
		if match_code = 0 then return ("1"b);
		else if match_code ^= error_table_$nomatch then
		     call ssu_$abort_line (ssu_ptr, match_code, """^a""", trans_specs.regexp);
	     end;

	     if trans_specs.no_match_text then return ("0"b);
	     call search_file_$silent (addr (trans_specs.regexp), 1, trans_specs.regexp_len,
		addr (forum_user_trans.text), 1, (forum_user_trans.text_length), (0), (0), match_code);
	     if match_code ^= 0 then
		if match_code = error_table_$nomatch then
		     return ("0"b);
		else call ssu_$abort_line (ssu_ptr, match_code, """^a""", trans_specs.regexp);
	end;

	return ("1"b);
     end select;

     end forum_trans_specs_$parse_specs;
   



		    forum_trans_util_.pl1           10/19/92  1521.1r w 10/19/92  1454.1       74835


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) BULL HN Information Systems Inc., 1992       *
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Made read_trans handle user area full.
  2) change(92-05-20,Vu), approve(92-05-20,MCR8255), audit(92-10-08,Zimmerman),
     install(92-10-19,MR12.5-1027):
     forum raises 'area condition' in large meetings
                                                   END HISTORY COMMENTS */


/* split off from forum_trans_specs_, added sort_by_chain 11/19/82 Jay Pattin */

forum_trans_util_$read_trans:
     proc (P_passport_info_ptr, P_forum_idx, P_trans_idx, P_forum_user_trans_ptr, P_code);

declare	(P_passport_info_ptr	ptr,
	P_code			fixed bin (35),
	P_forum_trans_list_ptr	ptr,
	P_forum_idx		fixed bin,
	P_trans_idx		fixed bin,
	P_type			fixed bin,
	P_forum_user_trans_ptr	ptr) parameter;

declare	based_fb			fixed bin based,
	cache			bit (1) aligned,
	code			fixed bin (35),
	forum_idx			fixed bin,
	idx			fixed bin,
	(low, low_in_chain)		fixed bin,
	new_trans_list_ptr		ptr,
	nref			fixed bin,
	retry			bit (1) aligned,
	ssu_ptr			ptr,
	trans_idx			fixed bin,
	type			fixed bin,
	v_ptr			ptr;

declare	1 new_trans_list		aligned like forum_trans_list based (new_trans_list_ptr),
	1 v			aligned based (v_ptr),
	2 n			fixed bin,
	2 vector			(alloc_trans_list_size refer (v.n)) ptr unaligned;

declare	(error_table_$noalloc,
	forum_et_$no_forum,
	forum_et_$no_unprocessed,
	forum_et_$trans_reaped,
	forum_et_$trans_deleted)
				fixed bin (35) external static;

declare	forum_$read_trans		entry (fixed bin, fixed bin, ptr, ptr, fixed bin (35)),
	forum_$trans_ref_info	entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, bit (1) aligned,
				fixed bin (35)),
	sort_items_$fixed_bin	entry (ptr),
	ssu_$abort_line		entry options (variable);

declare   (area, cleanup)               condition,
	(addr, null)		builtin;
%page;
%include forum_passport;
%page;
%include forum_trans_list;
%page;
%include forum_user_trans;
%page;
	passport_info_ptr = P_passport_info_ptr;
	ssu_ptr = passport.ssu_ptr;
	trans_idx = P_trans_idx;
	cache = "1"b;

	if P_forum_idx = 0 then do;			/* use current forum */
	     forum_idx = passport.forum_idx;
 	     if forum_idx = 0 & P_trans_idx ^= 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	end;
	else do;					/* use forum given */
	     forum_idx = P_forum_idx;
	     if forum_idx ^= passport.forum_idx then cache = "0"b;	/* don't use cache */
	end;

	if trans_idx = 0 then do;			/* unprocessed trans */
	     if passport.unprocessed_trans_ptr = null then
		call ssu_$abort_line (ssu_ptr, forum_et_$no_unprocessed);
	     P_forum_user_trans_ptr = passport.unprocessed_trans_ptr;
	     P_code = 0;
	     return;
	end;

	if cache & passport.first_trans_ptr ^= null () then do;	/* Look for message in user ring cache */
	     do forum_user_trans_ptr = passport.last_trans_ptr repeat forum_user_trans.prev_trans_ptr
		while (forum_user_trans_ptr ^= null ());
		if forum_user_trans.trans_no = trans_idx then do;
		     P_forum_user_trans_ptr = forum_user_trans_ptr;
		     P_code = 0;
		     return;
		end;
	     end;
	end;

	retry = "0"b;
TRY_AGAIN:
	call forum_$read_trans (forum_idx, trans_idx, passport.area_ptr, forum_user_trans_ptr, code);
	if forum_user_trans_ptr ^= null () then		/* Thread it in cache */
	     if cache then do;
		forum_user_trans.prev_trans_ptr = passport.last_trans_ptr;
		forum_user_trans.next_trans_ptr = null ();
		if passport.first_trans_ptr = null () then
		     passport.first_trans_ptr = forum_user_trans_ptr;
		else passport.last_trans_ptr -> forum_user_trans.next_trans_ptr = forum_user_trans_ptr;
		passport.last_trans_ptr = forum_user_trans_ptr;
	     end;
	     else;
	else if code = forum_et_$trans_reaped | code = forum_et_$trans_deleted then;
	else if code = error_table_$noalloc & ^retry then do;
	     retry = "1"b;
	     call forum_trans_util_$clear_cache (passport_info_ptr);
	     goto TRY_AGAIN;
	end;
	else call ssu_$abort_line (ssu_ptr, code, "Reading transaction ^d.", trans_idx);

	P_forum_user_trans_ptr = forum_user_trans_ptr;
	P_code = code;
	return;
%page;
/* This routine is called to free user-ring cache storage when the current forum is closed */

forum_trans_util_$clear_cache:
     entry (P_passport_info_ptr);

declare	p			 pointer;

	passport_info_ptr = P_passport_info_ptr;
	if passport_info_ptr = null () then return;

	on cleanup begin;
	     passport.first_trans_ptr, passport.last_trans_ptr = null ();
	end;

	do forum_user_trans_ptr = passport.first_trans_ptr repeat p while (forum_user_trans_ptr ^= null ());
	     p = forum_user_trans.next_trans_ptr;
	     free forum_user_trans;
	end;
	passport.first_trans_ptr, passport.last_trans_ptr = null ();
	return;
%page;
forum_trans_util_$reverse:
     entry (P_passport_info_ptr, P_forum_trans_list_ptr);

	passport_info_ptr = P_passport_info_ptr;
	forum_trans_list_ptr = P_forum_trans_list_ptr;
	
	new_trans_list_ptr = null ();
	on cleanup begin;
	     if new_trans_list_ptr ^= null () then free new_trans_list;
	end;

	alloc_trans_list_size = forum_trans_list.size;

RETRY:
	on area begin;
	     call forum_trans_util_$clear_cache (passport_info_ptr);
               goto RETRY;
	end;

	allocate new_trans_list in (forum_area);
          revert area;
	new_trans_list.size = alloc_trans_list_size;
	new_trans_list.max_personid_len = forum_trans_list.max_personid_len;
	do trans_idx = 1 to new_trans_list.size;
	     new_trans_list.trans_num (trans_idx) = forum_trans_list.trans_num (new_trans_list.size - trans_idx + 1);
	end;

	free forum_trans_list;
	P_forum_trans_list_ptr = new_trans_list_ptr;
	return;
%page;
forum_trans_util_$sort_by_chain:
     entry (P_passport_info_ptr, P_forum_idx, P_forum_trans_list_ptr, P_type);

	passport_info_ptr = P_passport_info_ptr;
	forum_idx = P_forum_idx;
	forum_trans_list_ptr = P_forum_trans_list_ptr;
	type = P_type;

	new_trans_list_ptr, v_ptr = null ();
	on cleanup begin;
	     if new_trans_list_ptr ^= null () then free new_trans_list;
	     if v_ptr ^= null () then free v;
	end;

	alloc_trans_list_size = forum_trans_list.size;
	allocate v in (forum_area);
	do idx = 1 to forum_trans_list.size;
	     v.vector (idx) = addr (forum_trans_list.trans_num (idx));
	end;
	call sort_items_$fixed_bin (v_ptr);

	allocate new_trans_list in (forum_area);
	new_trans_list.max_personid_len = forum_trans_list.max_personid_len;
	new_trans_list.size = 0;

	trans_idx = v.vector (1) -> based_fb;
	v.vector (1) = null ();
	low = 2;

	do while ("1"b);
ADD:	     new_trans_list.size = new_trans_list.size + 1;
	     new_trans_list.trans_num (new_trans_list.size) = trans_idx;

	     if new_trans_list.size = forum_trans_list.size then do;     /* Done */
		free v;
		free forum_trans_list;
		P_forum_trans_list_ptr = new_trans_list_ptr;
		return;
	     end;

	     low_in_chain = low;
	     call forum_$trans_ref_info (forum_idx, trans_idx, type, (0), nref, ("0"b), (0));
	     do while (nref ^= 0);
		do idx = low_in_chain to v.n;
		     if v.vector (idx) ^= null () then do;
			trans_idx = v.vector (idx) -> based_fb;
		     	if trans_idx = nref then do;
			     v.vector (idx) = null ();
			     low_in_chain = idx + 1;
			     goto ADD;
			end;
			if trans_idx > nref then goto NOT_THIS_ONE;
		     end;
		end;
NOT_THIS_ONE:	trans_idx = nref;
		call forum_$trans_ref_info (forum_idx, trans_idx, type, (0), nref, ("0"b), (0));
		low_in_chain = idx;
	     end;

	     do idx = low to v.n while (v.vector (idx) = null ());	/* No more in chain, find next head */
	     end;
	     trans_idx = v.vector (idx) -> based_fb;
	     v.vector (idx) = null ();
	     low = idx + 1;
	end;
	     
     end forum_trans_util_$read_trans;
 



		    suffix_forum_.pl1               10/14/88  1224.3rew 10/14/88  1213.0      123678


/****^  **************************************************************
        *                                                            *
        * Copyright, (C) Massachusetts Institute of Technology, 1983 *
        *                                                            *
        ************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     removed per-attendee switches because of errors when called
     by non-participants.
  2) change(88-09-13,Beattie), approve(88-08-01,MCR7948),
     audit(88-10-11,Farley), install(88-10-14,MR12.2-1165):
     Fix bug in list_acl entry which is called when fs_util_$list_acl
     is used.  Needed to copy access_name entries from one array to another.
                                                   END HISTORY COMMENTS */


/* format: style2,idind30,indcomtxt */

suffix_forum_:
     procedure;

/*  Interface to forum for the extended acl / extended object facility
   Jay Pattin 1/25/83 */
/*  Moved to the new interfaces, BIM, 831002 */

	declare P_acl_ptr		        ptr;
	declare P_area_ptr		        ptr;
	declare P_bit_count		        fixed bin (24);
	declare P_copy_options_ptr	        ptr;
	declare P_desired_version	        char (*);
	declare P_directory		        char (*);
	declare P_max_length	        fixed bin (19);
	declare (P_mode, P_exmode)	        bit (36) aligned;
	declare P_name		        char (*);
	declare P_new_name		        char (*);
	declare P_no_sysdaemon	        bit (1);
	declare P_old_name		        char (*);
	declare P_return_ptr	        ptr;
	declare P_ring		        fixed bin;
	declare P_ring_brackets	        (*) fixed bin (3);
	declare P_status		        fixed bin (35);
	declare P_suffix_info_ptr	        ptr;
	declare P_switch_list_ptr	        ptr;
	declare P_switch_name	        char (*);
	declare P_user_name		        char (*);
	declare P_value		        bit (1) aligned;

	declare area_ptr		        pointer;
	declare based_area		        area based (area_ptr);
	declare directory		        char (168);
	declare dir_rings		        (2) fixed bin (3);
	declare idx		        fixed bin;
	declare name		        char (32);

	declare (
	        error_table_$unimplemented_version,
	        error_table_$argerr,
	        error_table_$noentry,
	        error_table_$not_seg_type,
	        forum_et_$invalid_switch_name,
	        forum_et_$no_such_user,
	        forum_et_$not_a_forum
	        )			        fixed bin (35) external;

	declare (addr, hbound, lbound, null, rtrim, string)
				        builtin;

	declare old_acl_ptr		        pointer;
	declare switches		        (5) char (32) static options (constant)
				        init ("safety", "adjourned", "adj",
				        "meeting_eligibility_messages", "mtg_emsg");

	declare get_system_free_area_	        entry () returns (ptr);
	declare hcs_$get_dir_ring_brackets    entry (char (*), char (*), (2) fixed bin (3), fixed bin (35));
	declare hcs_$get_user_access_modes    entry (char (*), char (*), char (*), fixed bin, bit (36) aligned,
				        bit (36) aligned, fixed bin (35));
	declare forum_$chname_forum	        entry (char (*), char (*), char (*), char (*), fixed bin (35));
	declare forum_$copy		        entry (ptr, fixed bin (35));
	declare forum_$delete_forum	        entry (char (*), char (*), fixed bin (35));
	declare forum_$delete_forum_acl       entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
	declare forum_$get_forum_path	        entry (char (*), char (*), char (*), char (*), fixed bin (35));
	declare forum_$get_switch	        entry (char (*), char (*), char (*), char (*), bit (1) aligned,
				        fixed bin (35));
	declare forum_$list_forum_acl	        entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35));
	declare forum_$replace_forum_acl      entry (char (*), char (*), ptr, fixed bin, bit (1), fixed bin (35));
	declare forum_$set_forum_acl	        entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
	declare forum_$set_switch	        entry (char (*), char (*), char (*), char (*), bit (1) aligned,
				        fixed bin (35));

	declare forum_data_$print_eligibility_messages
				        bit (1) aligned external;
						/* format: off */
declare system_free_area area based (get_system_free_area_ ());
declare cleanup condition;

%page; %include acl_structures;
%page; %include suffix_info;
%page; %include copy_options;
%page; %include copy_flags;
%page; %include access_mode_values;
/* format: on */


chname_file:
     entry (P_directory, P_name, P_old_name, P_new_name, P_status);

	call forum_$chname_forum (P_directory, P_name, P_old_name, P_new_name, P_status);
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	return;


copy:
     entry (P_copy_options_ptr, P_status);

	call forum_$copy (P_copy_options_ptr, P_status);
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	return;

get_ring_brackets:
     entry (P_directory, P_name, P_ring_brackets, P_status);

	if lbound (P_ring_brackets, 1) ^= 1 | hbound (P_ring_brackets, 1) < 2
	then do;
		P_status = error_table_$argerr;
		return;
	     end;

	call forum_$get_forum_path (P_directory, P_name, directory, name, P_status);
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	     else ;
	else do;
		call hcs_$get_dir_ring_brackets (P_directory, P_name, dir_rings, P_status);
		P_ring_brackets (1), P_ring_brackets (2) = dir_rings (1);
	     end;

	return;

get_user_access_modes:
     entry (P_directory, P_name, P_user_name, P_ring, P_mode, P_exmode, P_status);

	directory = rtrim (P_directory) || ">" || P_name;

	P_exmode = ""b;
	call hcs_$get_user_access_modes (directory, "Attendees", P_user_name, P_ring, (""b), P_mode, P_status);
						/* YCCH! */

	if P_status = error_table_$noentry
	then P_status = error_table_$not_seg_type;
	return;
%page;
get_switch:
     entry (P_directory, P_name, P_switch_name, P_value, P_status);

	call forum_$get_switch (P_directory, P_name, "", P_switch_name, P_value, P_status);
	goto CHECK_SWITCH_ERROR;


set_switch:
     entry (P_directory, P_name, P_switch_name, P_value, P_status);

	call forum_$set_switch (P_directory, P_name, "", P_switch_name, P_value, P_status);

CHECK_SWITCH_ERROR:
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	     else if P_status = forum_et_$invalid_switch_name
	     then P_status = error_table_$argerr;

	return;
%page;
add_acl_entries:
     entry (P_directory, P_name, P_acl_ptr, P_status);

	acl_ptr = P_acl_ptr;
	if general_acl.version ^= GENERAL_ACL_VERSION_1
	then do;
		P_status = error_table_$unimplemented_version;
		return;
	     end;

	acl_count = general_acl.count;
	old_acl_ptr = null ();
	on cleanup
	     begin;
		if old_acl_ptr ^= null ()
		then do;
			free old_acl_ptr -> segment_acl_array;
			old_acl_ptr = null ();
		     end;
	     end;

	allocate segment_acl_array in (system_free_area) set (old_acl_ptr);
	old_acl_ptr -> segment_acl_array (*).access_name = general_acl.entries (*).access_name;
	old_acl_ptr -> segment_acl_array (*).mode = RW_ACCESS;
	old_acl_ptr -> segment_acl_array (*).extended_mode = general_acl.entries (*).mode;


	call forum_$set_forum_acl (P_directory, P_name, old_acl_ptr, acl_count, P_status);
	general_acl.entries (*).status_code = old_acl_ptr -> segment_acl_array (*).status_code;
	free old_acl_ptr -> segment_acl_array;

	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	return;


delentry_file:
     entry (P_directory, P_name, P_status);

	call forum_$delete_forum (P_directory, P_name, P_status);
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	return;


delete_acl_entries:
     entry (P_directory, P_name, P_acl_ptr, P_status);

	acl_ptr = P_acl_ptr;
	if general_delete_acl.version ^= GENERAL_DELETE_ACL_VERSION_1
	then do;
		P_status = error_table_$unimplemented_version;
		return;
	     end;
	call forum_$delete_forum_acl (P_directory, P_name, addr (general_delete_acl.entries), general_delete_acl.count,
	     P_status);

	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	return;


list_acl:
     entry (P_directory, P_name, P_desired_version, P_area_ptr, P_acl_ptr, P_status);

	acl_ptr = P_acl_ptr;
	if acl_ptr = null ()
	then do;
		if P_desired_version ^= GENERAL_ACL_VERSION_1
		then do;
			P_status = error_table_$unimplemented_version;
			return;
		     end;

		call forum_$list_forum_acl (P_directory, P_name, get_system_free_area_ (), old_acl_ptr, null (),
		     acl_count, P_status);
		if P_status ^= 0
		then do;
			if P_status = forum_et_$not_a_forum
			then P_status = error_table_$not_seg_type;
			return;
		     end;

		if acl_count = 0
		then do;
			if old_acl_ptr ^= null ()
			then free old_acl_ptr -> segment_acl_array;
			P_acl_ptr = null ();
			return;
		     end;
		area_ptr = P_area_ptr;
		allocate general_acl in (based_area) set (acl_ptr);
		general_acl.version = P_desired_version;
		general_acl.entries (*).access_name = old_acl_ptr -> segment_acl_array (*).access_name;
		general_acl.entries (*).mode = old_acl_ptr -> segment_acl_array (*).extended_mode;
		general_acl.entries (*).status_code = 0;
		free old_acl_ptr -> segment_acl_array;
		P_acl_ptr = acl_ptr;
		return;
	     end;
	else do;					/* Specific entries */
		if general_acl.version ^= GENERAL_ACL_VERSION_1
		then do;
			P_status = error_table_$unimplemented_version;
			return;
		     end;
		old_acl_ptr = null ();
		on cleanup
		     begin;
			if old_acl_ptr ^= null ()
			then do;
				free old_acl_ptr -> segment_acl_array;
				old_acl_ptr = null ();
			     end;
		     end;

		acl_count = general_acl.count;
		allocate segment_acl_array in (system_free_area) set (old_acl_ptr);
		old_acl_ptr -> segment_acl_array(*).access_name = general_acl.entries(*).access_name;

		call forum_$list_forum_acl (P_directory, P_name, null (), null (), old_acl_ptr, acl_count, P_status);
		if P_status = forum_et_$not_a_forum
		then P_status = error_table_$not_seg_type;
		else do;
			general_acl.entries (*).mode = old_acl_ptr -> segment_acl_array (*).extended_mode;
			general_acl.entries (*).status_code = old_acl_ptr -> segment_acl_array (*).status_code;
		     end;
		free old_acl_ptr -> segment_acl_array;
	     end;
	return;

replace_acl:
     entry (P_directory, P_name, P_acl_ptr, P_no_sysdaemon, P_status);


	old_acl_ptr = null ();
	on cleanup
	     begin;
		if old_acl_ptr ^= null ()
		then do;
			free old_acl_ptr -> segment_acl_array;
			old_acl_ptr = null ();
		     end;
	     end;

	acl_ptr = P_acl_ptr;
	if acl_ptr = null ()
	then do;
		call forum_$replace_forum_acl (P_directory, P_name, null (), 0, P_no_sysdaemon, P_status);
		return;
	     end;

	if general_acl.version ^= GENERAL_ACL_VERSION_1
	then do;
		P_status = error_table_$unimplemented_version;
		return;
	     end;

	acl_count = general_acl.count;
	allocate segment_acl_array in (system_free_area) set (old_acl_ptr);

	old_acl_ptr -> segment_acl_array (*).access_name = general_acl.entries (*).access_name;
	old_acl_ptr -> segment_acl_array (*).mode = RW_ACCESS;
	old_acl_ptr -> segment_acl_array (*).extended_mode = general_acl.entries (*).mode;
	old_acl_ptr -> segment_acl_array (*).status_code = 0;

	call forum_$replace_forum_acl (P_directory, P_name, old_acl_ptr, acl_count, P_no_sysdaemon, P_status);
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;

	general_acl.entries (*).status_code = old_acl_ptr -> segment_acl_array (*).status_code;
	free old_acl_ptr -> segment_acl_array;
	return;


validate:
     entry (P_directory, P_name, P_status);

	call forum_$get_forum_path (P_directory, P_name, directory, name, P_status);
	if P_status ^= 0
	then if P_status = forum_et_$not_a_forum
	     then P_status = error_table_$not_seg_type;
	return;


suffix_info:
     entry (P_suffix_info_ptr);

	suffix_info_ptr = P_suffix_info_ptr;

	suffix_info.version = SUFFIX_INFO_VERSION_1;
	suffix_info.type = "forum";
	suffix_info.type_name = "Forum meeting";
	suffix_info.plural_name = "Forum meetings";
	string (suffix_info.flags) = ""b;
	suffix_info.extended_acl = "0"b;
	suffix_info.has_switches = "1"b;
	suffix_info.modes = "rwc";
	suffix_info.max_mode_len = 3;
	suffix_info.num_ring_brackets = 2;

	string (suffix_info.copy_flags) = ""b;
	suffix_info.copy_flags.names, suffix_info.copy_flags.acl, suffix_info.copy_flags.safety_switch = "1"b;

	suffix_info.info_pathname = ">exl>info>forum.xobj.info";
	return;


list_switches:
     entry (P_desired_version, P_area_ptr, P_switch_list_ptr, P_status);

	if P_desired_version ^= SWITCH_LIST_VERSION_1
	then do;
		P_status = error_table_$unimplemented_version;
		return;
	   end;

	alloc_switch_count = 3;
	alloc_switch_name_count = hbound (switches, 1);

	area_ptr = P_area_ptr;
	allocate switch_list in (based_area);
	switch_list.version = SWITCH_LIST_VERSION_1;

	switch_list.name_index (1) = 1;		/* safety */
	switch_list.name_count (1) = 1;
	switch_list.default_value (1) = "0"b;

	switch_list.name_index (2) = 2;		/* adjourned */
	switch_list.name_count (2) = 2;
	switch_list.default_value (2) = "0"b;

	switch_list.name_index (3) = 4;		/* meeting_eligibility_messages */
	switch_list.name_count (3) = 2;
	switch_list.default_value (3) = forum_data_$print_eligibility_messages;

	switch_list.names (*) = switches (*);
	P_switch_list_ptr = switch_list_ptr;

	return;

     end suffix_forum_;


		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved