



		    display_doc.pl1                 11/01/84  1435.9r w 11/01/84  1303.8       86859



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
/* format: style2 */
display_doc:
     proc (p_io_ptr, p_mrds_dbi, p_manual_number, p_display_info_ptr, p_topics_string, p_code);

/* HISTORY:
Written by Jim Paradise, fall 1981.
Modified:
03/05/81 by M. Pierret for new format (no manual_data_rel).
10/19/81 by M. Pierret to accept p_topics_string, and display that string
            at the end of the header with a "Topic(s) selected:" prefix.
03/30/83 by M. Pierret: Changed to use new format database which includes
            the info_rel relation, and to use format_document_$string to
            to format text fields for printing.
04/22/83 by Matthew Pierret:  Changed to remove the comment block surrounding
            the code which displays short names.  This code was commented out
            so that short names would not be displayed.  Now, explain_doc and
            where_doc have been changed to turn the
            display_info.short_name_flag off by default.  This change allows
            short names to be displayed by over-riding the default with
            control args.
05/13/83 by J. Siwila:  Removed one of the blank lines inserted before manual
            information is displayed.  Now there is only one line inserted 
            between the command line and the display and between separate
            manuals in a single display.
06/15/83 by J. Siwila:  Substituted p_topics_string for topics_string so that
            char is * rather than 128.
09/01/83 by Matthew Pierret: Changed to allow display of leading blank line to
            be optional, to display "Short names" field at left margin, to
            trim of trailing NL from description and audience.
09/29/83 by Matthew Pierret: Fixed bug which prevented the display of more than
            one short name.  Changed to correctly set the version_number and
            syllable_size of format_document_options and to not adjust (right
            justify) text.
*/

/*
DESCRIPTION:
        Given an internal manual identification number, this routine displays
   information about that manual according to constraints set in display_info.
   The following information is displayed as follows:

     Title:  Multics Commands and Active Functions
     Order No.:  AG92-05 
   { Short names:  commands, commands_afs, caf }
     Release Supported:  MR10.1
   { Topics selected:  create_mrds_dsm, list_comp_dsm }

   { Description: ... }

   { Audience: ...... }

   { Table of contents: ... }

   { New features: ........ }

   Those enclosed in {} are optionally displayed according to display_doc_info.
*/

/* START OF DECLARATIONS */
/* Parameters */

	dcl     p_io_ptr		 ptr;		/* points to iocb to use for output */
	dcl     p_mrds_dbi		 fixed bin (35);	/* is the database opening index of the online_doc database */
	dcl     p_manual_number	 fixed bin;	/* is the identifier of the manual to be dislayed. */
	dcl     p_display_info_ptr	 ptr;		/* is a pointer to a display_info structure, which specifies which fields to display. */
	dcl     p_topics_string	 char (*) varying;	/* is a string of one or more topics selected by where_doc. */
	dcl     p_code		 fixed bin (35);	/* is a standard system error code. */

/* Automatic */

	dcl     io_ptr		 ptr;

	dcl     manual_number	 fixed bin;
	dcl     mrds_dbi		 fixed bin (35);
	dcl     code		 fixed bin (35);

	dcl     print_short_name	 char (64) varying;
	dcl     title_string	 char (128) varying;
	dcl     first_short_name_flag	 bit (1);
	dcl     (input_string, formatted_string)
				 char (1024);
	dcl     output_string	 char (1024) varying;
	dcl     formatted_string_length
				 fixed bin (21);
	dcl     1 local_format_document_options
				 aligned like format_document_options;

/* Builtin */

	dcl     (addr, after, before, index, length, string, substr, translate)
				 builtin;

/* Constant */

	dcl     NL		 char (1) internal static options (constant) init ("
");

/* Entry */

	dcl     dsl_$retrieve	 entry options (variable);
	dcl     ioa_$ioa_switch	 entry options (variable);
	dcl     ioa_$ioa_switch_nnl	 entry options (variable);
	dcl     format_document_$string
				 entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35));

/* END OF DECLARATIONS */

/* format: ^indblkcom,indcomtxt */

	io_ptr = p_io_ptr;
	mrds_dbi = p_mrds_dbi;
	manual_number = p_manual_number;
	display_info_ptr = p_display_info_ptr;

	if display_info.header.full_name_flag | display_info.header.order_number_flag
	     | display_info.header.revision_flag | display_info.header.release_supported_flag
	then do;
		call dsl_$retrieve (mrds_dbi, "-range (x full_name_rel) -select x -where x.manual_number = .V.",
		     manual_number, full_name_rel, code);
		if code ^= 0
		then goto ERROR;
	     end;

	if display_info.display_leading_blank_line
	then call ioa_$ioa_switch (io_ptr, "");

	if display_info.header.full_name_flag
	then do;
		title_string = translate (full_name_rel.full_name, " ", "_");
		call ioa_$ioa_switch (io_ptr, "Title:  ^a", title_string);
	     end;

	if display_info.header.order_number_flag
	then call ioa_$ioa_switch (io_ptr, "Order No.:  ^a^[-^3a^]", full_name_rel.order_number,
		(full_name_rel.revision ^= " "), full_name_rel.revision);

	if display_info.header.short_name_flag
	then do;
		call dsl_$retrieve (mrds_dbi, "-range (x short_name_rel) -select x -where x.manual_number = .V.",
		     manual_number, short_name_rel, code);
		if code ^= 0
		then goto ERROR;

		first_short_name_flag = "1"b;
		print_short_name = translate (short_name_rel.short_name, " ", "_");
DISPLAY_EACH_SHORT_NAME:
		do while (code = 0);
		     call dsl_$retrieve (mrds_dbi, "-another", manual_number, short_name_rel, code);

		     call ioa_$ioa_switch_nnl (io_ptr, "^[Short name^[s^]:  ^;^s, ^]^a", first_short_name_flag,
			(code = 0), print_short_name);
		     if code = 0
		     then print_short_name = translate (short_name_rel.short_name, " ", "_");
		     first_short_name_flag = "0"b;

		end DISPLAY_EACH_SHORT_NAME;
	     end;

	if display_info.header.short_name_flag
	then call ioa_$ioa_switch_nnl (io_ptr, "^/");

	if display_info.header.release_supported_flag
	then call ioa_$ioa_switch (io_ptr, "Release Supported:  ^a", full_name_rel.release_supported);

	if display_info.header.topics_flag
	then call ioa_$ioa_switch (io_ptr, "Topic^[s^] selected:  ^a", (index (p_topics_string, ", ") ^= 0),
		p_topics_string);


	if description_flag | audience_flag | table_of_contents_flag | new_features_flag
	then do;
		call dsl_$retrieve (mrds_dbi, "-range (x info_rel) -select x -where x.manual_number = .V.",
		     manual_number, info_rel, code);
		if code ^= 0
		then goto ERROR;
	     end;

	format_document_options_ptr = addr (local_format_document_options);
	format_document_options.version_number = format_document_version_2;
	format_document_options.indentation = 5;
	format_document_options.line_length = 70;
	format_document_options.syllable_size = 0;
	string (format_document_options.switches) = "0"b;
	format_document_options.switches.galley_sw = "1"b;
	format_document_options.switches.literal_sw = "1"b;

	if description_flag
	then do;
		input_string = info_rel.description;
		call format_document_$string (substr (input_string, 1, length (info_rel.description)),
		     formatted_string, formatted_string_length, format_document_options_ptr, code);
		if substr (formatted_string, formatted_string_length, 1) = NL
		then output_string = substr (formatted_string, 1, formatted_string_length - 1);
		else output_string = substr (formatted_string, 1, formatted_string_length);
		call ioa_$ioa_switch (io_ptr, "^/Description:^/^a", output_string);
	     end;

	if audience_flag
	then do;
		input_string = info_rel.audience;
		call format_document_$string (substr (input_string, 1, length (info_rel.audience)), formatted_string,
		     formatted_string_length, format_document_options_ptr, code);
		if substr (formatted_string, formatted_string_length, 1) = NL
		then output_string = substr (formatted_string, 1, formatted_string_length - 1);
		else output_string = substr (formatted_string, 1, formatted_string_length);

		call ioa_$ioa_switch (io_ptr, "^/Audience:^/^a", output_string);
	     end;

	if table_of_contents_flag
	then do;
		input_string = info_rel.table_of_contents;
		call ioa_$ioa_switch (io_ptr, "^/Table of Contents:");
		do while (index (input_string, NL) ^= 0);
		     output_string = before (input_string, NL);
		     input_string = after (input_string, NL);
		     call ioa_$ioa_switch (io_ptr, "^vx^a", format_document_options.indentation, output_string);
		end;
		if input_string ^= ""
		then call ioa_$ioa_switch (io_ptr, "^vx^a", format_document_options.indentation, input_string);
	     end;

	if new_features_flag
	then do;
		input_string = info_rel.new_features;
		call ioa_$ioa_switch (io_ptr, "^/New Features:");
		do while (index (input_string, NL) ^= 0);
		     output_string = before (input_string, NL);
		     input_string = after (input_string, NL);
		     call ioa_$ioa_switch (io_ptr, "^vx^a", format_document_options.indentation, output_string);
		end;
		if input_string ^= ""
		then call ioa_$ioa_switch (io_ptr, "^vx^a", format_document_options.indentation, input_string);
	     end;

	p_code = 0;
	return;

ERROR:
	p_code = code;
	return;
%page;
%include display_doc_info;
%page;
%include online_doc;
%page;
%include format_document_options;

     end display_doc;




		    explain_doc.pl1                 06/18/86  1333.5rew 06/18/86  1331.3      388602



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-06-12,GJohnson), approve(86-06-12,MCR7410),
     audit(86-06-17,Martinson), install(86-06-18,MR12.0-1079):
     Changed to use iox_ user_output.
                                                   END HISTORY COMMENTS */


/* format: style2 */
explain_doc:
edoc:
     proc;


/* HISTORY:
Written by Jim Paradise, fall 1980.
Modified:
03/03/81 by M. Pierret to include request loop and allow quitting
            without closing data base.
06/04/81 M. Pierret "Another section?" to "More information?",
            added "y" as acceptable answer, made description default.
            added -no_description, -nd control arguments.
10/19/81 by M. Pierret to use display_info instead of display_flags.

03/24/83 by J. Siwila to add menu displays for 12 groups of Multics 
            manuals and substring searching of input strings for mrds,
            linus, and mrpg manuals.  Also added "n" as acceptable
            answer to prompt and took short names out of display.
04/22/83 by Matthew Pierret:  Reformatted the HISTORY section so that it is
            useable by subsys maintenance tools.  Added a DESCRIPTION section.
           Changed to set display_info.short_name_flag to off by default.
           Added an automatic local_display_info, like display_info, upon
            which display_info is based (display_info_ptr = addr
            (local_display_info)).
05/24/83 by Matthew Pierret: Changed control arg processing loop to start
            at 2 instead of 1, as the first non-null value in the 
            control_argument array is the control_argument(2).
            Changed "-pathname" to "-database_pathname" and "-pn" to "-dbpn"
            in the control_argument array. Filled out the argument_type array
            to the same extent as the control_argument array.
07/15/83 by James Siwila:  Added -no_audience, -no_table_of_contents, and 
            -no_new_features control arguments and a facility for displaying 
            the 12 manual subsets when the menu facility is not available or 
            not invoked by the user.
09/01/83 by M. Pierret:  Removed -brief control argument.
09/23/83 by M. Pierret:  General cleanup of code. Changed headers and trailers
            of menus to be slightly more descriptive.  Changed error messages
            to be more descriptive and more complete.  Added support of
            -output_file.  Changed handling of groups by setting up an include
            file of based choice arrays (on for each group) with initial
            attributes of the choices for each group.  That way the GROUP case
            statement cases are reduce to allocating the proper choices array.
            Changed display of acceptable requests to be two-columned.
            Changed default database path to >doc>facilities_data_dir.
09/29/83 by M. Pierret:  Changed to always get new opening when -dbpn is
            specified, and to close the existing opening if there is one.
            Made -output_file_sw mean also -no_request_loop.
09/30/83 by Matthew Pierret: Changed to print "explain_doc must be followed..."
            instead of "Command name must be followed..." and to use a local
            variable for the code argument instead of (0) in calls in the 
            clean_up subroutine - dsl_$close was complaining about not getting
            a correctly declared argument. Changed cleanup routines to cleanup
            the screen if use_menu is on rather than video_is_on. Changed the
            "new user" group name to "new_user".
*/

/*
DESCRIPTION:
          This command retrieves information about a Multics documentaiton 
     manual stored in the online_doc.db database, and displays that information
     for the user.
     Usage: explain_doc ID {-control_args}; where ID may be a manual order
     number (e.g., AG93) or the full name or short name of a manual.
*/


/* Automatic */

	dcl     output_switch_name	 char (32);
	dcl     manual_id		 char (64) var;
	dcl     reply		 char (256) varying;
	dcl     request		 char (256) varying;
	dcl     mrds_database_path	 char (168);
	dcl     output_file_path	 char (168);

	dcl     (
	        accept_control_argument,
	        mrds_scope_set,
	        completely_processed_reply,
	        display_all_manuals,
	        enter_request_loop	 init ("1"b),
	        manual_number_found,
	        quit_signalled
	        )			 bit (1) aligned;
	dcl     (database_path_sw, output_file_sw)
				 bit (1) aligned init ("0"b);

	dcl     1 local_display_info	 aligned like display_info;

	dcl     (accept_idx, first_delimiter, idx, manual_number, number_of_manuals, request_idx, start_idx)
				 fixed bin;
	dcl     arg_len		 fixed bin;
	dcl     arg_idx		 fixed bin;
	dcl     nargs		 fixed bin;
	dcl     control_argument_idx	 fixed bin;
	dcl     code		 fixed bin (35);
	dcl     mrds_dbi		 fixed bin (35) init (0);
	dcl     current_mrds_dbi	 fixed bin (35) init (0);

	dcl     manual_array	 (200) fixed bin;
	dcl     (arg_ptr, output_ptr, work_area_ptr)
				 ptr;

/* Based */

	dcl     arg		 based (arg_ptr) char (arg_len);
	dcl     work_area		 area (sys_info$max_seg_size) based (work_area_ptr);

/* Constant */

	dcl     control_argument	 (1:29) char (32) varying options (constant)
				 init ("explain_doc", "-output_file", "-of", "-database_pathname", "-dbpn",
				 "-description", "-desc", "-audience", "-aud", "-table_of_contents", "-toc",
				 "-new_features", "-nf", "", "", "-no_request_loop", "-nrql", "-request_loop",
				 "-rql", "-all", "-a", "-no_description", "-no_desc", "-no_audience", "-no_aud",
				 "-no_table_of_contents", "-no_toc", "-no_new_features", "-no_nf") internal static;
	dcl     argument_type	 (1:29) char (64) varying options (constant)
				 init ("manual identifier", (2) (1)"output file pathname",
				 (2) (1)"database pathname", (24) (1)"") internal static;
	dcl     myname		 char (11) options (constant) init ("explain_doc") internal static;
	dcl     acceptable_requests	 (0:16) char (17) varying int static
				 init ("", "?", "yes", "y", "no", "n", "quit", "q", "description", "desc",
				 "audience", "aud", "table_of_contents", "toc", "new_features", "nf", "all");
	dcl     (
	        QUESTION_MARK_REQUEST_IDX
				 init (1),
	        FIRST_REQUEST_IDX	 init (2),
	        FIRST_SECTION_NAME_IDX init (8)
	        )			 fixed bin internal static options (constant);
	dcl     LOWER_CASE_ALPHA	 char (26) int static options (constant) init ("abcdefghijklmnopqrstuvwxyz");
	dcl     UPPER_CASE_ALPHA	 char (26) int static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");

/* Builtin */

	dcl     (addr, after, before, copy, empty, hbound, index, length, ltrim, null, rtrim, string, substr, translate,
	        unspec)		 builtin;

/* Condition */

	dcl     cleanup		 condition;


/* Entry */

	dcl     absolute_pathname_	 entry (char (*), char (*), fixed bin (35));
	dcl     absolute_pathname_$add_suffix
				 entry (char (*), char (*), char (*), fixed bin (35));
	dcl     active_fnc_err_	 entry () options (variable);
	dcl     com_err_		 entry options (variable);
	dcl     complain		 entry variable options (variable);
	dcl     cu_$arg_ptr		 entry (fixed bin, ptr, fixed bin, fixed bin (35));
	dcl     cu_$af_return_arg	 entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl     cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35));
	dcl     display_doc		 entry (ptr, fixed bin (35), fixed bin, ptr, char (*) var, fixed bin (35));
	dcl     dsl_$close		 entry () options (variable);
	dcl     dsl_$dl_scope_all	 entry (fixed binary (35), fixed binary (35));
	dcl     dsl_$open		 entry options (variable);
	dcl     dsl_$retrieve	 entry options (variable);
	dcl     dsl_$set_scope_all	 entry options (variable);
	dcl     ioa_		 entry options (variable);
	dcl     online_doc_db_index$set_index
				 entry (fixed bin (35));
	dcl     online_doc_db_index$return_index
				 entry (fixed bin (35));
	dcl     command_query_	 entry () options (variable);
	dcl     define_area_	 entry (ptr, fixed bin (35));
	dcl     release_area_	 entry (ptr);
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));

/* External */

	dcl     (
	        error_table_$noarg,
	        error_table_$badopt,
	        error_table_$bad_arg,
	        error_table_$not_act_fnc,
	        error_table_$active_function,
	        error_table_$noentry,
	        mrds_error_$tuple_not_found,
	        mrds_error_$invalid_db_index
	        )			 ext fixed bin (35);
	dcl     sys_info$max_seg_size	 ext fixed bin (35);

/* Menu dcls */

	dcl     video_data_$terminal_iocb
				 ptr external;
	dcl     (video_is_on, use_menu)
				 bit (1) aligned;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     reason		 char (512);

/* END OF DECLARATIONS */

/* format: indcomtxt,^indblkcom */

	output_ptr, work_area_ptr = null;
	mrds_scope_set, use_menu = "0"b;
	video_is_on = (video_data_$terminal_iocb ^= null);

	mrds_database_path = ">doc>facilities_data_dir>online_doc.db";

	manual_id = "";

	display_info_ptr = addr (local_display_info);
	string (display_info) = "0"b;
	display_info.header.order_number_flag, display_info.header.full_name_flag,
	     display_info.header.release_supported_flag, display_info.header.revision_flag,
	     display_info.text.description_flag = "1"b;

	call cu_$af_return_arg (nargs, (null), (0), code);
	if code = 0
	then call active_fnc_err_ (error_table_$active_function, myname, "");
	else if code ^= error_table_$not_act_fnc
	then do;
		call com_err_ (code, myname);
		return;
	     end;

	complain = com_err_;

	if nargs = 0
	then do;
		call complain (error_table_$noarg, myname, "^/Usage: ^a topic_name  {-control_args}", myname);
		return;
	     end;
	accept_control_argument = "0"b;		/* First argument cannot be a control argument. */
	control_argument_idx = 1;			/* First argument must be of argument_type (1) - topic name. */

ARGUMENT_PROCESSING_LOOP:
	do arg_idx = 1 to nargs;
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);
	     if index (arg, "-") ^= 1
	     then do;
		     goto ARG (control_argument_idx);

		/*** The argument is not a control argument.  If no control argument has
		     been processed yet, the argument is of type argument_type (1). If a
		     control argument has been processed but the last control argument does not
		     expect an arguemnt, control_argument_idx is 0 and this case is in error.
		     If an argument to a control argument is expected, it is of type
		     argument_type (control_argument_idx). */

ARG (0):						/* unexpected argument */
		     call complain (error_table_$badopt, myname, "Argument is out of place: ^a.", arg);
		     return;

ARG (1):						/* manual identifier, immediately follows the command name. */
		     if length (arg) + length (manual_id) + 1 > 64
		     then do;
			     call complain (error_table_$bad_arg, myname,
				"^/The manual identifier ""^a ^a"" exceeds the 64 character limit.", manual_id,
				arg);
			     return;
			end;
		     else if manual_id = ""
		     then manual_id = ltrim (rtrim (arg));
		     else manual_id = manual_id || " " || ltrim (rtrim (arg));
		     accept_control_argument = "1"b;	/* Next arg may be a control argument */
		     control_argument_idx = 1;	/* But next arg may also be more of manual_id */
		     goto NEXT_1;

ARG (2):						/* output file pathname */
		     call absolute_pathname_ (arg, output_file_path, code);
		     if code ^= 0
		     then do;
			     call complain (code, myname, "Output file pathname argument ^a.", arg);
			     return;
			end;

		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_1;

ARG (4):						/* database pathname */
		     call absolute_pathname_$add_suffix (arg, "db", mrds_database_path, code);
		     if code ^= 0
		     then do;
			     call complain (code, myname, "Data base pathname argument ^a.", arg);
			     return;
			end;

		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_1;

NEXT_1:
		end;
	     else if ^accept_control_argument
	     then do;

		/*** A control argument was specified, but the command was not expecting
		     a control argument at this point. It was expecting the argument
		     associated with control_argument(control_argument_idx), which is
		     described in argument_type (control_argument_idx).
		     It should never be the case that accept_control_argument is off and
		     control_argument_idx is equal to 0. */

		     call complain (error_table_$noarg, myname, "^a must be followed by a^[n^] ^a.",
			control_argument (control_argument_idx),
			(index ("aeiouh", substr (argument_type (control_argument_idx), 1, 1)) > 0),
			argument_type (control_argument_idx));
		     return;
		end;
	     else do;

		/*** The argument is a control argument and it is expected. Find the control
		     argument in the control_argument array. The index into this array identifies
		     the case to process in the following case statement (computed goto). */

		     do control_argument_idx = 2 to hbound (control_argument, 1)
			while (control_argument (control_argument_idx) ^= arg);
		     end;
		     if control_argument_idx > hbound (control_argument, 1)
		     then do;
			     call complain (error_table_$badopt, myname, "^a", arg);
			     return;
			end;

		     goto CONTROL_ARG (control_argument_idx);

		/*** Case of control argument with the index control_argument_idx.  In each
		     case where an argument is expected to follow the control argument,
		     accept_control_argument is turned off so that an error occurs if the
		     next argument is a control argument. If no argument is expected,
		     accept_control_argument is turned on, meaning that control arguments are
		     allowed, and control_argument_idx is set to 0, indicating that there is
		     no control argument expecting an argument. */


CONTROL_ARG (2):
CONTROL_ARG (3):					/* -output_file, -of */
		     output_file_sw = "1"b;
		     accept_control_argument = "0"b;
		     control_argument_idx = 2;
		     goto NEXT_ARG;

CONTROL_ARG (4):
CONTROL_ARG (5):					/* -database_pathname, -dbpn */
		     database_path_sw = "1"b;
		     accept_control_argument = "0"b;
		     control_argument_idx = 4;
		     goto NEXT_ARG;

CONTROL_ARG (6):
CONTROL_ARG (7):					/* -description, -desc */
		     display_info.text.description_flag = "1"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (8):
CONTROL_ARG (9):					/* -audience, -aud */
		     display_info.text.audience_flag = "1"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (10):
CONTROL_ARG (11):					/* -table_of_contents, -toc */
		     display_info.text.table_of_contents_flag = "1"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (12):
CONTROL_ARG (13):					/* -new_features, -nf */
		     display_info.text.new_features_flag = "1"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (14):
CONTROL_ARG (15):					/* "", "" */
		     goto NEXT_ARG;

CONTROL_ARG (16):
CONTROL_ARG (17):					/* -no_request_loop, -nrql */
		     enter_request_loop = "0"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (18):
CONTROL_ARG (19):					/* -request_loop, -rql */
		     enter_request_loop = "1"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (20):
CONTROL_ARG (21):					/* -all, -a */
		     string (display_info) = copy ("1"b, length (string (display_info)));
		     display_info.header.topics_flag = "0"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (22):
CONTROL_ARG (23):					/* -no_description, -nd */
		     display_info.text.description_flag = "0"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (24):
CONTROL_ARG (25):					/* -no_audience, -naud */
		     display_info.text.audience_flag = "0"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (26):
CONTROL_ARG (27):					/* -no_table_of_contents, -ntoc */
		     display_info.text.table_of_contents_flag = "0"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;

CONTROL_ARG (28):
CONTROL_ARG (29):					/* -no_new_features, -nnf */
		     display_info.text.new_features_flag = "0"b;
		     accept_control_argument = "1"b;	/* Next argument may be control argument */
		     control_argument_idx = 0;	/* No non-control argument argument is expected. */
		     goto NEXT_ARG;
NEXT_ARG:
		     ;
		end;
	end ARGUMENT_PROCESSING_LOOP;


	if ^accept_control_argument
	then do;

	     /*** An argument was expected since control_argument_idx is non-zero, and
		the argument was not optional, since accept_control_argument is off. */

		call complain (error_table_$noarg, myname, "^a must be followed by a^[n^] ^a.",
		     control_argument (control_argument_idx),
		     (index ("aeiouh", substr (argument_type (control_argument_idx), 1, 1)) > 0),
		     argument_type (control_argument_idx));
		return;
	     end;

	if output_file_sw
	then enter_request_loop = "0"b;

/**** End of argument processing.  Execute the command. */

	on cleanup call cleanup_all;

     /*** Prepare to access the online_doc data base by setting MRDS scope and/or
	opening the data base. */

	call online_doc_db_index$return_index (current_mrds_dbi);

	if database_path_sw
	then mrds_dbi = 0;				/* To guarantee a new opening. */
	else mrds_dbi = current_mrds_dbi;		/* Use existing opening if there is one. */

	if mrds_dbi = 0
	then do;

	     /*** The online_doc data base has not been opened yet in this process. Open it. */

		call open_data_base (mrds_database_path, mrds_dbi, code);
		if code ^= 0
		then call cleanup_and_abort (code,
			"^/^10xThe data base is temporarily out of service.  Try again shortly.^/^10xIf this problem persists, see your administrator.^s"
			, "");
	     end;

     /*** Set the MRDS scope to allow this opening to read and to prevent nothing */

	call dsl_$set_scope_all (mrds_dbi, 1, 0, 30, code);
	if code ^= 0
	then if code = mrds_error_$invalid_db_index
	     then do;

		/*** The index held by online_doc_db_index is incorrect. Reset it to zero and
		     re-open the data base. */

		     call online_doc_db_index$set_index (0);
		     call open_data_base (mrds_database_path, mrds_dbi, code);
		     if code ^= 0
		     then call cleanup_and_abort (code,
			     "^/^10xThe data base is temporarily out of service.  Try again shortly.^/^10xIf this problem persists, see your administrator.^s"
			     , "");
		     call dsl_$set_scope_all (mrds_dbi, 1, 0, 30, code);
		end;

	if code ^= 0
	then call cleanup_and_abort (code,
		"^/^10xThe data base is temporarily out of service.  Try again shortly.^/^10xIf this problem persists, see your administrator.^s"
		, "");
	mrds_scope_set = "1"b;
%page;
     /*** Set up query_info structure for later use in find_manual_number and nonmenu. */

	query_info.version = query_info_version_4;
	query_info.switches.yes_or_no_sw = "0"b;
	query_info.switches.suppress_name_sw = "1"b;
	query_info.switches.cp_escape_control = "11"b;
	query_info.switches.suppress_spacing = "0"b;
	query_info.switches.padding = "0"b;
	query_info.status_code = 0;
	query_info.query_code = 0;
	query_info.question_iocbp = null ();
	query_info.answer_iocbp = null ();
	query_info.repeat_time = 0;

     /*** Find the identifying manual_number of the manual specified by the caller.  */

	call find_manual_number (manual_id, display_all_manuals, manual_number_found, manual_number);

	code = 0;

	if display_all_manuals
	then do;

	     /*** Retrieve the identifying manual number of all manuals. */

		manual_number_found = "1"b;

		call dsl_$retrieve (mrds_dbi, "-range (x full_name_rel) -select x.manual_number", manual_number, code)
		     ;
		if code ^= 0
		then call cleanup_and_abort (error_table_$noentry,
			"^/No information was found about any manuals in the data base ^a.", mrds_database_path);

		number_of_manuals = 0;
		do while (code = 0 & number_of_manuals < hbound (manual_array, 1));

		     number_of_manuals = number_of_manuals + 1;
		     manual_array (number_of_manuals) = manual_number;

		     call dsl_$retrieve (mrds_dbi, "-another", manual_number, code);
		     if code ^= 0 & code ^= mrds_error_$tuple_not_found
		     then call cleanup_and_abort (code, "^/Could not retrieve information about all of the manuals.",
			     "");

		     code = 0;
		end;
	     end;

	if ^manual_number_found
	then call cleanup_and_abort (error_table_$noentry, "^/No manual information for ""^a""", rtrim (manual_id));

	if output_file_sw
	then do;

	     /*** Output should be directed to output_file_path. */

		output_switch_name = "online_doc_output" || unique_chars_ ("0"b);
		call iox_$attach_name (output_switch_name, output_ptr, ("vfile_ " || output_file_path || " -extend"),
		     null, code);
		if code ^= 0
		then call cleanup_and_abort (code, "^/Output could not be directed to ^a.", (output_file_path));
		call iox_$open (output_ptr, Stream_output, "0"b, code);
		if code ^= 0
		then call cleanup_and_abort (code, "^/Output could not be directed to ^a.", (output_file_path));
	     end;
	else output_ptr = iox_$user_output;

	quit_signalled = "0"b;

PRINT_AND_PROMPT_LOOP:
	do while (^quit_signalled);

	/*** Display information about selected manuals */

	     if string (display_info) ^= "0"b		/* Have something to print */
	     then if ^display_all_manuals
		then call display_doc (output_ptr, mrds_dbi, manual_number, display_info_ptr, "", code);
		else do idx = 1 to number_of_manuals;

			manual_number = manual_array (idx);
			call display_doc (output_ptr, mrds_dbi, manual_number, display_info_ptr, "", code);
		     end;

	     if enter_request_loop
	     then do;

		/*** Caller wants to be prompted for more information. Display prompt and
		     get caller's reply. */

		     call command_query_ (addr (query_info), reply, myname, "More information?");
		     string (display_info) = "0"b;	/* Assume nothing */
		     completely_processed_reply = "0"b;
		end;
	     else completely_processed_reply, quit_signalled = "1"b;
						/* Avoid processing of reply as there is none and exit prompt loop. */

PROCESS_REPLY_TO_PROMPT_LOOP:
	     do while (^completely_processed_reply);

	     /*** Process each request in the reply, where requests are delimited by " ". */

		reply = ltrim (reply);

		if index (reply, " ") = 0
		then do;
			request = reply;
			reply = "";
		     end;
		else do;
			request = before (reply, " ");
			reply = ltrim (after (reply, " "));
		     end;

		do request_idx = 0 to hbound (acceptable_requests, 1)
		     while (acceptable_requests (request_idx) ^= request);
		end;

		goto REQUEST (request_idx);

	     /*** Go to the case which handles the caller's request. */

REQUEST (0):					/* "" */
		completely_processed_reply = "1"b;
		goto NEXT_REQUEST;
REQUEST (1):					/* ? */
REQUEST (2):					/* yes */
REQUEST (3):					/* y */
		if request_idx = QUESTION_MARK_REQUEST_IDX
		then do;
			start_idx = FIRST_REQUEST_IDX;
			call ioa_ ("^/The following requests are acceptable:");
		     end;
		else do;
			start_idx = FIRST_SECTION_NAME_IDX;
			call ioa_ ("^/The following sections can be displayed:");
		     end;

		do accept_idx = start_idx by 2 to hbound (acceptable_requests, 1);
		     call ioa_ ("^7x^a^[,^35t^a,^;^s^]", acceptable_requests (accept_idx),
			(accept_idx < hbound (acceptable_requests, 1)),
			acceptable_requests (min (accept_idx + 1, hbound (acceptable_requests, 1))));
		end;

		if request_idx = QUESTION_MARK_REQUEST_IDX
		then completely_processed_reply = "1"b;
		else do;
			call command_query_ (addr (query_info), reply, myname,
			     "Which section(s) do you wish to see?");
			string (display_info) = "0"b;
			completely_processed_reply = "0"b;
		     end;
		goto NEXT_REQUEST;
REQUEST (4):
REQUEST (5):
REQUEST (6):
REQUEST (7):					/* no, n, quit, q */
		completely_processed_reply, quit_signalled = "1"b;
		goto NEXT_REQUEST;
REQUEST (8):
REQUEST (9):					/* description, desc */
		display_info.text.description_flag = "1"b;
		goto NEXT_REQUEST;
REQUEST (10):
REQUEST (11):					/* audience,  */
		display_info.text.audience_flag = "1"b;
		goto NEXT_REQUEST;
REQUEST (12):
REQUEST (13):					/* table_of_contents, toc */
		display_info.text.table_of_contents_flag = "1"b;
		goto NEXT_REQUEST;
REQUEST (14):
REQUEST (15):					/* new_features,  */
		display_info.text.new_features_flag = "1"b;
		goto NEXT_REQUEST;
REQUEST (16):					/* all */
		string (display_info.text) = copy ("1"b, length (string (display_info.text)));
		goto NEXT_REQUEST;
REQUEST (17):					/* invalid response */
		call ioa_ ("""^a"" is not a valid response. Type ? for a list of valid responses.", rtrim (request));
		completely_processed_reply = "1"b;
		string (display_info) = "0"b;		/* In case some flags were set because of this reply. */
		goto NEXT_REQUEST;

NEXT_REQUEST:
	     end PROCESS_REPLY_TO_PROMPT_LOOP;
	end PRINT_AND_PROMPT_LOOP;

	if code ^= 0
	then call complain (code, myname);

	call clean_up;

MAIN_RETURN:
	return;

/* cleanup procedures */


cleanup_and_abort:
     proc (cab_code, cab_err_msg, cab_err_msg_arg);

	dcl     cab_code		 fixed bin (35);
	dcl     cab_err_msg		 char (*) var;
	dcl     cab_err_msg_arg	 char (*);

	if use_menu
	then call cleanup_screen;
	call clean_up;
	call complain (cab_code, myname, cab_err_msg, cab_err_msg_arg);
	goto MAIN_RETURN;

     end cleanup_and_abort;

cleanup_all:
     proc;

	call cleanup_screen;
	call clean_up;

     end cleanup_all;

clean_up:
     proc;

	dcl     cu_code		 fixed bin (35) init (0);

	if output_ptr ^= null & output_file_sw
	then do;
		call iox_$close (output_ptr, (cu_code));
		call iox_$detach_iocb (output_ptr, (cu_code));
	     end;

	if mrds_scope_set
	then call dsl_$dl_scope_all (mrds_dbi, (cu_code));
	if current_mrds_dbi ^= 0 & current_mrds_dbi ^= mrds_dbi
	then call dsl_$close (current_mrds_dbi, (cu_code));
	if work_area_ptr ^= null
	then call release_area_ (work_area_ptr);

     end clean_up;

cleanup_screen:
     proc;

	if use_menu
	then call window_$clear_window (iox_$user_io, (0));


     end cleanup_screen;
%page;
find_manual_number:
     proc (fmn_manual_id, fmn_display_all_manuals, fmn_manual_number_found, fmn_manual_number);

	dcl     fmn_manual_id	 char (*) varying;
	dcl     fmn_display_all_manuals
				 bit (1) aligned;
	dcl     fmn_manual_number_found
				 bit (1) aligned;
	dcl     fmn_manual_number	 fixed bin;

	dcl     (manual_name, manual_id_string)
				 char (64) varying;
	dcl     headers		 (2) char (70) var;
	dcl     trailers		 (2) char (50) var;
	dcl     order_number	 char (4);

	dcl     (fits_order_number_pattern, fkey)
				 bit (1) aligned;

	dcl     choice		 fixed bin;
	dcl     group_name_idx	 fixed bin;
	dcl     manual_number	 fixed bin;

	dcl     menu_ptr		 ptr;

	dcl     (
	        LOWER_CASE_ALPHA	 char (26) init ("abcdefghijklmnopqrstuvwxyz"),
	        UPPER_CASE_ALPHA	 char (26) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"),
	        NUMERIC		 char (10) init ("0123456789"),
	        GROUP_PROMPT	 char (80) var
				 init ("Select from the list by typing the associated number and RETURN:")
	        )			 internal static options (constant);


	dcl     1 local_area_info	 aligned like area_info;
	dcl     1 local_menu_format	 like menu_format;
	dcl     1 local_menu_requirements
				 like menu_requirements;


	unspec (local_area_info) = "0"b;
	local_area_info.version = 1;
	local_area_info.control.extend = "1"b;
	local_area_info.owner = myname;
	local_area_info.size = sys_info$max_seg_size;
	local_area_info.areap = null;

	call define_area_ (addr (local_area_info), code);
	if code ^= 0
	then call cleanup_and_abort (code, "Cannot define area.", "");

	work_area_ptr = local_area_info.areap;

	fmn_display_all_manuals = "0"b;
	fmn_manual_number_found = "0"b;
	fmn_manual_number = 0;
	manual_id_string = translate (fmn_manual_id, LOWER_CASE_ALPHA, UPPER_CASE_ALPHA);

	if manual_id_string = "*"
	then do;
		fmn_display_all_manuals = "1"b;
		return;
	     end;


	if length (manual_id_string) >= 4 & length (manual_id_string) <= 8
	then do;

	     /*** This may be an order number.  See if manual_id_string fits the order number
		pattern, AA99{xxx}, and search for the manual with that order number if it
		fits the pattern. */

		fits_order_number_pattern = "1"b;
		if verify (substr (manual_id_string, 1, 2), LOWER_CASE_ALPHA) ^= 0
		then fits_order_number_pattern = "0"b;
		if verify (substr (manual_id_string, 3, 2), NUMERIC) ^= 0
		then fits_order_number_pattern = "0"b;

		if fits_order_number_pattern
		then do;
			order_number =
			     translate (substr (manual_id_string, 1, 4), UPPER_CASE_ALPHA, LOWER_CASE_ALPHA);
			call dsl_$retrieve (mrds_dbi,
			     "-range (x full_name_rel) -select x.manual_number -where x.order_number = .V.",
			     order_number, manual_number, code);
			if code = 0
			then fmn_manual_number_found = "1"b;
			else if code ^= mrds_error_$tuple_not_found
			then call cleanup_and_abort (code,
				"^/This unexpected error occurred while searching for order ^/number ^a.",
				order_number);
			code = 0;
		     end;
	     end;

	if ^fmn_manual_number_found
	then do;

	     /*** No manual was found when manual_id_string was interpreted as an order number.
		Try again using manual_id_string as a manual name. */

		manual_name = canonicalize_name (manual_id_string);
		call dsl_$retrieve (mrds_dbi, "-range (x name_rel) -select x.manual_number -where x.name = .V.",
		     manual_name, manual_number, code);
		if code = 0
		then fmn_manual_number_found = "1"b;
		else if code ^= mrds_error_$tuple_not_found
		then call cleanup_and_abort (code,
			"^/This unexpected error occurred while searching for manual name ""^a"".", (manual_name));
		code = 0;
	     end;

	if ^fmn_manual_number_found
	then do;

	     /*** No manual found with supplied name either. See if the supplied name
		identifies one of a set of common groups of manuals, as defined in group_name. */

		do group_name_idx = 1 to hbound (group_name, 1)
		     while (index (manual_name, group_name (group_name_idx)) = 0);
		end;
		if group_name_idx > hbound (group_name, 1)
		then call cleanup_and_abort (error_table_$noentry,
			"^/No manual with an order number or name corresponding^/to ""^a"" was found.",
			rtrim (manual_id_string));


		goto GROUP (group_name_idx);

	     /*** The manual_id_string specified does not match a manual name, but is one of a set
		of very commonly used terms.  Some of these terms refer to groups of manuals,
		such as the Multics Programming Manuals (MPM) or Multics Administrator's
		Manuals (MAM), or is the name of a product whose name does not match the
		name of the manual in which it is described, such as MRDS, LINUS or WORDPRO.
		For each case which deals with a group of manuals, allocate a structure
		which contains a choices array with all of the manual names.  The structures
		are declared with initial attributes in online_doc_groups.incl.pl1.  The
		choices array will be used to set up a menu or to print the choices.
		Those that deal with a single manual only just retrievpFor those that deals with a single manual only,
		just get the manual_number of the manual. */

GROUP (1):					/* mpm */
		alloc mpm_choices in (work_area);
		number_of_choices = mpm_choices.number_of_choices;
		choices_ptr = addr (mpm_choices.choices (1));
		goto END_GROUP_CASE;

GROUP (2):					/* mam */
		alloc mam_choices in (work_area);
		number_of_choices = mam_choices.number_of_choices;
		choices_ptr = addr (mam_choices.choices (1));
		goto END_GROUP_CASE;

GROUP (3):					/* i/o */
		alloc io_choices in (work_area);
		number_of_choices = io_choices.number_of_choices;
		choices_ptr = addr (io_choices.choices (1));
		goto END_GROUP_CASE;

GROUP (4):					/* cobol */
		alloc cobol_choices in (work_area);
		number_of_choices = cobol_choices.number_of_choices;
		choices_ptr = addr (cobol_choices.choices (1));
		goto END_GROUP_CASE;

GROUP (5):					/* wordpro */
		alloc wordpro_choices in (work_area);
		number_of_choices = wordpro_choices.number_of_choices;
		choices_ptr = addr (wordpro_choices.choices (1));
		goto END_GROUP_CASE;

GROUP (6):					/* emacs */
		alloc emacs_choices in (work_area);
		number_of_choices = emacs_choices.number_of_choices;
		choices_ptr = addr (emacs_choices.choices (1));
		goto END_GROUP_CASE;


GROUP (7):					/* sdn */
		alloc sdn_choices in (work_area);
		number_of_choices = sdn_choices.number_of_choices;
		choices_ptr = addr (sdn_choices.choices (1));
		goto END_GROUP_CASE;


GROUP (8):					/* plm */
		alloc plm_choices in (work_area);
		number_of_choices = plm_choices.number_of_choices;
		choices_ptr = addr (plm_choices.choices (1));
		goto END_GROUP_CASE;


GROUP (9):					/* xmail */
		alloc xmail_choices in (work_area);
		number_of_choices = xmail_choices.number_of_choices;
		choices_ptr = addr (xmail_choices.choices (1));
		goto END_GROUP_CASE;

GROUP (10):					/* pl1 */
		alloc pl1_choices in (work_area);
		number_of_choices = pl1_choices.number_of_choices;
		choices_ptr = addr (pl1_choices.choices (1));
		goto END_GROUP_CASE;


GROUP (11):					/* fortran */
		alloc fortran_choices in (work_area);
		number_of_choices = fortran_choices.number_of_choices;
		choices_ptr = addr (fortran_choices.choices (1));
		goto END_GROUP_CASE;


GROUP (12):					/* new_user */
		alloc new_user_choices in (work_area);
		number_of_choices = new_user_choices.number_of_choices;
		choices_ptr = addr (new_user_choices.choices (1));
		goto END_GROUP_CASE;


GROUP (13):					/* mrds */
		call dsl_$retrieve (mrds_dbi,
		     "-range (x full_name_rel) -select x.manual_number -where x.order_number = .V.", "AW53",
		     manual_number, code);
		if code = 0
		then fmn_manual_number_found = "1"b;
		else call cleanup_and_abort (code,
			"^/This programming error occurred while searching for^/the manual with order number ^a.",
			"AW53");
		goto END_GROUP_CASE;

GROUP (14):					/* linus */
		call dsl_$retrieve (mrds_dbi,
		     "-range (x full_name_rel) -select x.manual_number -where x.order_number = .V.", "AZ49",
		     manual_number, code);
		if code = 0
		then fmn_manual_number_found = "1"b;
		else call cleanup_and_abort (code,
			"^/This programming error occurred while searching for^/the manual with order number ^a.",
			"AZ49");
		goto END_GROUP_CASE;

GROUP (15):					/* mrpg */
		call dsl_$retrieve (mrds_dbi,
		     "-range (x full_name_rel) -select x.manual_number -where x.order_number = .V.", "CC69",
		     manual_number, code);
		if code = 0
		then fmn_manual_number_found = "1"b;
		else call cleanup_and_abort (code,
			"^/This programming error occurred while searching for^/the manual with order number ^a.",
			"CC69");
		goto END_GROUP_CASE;
	     end;

END_GROUP_CASE:
	if ^fmn_manual_number_found
	then do;

	     /*** No manual has been selected yet.  Give user a choice of which manual
		to see. */

		headers (1) = "The manual may refer to any of the following.";
		headers (2) = "On which manual do you wish to see information?";
		trailers (1) = "-";
		trailers (2) = "Type the associated number to select a manual.";

		if video_is_on
		then call setup_menu (use_menu);

		if use_menu
		then call menu ();			/* Select with a menu. */
		else call nonmenu ();		/* Select without a menu */
	     end;


	if fmn_manual_number_found
	then fmn_manual_number = manual_number;

	return;
%page;
/* **** Subroutines of find_manual_number, setup_menu, menu and nonmenu. */

setup_menu:
     proc (sm_use_menu);

	dcl     sm_use_menu		 bit (1) aligned;
	dcl     sm_code		 fixed bin (35);

	sm_code = 0;
	sm_use_menu = "0"b;

	user_io_window_info.version = window_position_info_version_1;
	call iox_$control (iox_$user_io, "get_window_info", addr (user_io_window_info), sm_code);
	if sm_code ^= 0
	then call sm_cleanup_and_return;

	call window_$clear_window (iox_$user_io, sm_code);
	if sm_code ^= 0
	then call sm_cleanup_and_return;

	local_menu_format.version = menu_format_version_1;
	local_menu_format.max_width = user_io_window_info.width;

	local_menu_format.n_columns = 1;
	local_menu_format.center_headers = "1"b;
	local_menu_format.center_trailers = "1"b;
	local_menu_format.pad = "0"b;
	local_menu_format.pad_char = "-";

	local_menu_requirements.version = menu_requirements_version_1;
	local_menu_format.max_height = hbound (choices, 1) + 5;

	if local_menu_format.max_height > user_io_window_info.extent.height
	then call sm_cleanup_and_return;

	call menu_$create (choices, headers, trailers, addr (local_menu_format), MENU_OPTION_KEYS, work_area_ptr,
	     addr (local_menu_requirements), menu_ptr, code);
	if code ^= 0
	then call sm_cleanup_and_return;

	call menu_$display (iox_$user_io, menu_ptr, sm_code);
	if code ^= 0
	then call sm_cleanup_and_return;

	sm_use_menu = "1"b;

SM_RETURN:
	return;

sm_cleanup_and_return:
     proc;

	call cleanup_screen;
	goto SM_RETURN;

     end sm_cleanup_and_return;

     end setup_menu;
%page;
menu:
     proc ();

/**** The menu subroutine displays a menu of manuals and returns the
      user's choice to find_manual_number by setting the value of manual_number.
      The menu must already be created and formatted. */

	dcl     got_choice		 bit (1) aligned;

	got_choice = "0"b;

	do while (^got_choice);

	     call menu_$get_choice (iox_$user_io, menu_ptr, null, fkey, choice, code);
	     if code ^= 0
	     then call cleanup_and_abort (code, "Unable to get menu choice.", "");

	     if fkey
	     then call window_$bell (iox_$user_io, 0);
	     else if choice = hbound (choices, 1)
	     then got_choice = "1"b;			/* None.  Exit. */
	     else if choice < hbound (choices, 1)
	     then do;

		/*** A valid choice was made. Get the manual number of the selected manual. */

		     got_choice = "1"b;
		     manual_name = canonicalize_name ((choices (choice)));

		     call dsl_$retrieve (mrds_dbi, "-range (x name_rel) -select x.manual_number -where x.name = .V.",
			manual_name, manual_number, code);
		     if code = 0
		     then fmn_manual_number_found = "1"b;
		     else if code = mrds_error_$tuple_not_found
		     then call cleanup_and_abort (code,
			     "^/The data base does not contain a complete selection of^/manuals. The ""^a"" manual is missing."
			     , (choices (choice)));
		     else call cleanup_and_abort (code, "^/This error occurred attempting to find the ""^a"" manual.",
			     (choices (choice)));

		     call window_$clear_window (iox_$user_io, code);
		     if code ^= 0
		     then call cleanup_and_abort (code, "Unable to clear window.", "");

		end;
	     else call window_$bell (iox_$user_io, 0);
	end;

	return;

     end menu;
%page;
nonmenu:
     proc ();

     /*** Display a list of manual names, as in a menu, and prompt the user for
	a choice. */

	dcl     got_choice		 bit (1) aligned;
	dcl     (choice, choice_idx)	 fixed bin;
	dcl     choice_string	 char (32) varying;


	display_info.display_leading_blank_line = "1"b;

	call ioa_ ("^/^5x^a^/", headers (1));

	do choice_idx = 1 to hbound (choices, 1);
	     call ioa_ ("^2x(^d) ^a", choice_idx, choices (choice_idx));
	end;

	got_choice = "0"b;
	do while (^got_choice);
	     call command_query_ (addr (query_info), choice_string, "", GROUP_PROMPT);
	     choice = cv_dec_check_ ((choice_string), code);
	     if code ^= 0
	     then call complain (code, myname, "^/You must reply with an integer number between 1 and ^d, inclusive.",
		     hbound (choices, 1));
	     else if choice < 1 | choice > hbound (choices, 1)
	     then call complain (code, myname, "^/You must reply with an integer number.", hbound (choices, 1));
	     else got_choice = "1"b;
	end;

	if choice ^= hbound (choices, 1)
	then do;
		manual_name = canonicalize_name ((choices (choice)));

		call dsl_$retrieve (mrds_dbi, "-range (x name_rel) -select x.manual_number -where x.name = .V.",
		     manual_name, manual_number, code);
		if code = 0
		then fmn_manual_number_found = "1"b;
		else if code = mrds_error_$tuple_not_found
		then call cleanup_and_abort (code,
			"^/The data base does not contain a complete selection of^/manuals. The ""^a"" manual is missing."
			, (choices (choice)));
		else call cleanup_and_abort (code, "^/This error occurred attempting to find the ""^a"" manual.",
			(choices (choice)));
	     end;

     end nonmenu;

     end find_manual_number;
%page;
open_data_base:
     proc (odb_mrds_database_path, odb_mrds_dbi, odb_code);

	dcl     odb_mrds_database_path char (*);
	dcl     odb_mrds_dbi	 fixed bin (35);
	dcl     odb_code		 fixed bin (35);

	call dsl_$open (odb_mrds_database_path, odb_mrds_dbi, 1, odb_code);
	if odb_code = 0
	then call online_doc_db_index$set_index (odb_mrds_dbi);

	return;

     end open_data_base;

canonicalize_name:
     proc (cn_input_string) returns (char (64) var);

	dcl     cn_input_string	 char (64) var;
	dcl     cn_canonical_name	 char (64) var;
	dcl     cn_string		 char (64) var;
	dcl     cn_temp_string	 char (64) var;

	cn_string = cn_input_string;

	cn_string = translate (cn_string, "__", "- ");
	do while (index (cn_string, "__") ^= 0);
	     cn_temp_string = after (cn_string, "__");
	     cn_string = before (cn_string, "__") || "_" || cn_temp_string;
	end;

	cn_canonical_name = translate (cn_string, LOWER_CASE_ALPHA, UPPER_CASE_ALPHA);

	return (cn_canonical_name);

     end canonicalize_name;
%page;
%include online_doc_groups;
%page;
%include query_info;
%page;
%include window_control_info;
%page;
%include display_doc_info;
%page;
%include iox_dcls;
%page;
%include iox_modes;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include area_info;

     end explain_doc;




		    online_doc_db_index.pl1         10/10/83  1325.9rew 10/10/83  1306.0        5841



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
od_idx:
online_doc_db_index:
     proc;

	dcl     online_doc_db_index	 fixed bin (35) int static init (0);

	dcl     p_index		 fixed bin (35);

set_index:
     entry (p_index);

	online_doc_db_index = p_index;

	return;

return_index:
     entry (p_index);

	p_index = online_doc_db_index;

	return;

     end online_doc_db_index;




		    tut_bottom_.pl1                 09/13/88  1329.2r w 09/13/88  1315.0       39069



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

/* Written by J. Siwila 3/30/83 */

/* This procedure clears a six line window at the bottom of the Tutorial and then
   accepts a glossary query and prints the glossary entry. */

tut_bottom_:
     proc (true_io_window_info, io_height, menu_height, Phelp_args, code);

/* Automatic */

	dcl     io_height		 fixed bin;
	dcl     line		 char (40);
	dcl     menu_height		 fixed bin;
	dcl     1 bottom_io_window_info
				 like window_position_info;
	dcl     1 true_io_window_info	 like window_position_info;
	dcl     bottom_io_switch_name	 char (32);
	dcl     code		 fixed bin (35);
	dcl     ME_BOTTOM		 char (11) init ("tut_bottom_");
	dcl     n_read		 fixed bin (21);
	dcl     seg_name		 char (11) init ("prompt_line");
	dcl     trim_line		 char (40) var;

	dcl     LOWER_CASE		 char (26) int static options (constant) init ("abcdefghijklmnopqrstuvwxyz");
	dcl     UPPER_CASE		 char (26) int static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
	dcl     progress		 fixed bin;
	dcl     NL		 char (1) int static options (constant) init ("
");

/* Builtin */

	dcl     (addr, divide, substr, length, translate)
				 builtin;

/* Entries */


	dcl     ioa_$ioa_switch	 entry options (variable);
	dcl     ioa_$ioa_switch_nnl	 entry options (variable);
	dcl     tut_quit_		 entry () options (variable);


	bottom_io_window_info = window_position_info_version_1;
	call iox_$control (iox_$user_io, "get_window_info", addr (bottom_io_window_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_BOTTOM, "Can't get window info.", iox_$user_io, bottom_io_window_info);
		return;
	     end;
	bottom_io_window_info.height = 7;
	bottom_io_window_info.width = true_io_window_info.extent.width;

	bottom_io_window_info.line = io_height + menu_height - 6;

	call iox_$control (iox_$user_io, "set_window_info", addr (bottom_io_window_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (0, ME_BOTTOM, "Unable to set user i/o window info.", iox_$user_io,
		     bottom_io_window_info);
		return;
	     end;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (0, ME_BOTTOM, "Unable to clear bottom window.", iox_$user_io, bottom_io_window_info);
		return;
	     end;

	call ioa_$ioa_switch (iox_$user_io, "^v(-^)^/", bottom_io_window_info.width);
	call ioa_$ioa_switch_nnl (iox_$user_io, "^7( ^)Term to be explained:  ");
	call iox_$get_line (iox_$user_io, addr (line), length (line), n_read, code);

	trim_line = substr (line, 1, (n_read - 1));
	trim_line = translate (trim_line, "_", " ");
	trim_line = translate (trim_line, LOWER_CASE, UPPER_CASE);

	help_args.info_name = trim_line;

	call window_$position_cursor (iox_$user_io, 2, 1, code);

	if code ^= 0
	then do;
		call tut_quit_ (code, ME_BOTTOM, "Unable to move io switch.", iox_$user_io, bottom_io_window_info);
		return;
	     end;

	call help_ (ME_BOTTOM, Phelp_args, "gi.info", progress, code);
	if code ^= 0
	then if progress = 1
	     then call ioa_$ioa_switch (iox_$user_io, "Unable to get help at this time.");
	     else if progress = 2
	     then call ioa_$ioa_switch (iox_$user_io, "Cannot find term you asked for: ^a", trim_line);
	     else if progress = 3
	     then call ioa_$ioa_switch (iox_$user_io, "Cannot find term you asked for: ^a", trim_line);
	     else if progress = 4
	     then call ioa_$ioa_switch (iox_$user_io, "Cannot find term you asked for: ^a", trim_line);
	     else if progress = 5
	     then call ioa_$ioa_switch (iox_$user_io, "Cannot find term you asked for: ^a", trim_line);
	     else call ioa_$ioa_switch (iox_$user_io, "Cannot find term you asked for: ^a", trim_line);




	call iox_$control (iox_$user_io, "set_window_info", addr (true_io_window_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (0, ME_BOTTOM, "Unable to reset user i/o window.", iox_$user_io, true_io_window_info);
		return;
	     end;

	return;

%include iox_dcls;
%page;
%include help_args_;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_bottom_;




		    tut_get_seg_.pl1                11/01/84  1435.9r w 11/01/84  1303.8       25515



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure prints segments containing Tutorial information. */

/* Changed 3/30/84 by J. Siwila:  add condition handler for sub_error_ and check for error_table_$recoverable_error. */

/* format: style2 */
tut_get_seg_:
     proc (seg_name, menu_io, user_io_window_info, code);

/* Automatic */

	dcl     code		 fixed bin (35);
          dcl     error_table_$recoverable_error fixed bin (35) external;
	dcl     menu_io		 ptr;
	dcl     ME_SEG_NAME		 char (14) init ("tut_get_seg_");
	dcl     seg_name		 char (*);
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     1 local_fdoc_options	 like format_document_options;

/* Builtin */

	dcl     addr		 builtin;
          dcl     sub_error_             condition;

/* Entries */

	dcl     format_document_$switch
				 entry (char (*), char (*), ptr, ptr, fixed bin (35));
	dcl     tut_quit_		 entry () options (variable);
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));

/* Static */

	dcl     iox_$user_output	 ptr external static;

	format_document_options_ptr = addr (local_fdoc_options);
	local_fdoc_options.version_number = format_document_version_2;
	local_fdoc_options.indentation = 0;
	local_fdoc_options.line_length = user_io_window_info.extent.width;
	local_fdoc_options.pgno_sw = "0"b;
	local_fdoc_options.adj_sw = "0"b;
	local_fdoc_options.galley_sw = "1"b;
	local_fdoc_options.error_sw = "0"b;
	local_fdoc_options.literal_sw = "0"b;
	local_fdoc_options.dont_compress_sw = "1"b;
	local_fdoc_options.break_word_sw = "1"b;
	local_fdoc_options.max_line_length_sw = "1"b;
	local_fdoc_options.dont_break_indented_lines_sw = "1"b;
	local_fdoc_options.sub_err_sw = "1"b;
	local_fdoc_options.dont_fill_sw = "0"b;
	local_fdoc_options.hyphenation_sw = "1"b;
	local_fdoc_options.mbz = "0"b;
	local_fdoc_options.syllable_size = 2;

	on condition (sub_error_) code = 0;

	call window_$clear_window (iox_$user_output, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_SEG_NAME, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	call format_document_$switch (">doc>facilities_data_dir", seg_name, iox_$user_output,
	     format_document_options_ptr, code);
	if code ^= 0
	then 
	     if code = error_table_$recoverable_error 
	     then code = 0;
	     else call tut_quit_ (code, ME_SEG_NAME, "Unable to print option.", menu_io, user_io_window_info);

	return;

%page;
%include window_control_info;
%page;
%include format_document_options;

     end tut_get_seg_;




		    tut_getting_help_.pl1           09/13/88  1329.2r w 09/13/88  1315.0       65889



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */


/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      the help system. */

/* format: style2 */
tut_getting_help_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (5) char (30) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (18) init ("tut_getting_help_0");
	dcl     seg_name_1		 char (15) init ("tut_help_topics");
	dcl     seg_name_2		 char (17) init ("tut_help_commands");
	dcl     seg_name_3		 char (20) init ("tut_help_subroutines");
	dcl     seg_name_4		 char (13) init ("tut_help_list");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_GET_HELP		 char (17) init ("tut_getting_help_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, empty, addr)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "Help with Multics Topics";
	choices (2) = "Help with Commands";
	choices (3) = "Help with Subroutines";
	choices (4) = "List of Help Available";
	choices (5) = "Return to First Menu";

	headers (1) = "<<<Getting Help>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 6;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_GET_HELP, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_GET_HELP, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_GET_HELP, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 1;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call topics ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call commands ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call subroutines ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     call list_help ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 5
		     then do;
			     last1 = 1;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

topics:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end topics;

commands:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end commands;

subroutines:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end subroutines;

list_help:
     proc ();

	call tut_get_seg_ (seg_name_4, menu_io, user_io_window_info, code);
	return;

     end list_help;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_GET_HELP, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_GET_HELP, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_GET_HELP, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_getting_help_;




		    tut_giving_commands_.pl1        09/13/88  1329.2r w 09/13/88  1315.0       80928



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      commands. */

/* format: style2 */
tut_giving_commands_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (10) char (30) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (21) init ("tut_giving_commands_0");
	dcl     seg_name_1		 char (16) init ("tut_command_line");
	dcl     seg_name_2		 char (13) init ("tut_pathnames");
	dcl     seg_name_3		 char (21) init ("tut_control_arguments");
	dcl     seg_name_4		 char (21) init ("tut_multiple_commands");
	dcl     seg_name_5		 char (12) init ("tut_sh_names");
	dcl     seg_name_6		 char (17) init ("tut_abbreviations");
	dcl     seg_name_7		 char (11) init ("tut_erasing");
	dcl     seg_name_8		 char (16) init ("tut_interrupting");
	dcl     seg_name_9		 char (14) init ("tut_error_msgs");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_COMMANDS		 char (20) init ("tut_giving_commands_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, empty, addr)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "A Command Line";
	choices (2) = "Pathnames";
	choices (3) = "Control Arguments";
	choices (4) = "Multiple Commands";
	choices (5) = "Short Names";
	choices (6) = "Abbreviations";
	choices (7) = "Changing the Command Line";
	choices (8) = "Interrupting Commands";
	choices (9) = "Error Messages";
	choices (10) = "Return to First Menu";

	headers (1) = "<<<Giving Commands>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 8;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_COMMANDS, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_COMMANDS, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_COMMANDS, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 2;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call command_line ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call pathnames ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call control_args ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     call multiple ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 5
		     then do;
			     call short ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 6
		     then do;
			     call abbrevs ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 7
		     then do;
			     call erasing ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 8
		     then do;
			     call interrupting ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 9
		     then do;
			     call error ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 10
		     then do;
			     last1 = 2;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

command_line:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end command_line;

pathnames:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end pathnames;

control_args:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end control_args;

multiple:
     proc ();

	call tut_get_seg_ (seg_name_4, menu_io, user_io_window_info, code);
	return;

     end multiple;

short:
     proc ();

	call tut_get_seg_ (seg_name_5, menu_io, user_io_window_info, code);
	return;

     end short;

abbrevs:
     proc ();

	call tut_get_seg_ (seg_name_6, menu_io, user_io_window_info, code);
	return;

     end abbrevs;

erasing:
     proc ();

	call tut_get_seg_ (seg_name_7, menu_io, user_io_window_info, code);
	return;

     end erasing;

interrupting:
     proc ();

	call tut_get_seg_ (seg_name_8, menu_io, user_io_window_info, code);
	return;

     end interrupting;

error:
     proc ();

	call tut_get_seg_ (seg_name_9, menu_io, user_io_window_info, code);
	return;

     end error;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_COMMANDS, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_COMMANDS, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_COMMANDS, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_giving_commands_;




		    tut_log_in_.pl1                 09/13/88  1329.2r w 09/13/88  1315.0       65349



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      logging in and out. */

/* format: style2 */
tut_log_in_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (5) char (30) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (16) init ("tut_logging_in_0");
	dcl     seg_name_1		 char (14) init ("tut_logging_in");
	dcl     seg_name_2		 char (15) init ("tut_starting_up");
	dcl     seg_name_3		 char (19) init ("tut_getting_dropped");
	dcl     seg_name_4		 char (15) init ("tut_logging_out");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_LOG_IN		 char (11) init ("tut_log_in_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, empty, addr)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "Logging In";
	choices (2) = "Starting Up";
	choices (3) = "Getting Dropped";
	choices (4) = "Logging Out";
	choices (5) = "Return to First Menu";

	headers (1) = "<<<Logging In and Out>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 6;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_LOG_IN, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_LOG_IN, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_LOG_IN, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 6;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call logging_in ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call start_up ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call dropped ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     call logging_out ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 5
		     then do;
			     last1 = 6;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

logging_in:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end logging_in;

start_up:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end start_up;

dropped:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end dropped;

logging_out:
     proc ();

	call tut_get_seg_ (seg_name_4, menu_io, user_io_window_info, code);
	return;

     end logging_out;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_LOG_IN, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_LOG_IN, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_LOG_IN, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_log_in_;




		    tut_mail_.pl1                   09/13/88  1329.2r w 09/13/88  1315.0       74286



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      the mail system. */

/* format: style2 */
tut_mail_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (8) char (32) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (10) init ("tut_mail_0");
	dcl     seg_name_1		 char (20) init ("tut_sending_messages");
	dcl     seg_name_2		 char (22) init ("tut_accepting_messages");
	dcl     seg_name_3		 char (16) init ("tut_sending_mail");
	dcl     seg_name_4		 char (16) init ("tut_erase_prompt");
	dcl     seg_name_5		 char (13) init ("tut_mailboxes");
	dcl     seg_name_6		 char (16) init ("tut_reading_mail");
	dcl     seg_name_7		 char (15) init ("tut_saving_mail");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_MAIL		 char (9) init ("tut_mail_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, empty, addr)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "Sending Messages";
	choices (2) = "Accepting Messages";
	choices (3) = "Sending Mail";
	choices (4) = "Changing a Response to a Prompt";
	choices (5) = "Mailboxes";
	choices (6) = "Reading Mail";
	choices (7) = "Saving Mail";
	choices (8) = "Return to First Menu";

	headers (1) = "<<<Messages and Mail>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 7;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIL, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIL, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_MAIL, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 4;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call send_msg ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call accept_msg ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call send_mail ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     call change ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 5
		     then do;
			     call mailbox ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 6
		     then do;
			     call read_mail ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 7
		     then do;
			     call save_mail ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 8
		     then do;
			     last1 = 4;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

send_msg:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end send_msg;

accept_msg:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end accept_msg;

send_mail:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end send_mail;

change:
     proc ();

	call tut_get_seg_ (seg_name_4, menu_io, user_io_window_info, code);
	return;

     end change;

mailbox:
     proc ();

	call tut_get_seg_ (seg_name_5, menu_io, user_io_window_info, code);
	return;

     end mailbox;

read_mail:
     proc ();

	call tut_get_seg_ (seg_name_6, menu_io, user_io_window_info, code);
	return;

     end read_mail;

save_mail:
     proc ();

	call tut_get_seg_ (seg_name_7, menu_io, user_io_window_info, code);
	return;

     end save_mail;


tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIL, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIL, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIL, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_mail_;




		    tut_main_menu_.pl1              09/13/88  1329.2r w 09/13/88  1315.0      117864



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila 3/30/83 */

/* Changed 3/30/84 by J. Siwila: zeroed out user_io_window_info in order to
   be sure that stack garbage does not interfere with invocation of 
   tut_main_menu. */

/* This procedure sets up and displays the main menu in the Tutorial. */


/* format: style2 */
tut_main_menu_:
     proc (menu_io, function_key_data_ptr, Phelp_args, pseudo);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (10) char (30) var;
	dcl     code		 fixed bin (35);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     menu_io		 ptr;
	dcl     menu_io_switch_name	 char (32);
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     new_io_height	 fixed bin;
	dcl     1 true_io_window_info	 like window_position_info;
	dcl     seg_name		 char (15) init ("tut_main_menu_0");
	dcl     seg_name_1		 char (16) init ("tut_the_tutorial");
	dcl     seg_name_2		 char (12) init ("tut_glossary");
	dcl     seg_name_3		 char (12) init ("tut_practice");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_MAIN_MENU	 char (14) init ("tut_main_menu_");
	dcl     last		 fixed bin init (0);
	dcl     last1		 fixed bin init (0);
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, addr, empty, unspec)
                                         builtin;
	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_getting_help_	 entry () options (variable);
	dcl     tut_giving_commands_	 entry () options (variable);
	dcl     tut_log_in_		 entry () options (variable);
	dcl     tut_mail_		 entry () options (variable);
	dcl     tut_storing_information_
				 entry () options (variable);
	dcl     tut_wordpro_	 entry () options (variable);
	dcl     tut_writing_text_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_terminate_sys_	 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));
	dcl     tut_bottom_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;
	dcl     video_was_already_on	 bit (1) aligned external;

/* Create the menu */

	choices (1) = "The Tutorial";
	choices (2) = "New Terms";
	choices (3) = "Practice";
	choices (4) = "Getting Help with Multics";
	choices (5) = "Giving Commands";
	choices (6) = "Writing Text";
	choices (7) = "Messages and Mail";
	choices (8) = "Storing Information";
	choices (9) = "Logging In and Out";
	choices (10) = "Wordprocessing";

	headers (1) = "<<<Multics Tutorial>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	unspec (user_io_window_info) = "0"b;
          unspec (true_io_window_info) = "0"b;
	user_io_window_info.version = window_position_info_version_1;
	call iox_$control (iox_$user_io, "get_window_info", addr (user_io_window_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Can't get window info.", menu_io, user_io_window_info);
		return;
	     end;
	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 8;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve out temporary menu I/O window from the user_i/o window. */


	menu_io_switch_name = "menu_i/o" || unique_chars_ ("0"b);
	call iox_$find_iocb (menu_io_switch_name, menu_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to get IOCB pointer for menu window.", menu_io,
		     user_io_window_info);
		return;
	     end;
	call window_$create (video_data_$terminal_iocb, addr (user_io_window_info), menu_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to create the menu_i/o window.", menu_io,
		     user_io_window_info);
		return;
	     end;

SET_UP:
	change_origin = "0"b;
	call tut_window_ (menu_io, true_io_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_io_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then go to NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_MAIN_MENU, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then do;
		     if choice = 1
		     then do;
			     call tut_bottom_ (true_io_window_info, new_io_height, my_menu_format.max_height,
				Phelp_args, code);
			     if code ^= 0
			     then return;
			end;

		     else if choice = 2
		     then do;
			     call tut_cl ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then if last ^= 0
			then do;
				if last ^= last1
				then last = last1;
				call prev_menu ();
			     end;
			else call window_$bell (menu_io, (0));
		     else if choice = 4
		     then do;
			     call EXIT ();
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	     else do;
		     if choice = 1
		     then do;
			     call the_tut ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call terms ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call prac ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
MENU1:
			     if last1 ^= 0
			     then last = last1;
			     call tut_getting_help_ (menu_io, user_io_window_info, function_key_data_ptr, fkey,
				choice, last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else if choice = 5
		     then do;
MENU2:
			     if last1 ^= 0
			     then last = last1;
			     call tut_giving_commands_ (menu_io, user_io_window_info, function_key_data_ptr, fkey,
				choice, last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else if choice = 6
		     then do;
MENU3:
			     if last1 ^= 0
			     then last = last1;
			     call tut_writing_text_ (menu_io, user_io_window_info, function_key_data_ptr, fkey,
				choice, last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else if choice = 7
		     then do;
MENU4:
			     if last1 ^= 0
			     then last = last1;
			     call tut_mail_ (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice,
				last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else if choice = 8
		     then do;
MENU5:
			     if last1 ^= 0
			     then last = last1;
			     call tut_storing_information_ (menu_io, user_io_window_info, function_key_data_ptr,
				fkey, choice, last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else if choice = 9
		     then do;
MENU6:
			     if last1 ^= 0
			     then last = last1;
			     call tut_log_in_ (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice,
				last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else if choice = 10
		     then do;
MENU7:
			     if last1 ^= 0
			     then last = last1;
			     call tut_wordpro_ (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice,
				last1, Phelp_args, pseudo, code);
			     if code ^= 0
			     then return;
			     if fkey
			     then if choice = 3
				then call prev_menu ();
				else do;
					call EXIT ();
					return;
				     end;
			     else do;
				     init_display = "1"b;
				     goto SET_UP;
				end;
			end;

		     else call window_$bell (menu_io, (0));
		end;
	end;
	return;

/* Procedures for nonmenu options */

the_tut:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end the_tut;

terms:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end terms;

prac:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end prac;

EXIT:
     proc ();

	if choice = 4
	then do;
		call tut_terminate_sys_ (menu_io, user_io_window_info);
		if video_was_already_on
		then call window_$clear_window (iox_$user_io, (0));
		fkey = "0"b;
		return;
	     end;
	else call window_$bell (menu_io, (0));
     end EXIT;

prev_menu:
     proc ();

	if last = 0
	then goto SET_UP;
	else if last = 1
	then goto MENU1;
	else if last = 2
	then goto MENU2;
	else if last = 3
	then goto MENU3;
	else if last = 4
	then goto MENU4;
	else if last = 5
	then goto MENU5;
	else if last = 6
	then goto MENU6;
	else if last = 7
	then goto MENU7;
	else call window_$bell (menu_io, (0));

     end prev_menu;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_MAIN_MENU, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_main_menu_;




		    tut_storing_information_.pl1    09/13/88  1329.2r w 09/13/88  1315.0       77571



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      the storage system. */

/* format: style2 */
tut_storing_information_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (9) char (30) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (25) init ("tut_storing_information_0");
	dcl     seg_name_1		 char (11) init ("tut_segment");
	dcl     seg_name_2		 char (15) init ("tut_directories");
	dcl     seg_name_3		 char (12) init ("tut_home_dir");
	dcl     seg_name_4		 char (15) init ("tut_working_dir");
	dcl     seg_name_5		 char (15) init ("tut_project_dir");
	dcl     seg_name_6		 char (12) init ("tut_root_dir");
	dcl     seg_name_7		 char (15) init ("tut_pathnames_2");
	dcl     seg_name_8		 char (10) init ("tut_access");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_STORE_INFO	 char (24) init ("tut_storing_information_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, empty, addr)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "Segments";
	choices (2) = "Directories";
	choices (3) = "The Home Directory";
	choices (4) = "The Working Directory";
	choices (5) = "The Project Directory";
	choices (6) = "The Root Directory";
	choices (7) = "Pathnames";
	choices (8) = "Access to Stored Information";
	choices (9) = "Return to First Menu";

	headers (1) = "<<<Storing Information>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 8;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_STORE_INFO, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_STORE_INFO, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_STORE_INFO, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 5;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call seg ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call dirs ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call home ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     call working ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 5
		     then do;
			     call project ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 6
		     then do;
			     call root_dir ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 7
		     then do;
			     call pathname ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 8
		     then do;
			     call access ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 9
		     then do;
			     last1 = 5;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

seg:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end seg;

dirs:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end dirs;

home:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end home;

working:
     proc ();

	call tut_get_seg_ (seg_name_4, menu_io, user_io_window_info, code);
	return;

     end working;

project:
     proc ();

	call tut_get_seg_ (seg_name_5, menu_io, user_io_window_info, code);
	return;

     end project;

root_dir:
     proc ();

	call tut_get_seg_ (seg_name_6, menu_io, user_io_window_info, code);
	return;

     end root_dir;

pathname:
     proc ();

	call tut_get_seg_ (seg_name_7, menu_io, user_io_window_info, code);
	return;

     end pathname;

access:
     proc ();

	call tut_get_seg_ (seg_name_8, menu_io, user_io_window_info, code);
	return;

     end access;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_STORE_INFO, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_STORE_INFO, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_STORE_INFO, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_storing_information_;




		    tut_window_.pl1                 09/11/84  1519.9rew 09/10/84  1501.9       22014



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* format: style2 */

/* Written by J. Siwila 3/30/83 */

/* This procedure carves out the menu and io windows for the Tutorial. */

tut_window_:
     proc (iocb_ptr, auto_window_info, new_height, change_origin, code);


/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     code		 fixed bin (35);
	dcl     ME_TUT_WINDOW	 char (11) init ("tut_window_");
	dcl     iocb_ptr		 ptr;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     1 auto_window_info	 like window_position_info;
	dcl     new_height		 fixed bin;
	dcl     new_origin		 fixed bin;
	dcl     height_change	 fixed bin;

/* Builtin */

	dcl     addr		 builtin;

/* Entries */

	dcl     tut_quit_		 entry () options (variable);

/* Static */

	dcl     MIN_USER_IO_HEIGHT	 fixed bin static options (constant) init (5);
	dcl     USER_IO		 char (8) static options (constant) init ("user_i/o");

	auto_window_info.version = window_position_info_version_1;
	call window_$clear_window (iocb_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_TUT_WINDOW, "This ain't it.", iocb_ptr, auto_window_info);
		return;
	     end;

	call iox_$control (iocb_ptr, "get_window_info", addr (auto_window_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_TUT_WINDOW, "Can't get window info.", iocb_ptr, auto_window_info);
		return;
	     end;
	height_change = new_height - auto_window_info.height;
	if change_origin
	then do;
		if new_height < MIN_USER_IO_HEIGHT
		then do;
			call tut_quit_ (0, ME_TUT_WINDOW, "Window""user_i/o"" is too small.", iocb_ptr,
			     auto_window_info);
			return;
		     end;
		new_origin = auto_window_info.line - height_change;
		auto_window_info.line = new_origin;
	     end;
	auto_window_info.height = new_height;
	call iox_$control (iocb_ptr, "set_window_info", addr (auto_window_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_TUT_WINDOW, "Unable to shrink window""user_i/o"".", iocb_ptr,
		     auto_window_info);
		return;
	     end;


%page;
%include iox_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;
%page;
%include menu_dcls;

     end tut_window_;




		    tut_wordpro_.pl1                09/13/88  1329.2r w 09/13/88  1315.0       68220



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      WORDPRO. */

/* format: style2 */
tut_wordpro_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (6) char (32) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (13) init ("tut_wordpro_0");
	dcl     seg_name_1		 char (14) init ("tut_wp_segment");
	dcl     seg_name_2		 char (10) init ("tut_format");
	dcl     seg_name_3		 char (13) init ("tut_speedtype");
	dcl     seg_name_4		 char (14) init ("tut_dictionary");
	dcl     seg_name_5		 char (9) init ("tut_lists");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_WORDPRO		 char (13) init ("tut_wordpro_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (null, empty, addr)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "Creating a Document";
	choices (2) = "Formatting";
	choices (3) = "Speedtyping";
	choices (4) = "Using Online Dictionaries";
	choices (5) = "List Processing";
	choices (6) = "Return to First Menu";

	headers (1) = "<<<Wordprocessing>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 6;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WORDPRO, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WORDPRO, "Unable to display menu.", menu_io, user_io_window_info);
		return;
	     end;

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_WORDPRO, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 7;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call segment ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call formatting ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call speedtyping ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     call dictionary ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 5
		     then do;
			     call list ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 6
		     then do;
			     last1 = 7;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

segment:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end segment;

formatting:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end formatting;

speedtyping:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end speedtyping;

dictionary:
     proc ();

	call tut_get_seg_ (seg_name_4, menu_io, user_io_window_info, code);
	return;

     end dictionary;

list:
     proc ();

	call tut_get_seg_ (seg_name_5, menu_io, user_io_window_info, code);
	return;

     end list;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WORDPRO, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WORDPRO, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WORDPRO, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_wordpro_;




		    tut_writing_text_.pl1           09/13/88  1329.2r w 09/13/88  1315.0       61956



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */

/* Written by J. Siwila  3/30/83 */

/* This procedure sets up and displays the menu in the Tutorial dealing with
      text editors. */

/* format: style2 */
tut_writing_text_:
     proc (menu_io, user_io_window_info, function_key_data_ptr, fkey, choice, last1, Phelp_args, pseudo, code);

/* Automatic */

	dcl     change_origin	 bit (1) aligned;
	dcl     choice		 fixed bin;
	dcl     choices		 (4) char (30) var;
	dcl     code		 fixed bin (35);
	dcl     init_display	 bit (1) aligned init ("0"b);
	dcl     fkey		 bit (1) aligned;
	dcl     headers		 (1) char (30) var;
	dcl     menu_io		 ptr;
	dcl     menu_ptr		 ptr;
	dcl     my_area		 area (4095);
	dcl     1 my_menu_format	 like menu_format;
	dcl     1 my_menu_requirements like menu_requirements;
	dcl     1 true_window_info	 like window_position_info;
	dcl     new_io_height	 fixed bin;
	dcl     seg_name		 char (18) init ("tut_writing_text_0");
	dcl     seg_name_1		 char (12) init ("tut_emacs_ed");
	dcl     seg_name_2		 char (11) init ("tut_qedx_ed");
	dcl     seg_name_3		 char (10) init ("tut_ted_ed");
	dcl     trailers		 (2) char (40) var;
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     ME_WRITE_TEXT	 char (17) init ("tut_writing_text_");
	dcl     last1		 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Builtin */

	dcl     (addr, null, empty)	 builtin;

/* Condition */

	dcl     (program_interrupt, any_other)
				 condition;

/* Entries */

	dcl     cu_$cl		 entry () options (variable);
	dcl     tut_get_seg_	 entry () options (variable);
	dcl     tut_quit_		 entry () options (variable);
	dcl     tut_bottom_		 entry () options (variable);
	dcl     tut_window_		 entry () options (variable);

/* External */

	dcl     video_data_$terminal_iocb
				 ptr external;


/* Create the menu */

	choices (1) = "The Emacs Editor";
	choices (2) = "The Qedx Editor";
	choices (3) = "The Ted Editor";
	choices (4) = "Return to First Menu";

	headers (1) = "<<<Writing Text>>>";
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key F4 to Exit";
	trailers (2) = "-";

	my_menu_format.version = menu_format_version_1;
	my_menu_format.max_width = user_io_window_info.extent.width;
	my_menu_format.max_height = 5;
	my_menu_format.n_columns = 2;
	my_menu_format.center_headers = "1"b;
	my_menu_format.center_trailers = "1"b;
	my_menu_format.pad = "0"b;
	my_menu_format.pad_char = "-";

	my_menu_requirements = menu_requirements_version_1;

/* Now carve the menu I/O window out of the user_i/o window. */

	change_origin = "0"b;
	call tut_window_ (menu_io, true_window_info, my_menu_format.max_height, change_origin, code);
	if code ^= 0
	then return;
	new_io_height = user_io_window_info.height - my_menu_format.max_height;
START:
	change_origin = "1"b;
	call tut_window_ (iox_$user_io, true_window_info, new_io_height, change_origin, code);
	if code ^= 0
	then return;

	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WRITE_TEXT, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;

/* Display menus */


	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then call tut_quit_ (code, ME_WRITE_TEXT, "Unable to display menu.", menu_io, user_io_window_info);

	if init_display
	then goto NEXT;
	else do;
		init_display = "1"b;
		call tut_get_seg_ (seg_name, menu_io, user_io_window_info, code);
		if code ^= 0
		then return;
	     end;

NEXT:
	on condition (program_interrupt) go to START;

/* Now start processing input from user */

	do while ("1"b);

/* Get an option number or function key value from user. */

	     code = 0;
	     call iox_$control (iox_$user_io, "reset_more", null (), code);
	     call menu_$get_choice (menu_io, menu_ptr, function_key_data_ptr, fkey, choice, code);

/* Perform an action depending on the user's selection. */

	     if code ^= 0
	     then do;
		     call tut_quit_ (code, ME_WRITE_TEXT, "Unable to get choice.", menu_io, user_io_window_info);
		     return;
		end;
	     if fkey
	     then if choice = 1
		then do;
			call tut_bottom_ (true_window_info, new_io_height, my_menu_format.max_height, Phelp_args,
			     code);
			if code ^= 0
			then return;
		     end;
		else if choice = 2
		then do;
			call tut_cl ();
			if code ^= 0
			then return;
		     end;
		else if choice = 3
		then do;
			last1 = 3;
			return;
		     end;
		else if choice = 4
		then return;
		else call window_$bell (menu_io, (0));

	     else do;
		     if choice = 1
		     then do;
			     call emacs ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 2
		     then do;
			     call qedx ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 3
		     then do;
			     call ted ();
			     if code ^= 0
			     then return;
			end;
		     else if choice = 4
		     then do;
			     last1 = 3;
			     return;
			end;
		     else call window_$bell (menu_io, (0));
		end;
	end;

/* Procedures for options. */

emacs:
     proc ();

	call tut_get_seg_ (seg_name_1, menu_io, user_io_window_info, code);
	return;

     end emacs;

qedx:
     proc ();

	call tut_get_seg_ (seg_name_2, menu_io, user_io_window_info, code);
	return;

     end qedx;

ted:
     proc ();

	call tut_get_seg_ (seg_name_3, menu_io, user_io_window_info, code);
	return;

     end ted;

tut_cl:
     proc ();

	on any_other system;
	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WRITE_TEXT, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;
	trailers (1) = "Type ""pi"" and RETURN to reenter tutorial";
	call menu_$create (choices, headers, trailers, addr (my_menu_format), MENU_OPTION_KEYS, addr (my_area),
	     addr (my_menu_requirements), menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WRITE_TEXT, "Unable to create menu.", menu_io, user_io_window_info);
		return;
	     end;
	call menu_$display (menu_io, menu_ptr, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_WRITE_TEXT, "Unable to display menu", menu_io, user_io_window_info);
		return;
	     end;
	if pseudo
	then trailers (1) = "Use ESC q to Exit";
	else trailers (1) = "Use Function Key 1 to Exit";
	call cu_$cl;

     end tut_cl;

%include function_key_data;
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include window_dcls;
%page;
%include window_control_info;

     end tut_writing_text_;




		    tutorial.pl1                    09/13/88  1329.2rew 09/13/88  1257.6       97119



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(86-01-22,LJAdams), approve(86-01-22,MCR7327),
     audit(86-04-17,Lippard), install(86-04-24,MR12.0-1048):
     Added ssu_ references so subsystem calls to help_ will work properly.
     Added include file "help_args" which contains data needed by help.
  2) change(87-08-07,LJAdams), approve(87-09-03,MCR7766),
     audit(88-09-03,GDixon), install(88-09-13,MR12.2-1109):
     Changed Vhelp_args_2 to Vhelp_args_3.  Moved code from tut_quit_
     and tut_terminate_sys_ into here thus eliminating these modules.
                                                   END HISTORY COMMENTS */


/* Written by J. Siwila  3/30/83 */
/* Modified:  April,1985  by L.Adams - use new help_args_incl         */

/* This procedure starts the Tutorial by setting up the video system and
      alternate function key escape sequences and initializing the 
      help_args data structure. */

/* format: style2 */
tutorial:
     proc ();

/* Automatic */

	dcl     code		 fixed bin (35);
	dcl     key_shift_idx	 fixed bin;
	dcl     menu_io		 ptr;
	dcl     my_area_ptr		 ptr;
	dcl     1 local_area_info	 like area_info;
	dcl     reason		 char (512);
	dcl     1 user_io_window_info	 like window_position_info;
	dcl     1 auto_terminal_info	 like terminal_info;
	dcl     i			 fixed bin;
	dcl     pseudo		 bit (1) aligned;

/* Based */

	dcl     1 fkey_data		 like function_key_data based (function_key_data_ptr) aligned;
	dcl     my_area		 area (sys_info$max_seg_size) based (my_area_ptr);

/* Builtin */

	dcl     (addr, length, null, unspec)
				 builtin;

/* Conditions */

	dcl     (cleanup)		 condition;

/* Entries */

	dcl     tut_main_menu_	 entry () options (variable);
	dcl     ttt_info_$function_key_data
				 entry (char (*), ptr, ptr, fixed bin (35));
	dcl     video_utils_$turn_on_login_channel
				 entry (fixed bin (35), char (*));
          dcl     video_utils_$turn_off_login_channel 
				entry (fixed bin(35));
          dcl     com_err_		 entry() options(variable);
	dcl     define_area_	 entry (ptr, fixed bin (35));
	dcl     release_area_	 entry (ptr);

/* Internal Static */

	dcl     ME_EXAMPLE		 char (8) init ("tutorial") int static options(constant);
	dcl     PSEUDO_KEYS		 char (8) static options (constant) init ("gcpq");
	dcl     PSEUDO_KEYS_COUNT	 char (4) init ("1234") int static options(constant);
          dcl     tutorial_active        bit (1) internal static init("0"b);
	dcl     video_was_already_on	 bit (1) aligned internal static init ("0"b);


/* External */

	dcl     error_table_$no_table	 fixed bin (35) ext;
	dcl     sys_info$max_seg_size	 ext fixed bin (35);
	dcl     video_data_$terminal_iocb
				 pointer external;
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

          if tutorial_active				/* tutorial CANNOT be invoked recursively */
          then do;					/*   because of its use of internal static*/
						/*   variables.			  */
                    call com_err_  (0, ME_EXAMPLE, "The tutorial command may not be invoked recursively.
Type ""release -all"" to stop the prior invocation, then invoke tutorial again.");
		return;
               end;
          else tutorial_active = "1"b;

	menu_io = null;				/* initialize values needed for cleanup   */
	my_area_ptr = null;				/*   on unit			  */
          Phelp_args = null;

	video_was_already_on = (video_data_$terminal_iocb ^= null);
	if video_was_already_on			/* video details used by cleanup too.	  */
	then do;
		user_io_window_info = window_position_info_version_1;
		call iox_$control (iox_$user_io, "get_window_info", addr (user_io_window_info), code);
		if code ^= 0
		then do;
			call com_err_ (code, ME_EXAMPLE, "Unable to get window info.");
			return;
		     end;
	     end;
	on condition (cleanup) call clean_up ();

	unspec (local_area_info) = "0"b;

	local_area_info.version = area_info_version_1;
	local_area_info.control.extend = "1"b;
	local_area_info.owner = ME_EXAMPLE;
	local_area_info.size = sys_info$max_seg_size;
	local_area_info.areap = null;

	call define_area_ (addr (local_area_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_EXAMPLE, reason, menu_io, user_io_window_info);
		return;
	     end;
	my_area_ptr = local_area_info.areap;
%page;
/* Invoke the window system if it's not already invoked */

	if ^video_was_already_on
	then do;
		call video_utils_$turn_on_login_channel (code, reason);
		if code ^= 0
		then do;
			if code = error_table_$no_table
			then call tut_quit_ (code, ME_EXAMPLE,
				"The Multics Tutorial can be invoked only on an appropriately configured video terminal.  Please configure your terminal properly, or see your local Multics consultant."
				, menu_io, user_io_window_info);
			else call tut_quit_ (code, ME_EXAMPLE, reason, menu_io, user_io_window_info);
			return;
		     end;
		user_io_window_info = window_position_info_version_1;
		call iox_$control (iox_$user_io, "get_window_info", addr (user_io_window_info), code);
		if code ^= 0
		then do;
			call tut_quit_ (code, ME_EXAMPLE, "Unable to get window info after turning on video.",
			     menu_io, user_io_window_info);
			return;
		     end;
	     end;

	call window_$clear_window (iox_$user_io, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_EXAMPLE, "Unable to clear window.", menu_io, user_io_window_info);
		return;
	     end;

/* See if we have to use escape sequences for function keys */

	pseudo = "0"b;
	auto_terminal_info.version = terminal_info_version;
	call iox_$control (iox_$user_io, "terminal_info", addr (auto_terminal_info), code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_EXAMPLE, "Unable to get terminal info.", menu_io, user_io_window_info);
		return;
	     end;
	function_key_data_ptr = null;
	call ttt_info_$function_key_data (auto_terminal_info.term_type, my_area_ptr, function_key_data_ptr, code);
	if code ^= 0
	then do;
		if code = error_table_$no_table
		then call alt_keys;
		else do;
			call tut_quit_ (code, ME_EXAMPLE, "Cannot get function key data.", menu_io,
			     user_io_window_info);
			return;
		     end;
	     end;
	if function_key_data_ptr = null
	then call alt_keys;
	if fkey_data.highest < length (PSEUDO_KEYS_COUNT)
	then call alt_keys;
%page;
	call help_$init (ME_EXAMPLE, "", "", Vhelp_args_3, Phelp_args, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_EXAMPLE, "Unable to initiate help_.", menu_io, user_io_window_info);
		return;
	     end;
	help_args.Sctl.all = "1"b;
	help_args.Sctl.inhibit_errors = "1"b;
	help_args.Nsearch_dirs = help_args.Nsearch_dirs + 1;
	help_args.Npaths = 1;
	help_args.search_dirs = ">doc>facilities_data_dir";
	help_args.path.value = ">doc>facilities_data_dir>tut_glossary.gi.info";
	help_args.path.S.pn_ctl_arg = "0"b;
	help_args.path.S.info_name_not_starname = "1"b;

MAIN_MENU:
	call tut_main_menu_ (menu_io, function_key_data_ptr, Phelp_args, pseudo);
	call help_$term (ME_EXAMPLE, Phelp_args, code);
	if code ^= 0
	then do;
		call tut_quit_ (code, ME_EXAMPLE, "Unable to terminate help_.", menu_io, user_io_window_info);
		return;
	     end;
	call clean_up();
          return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

alt_keys:
     proc;

	pseudo = "1"b;
	function_key_data_highest = length (PSEUDO_KEYS_COUNT);
	allocate fkey_data in (my_area) set (function_key_data_ptr);
	fkey_data.version = function_key_data_version_1;
	fkey_data.seq_ptr = addr (PSEUDO_KEYS);
	fkey_data.seq_len = length (PSEUDO_KEYS);
	do key_shift_idx = 0 to 3;
	     fkey_data.home.sequence_length (key_shift_idx) = 0;
	     fkey_data.left.sequence_length (key_shift_idx) = 0;
	     fkey_data.up.sequence_length (key_shift_idx) = 0;
	     fkey_data.right.sequence_length (key_shift_idx) = 0;
	     fkey_data.down.sequence_length (key_shift_idx) = 0;
	end;

	do i = 1 to function_key_data_highest;
	     fkey_data.function_keys (i, KEY_PLAIN).sequence_index = 2 * i - 1;
	     fkey_data.function_keys (i, KEY_PLAIN).sequence_length = 2;
	end;
     end alt_keys;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
%page;
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

clean_up:
     proc ();

          call help_$term ("tutorial", Phelp_args, (0));
	if tutorial_active then
	     call tut_terminate_sys_ (menu_io, user_io_window_info);
	if my_area_ptr ^= null
	then call release_area_ (my_area_ptr);
	return;
     end clean_up;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

terminate_sys_:
     proc ();

          if tutorial_active then do;
	     if menu_io ^= null ()
	     then call window_$destroy (menu_io, (0));
	     menu_io = null;
	     if video_was_already_on
	     then call iox_$control (iox_$user_io, "set_window_info", addr (user_io_window_info), (0));
	     else call video_utils_$turn_off_login_channel ((0));
	     tutorial_active = "0"b;
	end;

end terminate_sys_;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

tut_quit_:
     entry (acode, ME, explanation, Pmenu_io, puser_io_window_info);

     dcl     acode                       fixed bin(35),
             explanation		 char (*),
             ME	           	 char (*),
             Pmenu_io                    ptr,
             1 puser_io_window_info like window_position_info;

          menu_io = Pmenu_io;
          user_io_window_info = puser_io_window_info;
	call terminate_sys_;
	call com_err_ (acode, ME, explanation);
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

tut_terminate_sys_:
     entry (Pmenu_io, puser_io_window_info);

          menu_io = Pmenu_io;
          user_io_window_info = puser_io_window_info;
          call terminate_sys_;
          return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
%page;
%include help_args_;
%page;
%include iox_dcls;
%page;
%include window_dcls;
%page;
%include function_key_data;
%page;
%include menu_dcls;
%page;
%include window_control_info;
%page;
%include terminal_info;
%page;
%include area_info;

     end tutorial;




		    where_doc.pl1                   06/18/86  1333.5rew 06/18/86  1332.0      302886



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-06-12,GJohnson), approve(86-06-12,MCR7410),
     audit(86-06-17,Martinson), install(86-06-18,MR12.0-1079):
     Changed to use iox_ user_output.
                                                   END HISTORY COMMENTS */


/* format: style2 */
where_doc:
wdoc:
     proc;

/* HISTORY:
Written by Jim Paradise, fall 1980.
Modified:
03/02/81 by M. Pierret to leave data base open.
06/16/81 by M. Pierret to canonicalize names, accept multi-word
            entry names, surround operation with set/del scope.
10/15/81 by M. Pierret to accept -(dont_a a)llow_partial_match control arg
            and to select manuals by doing an index comparison on each
            entry_name_rel.entry_name, if -allow_partial_match given.
10/19/81 by M. Pierret to use display_info instead of display_flags, and to
            display topics selected when -apm specified.
04/22/83 by Matthew Pierret:  Reformatted the HISTORY section to be useable by
            automatic subsys tools.
           Changed to set display_info.short_name_flag off by default.
           Added an automatic local_display_info, like display_info, upon
            which display_info is based (display_info_ptr = addr
            (local_display_info)).
05/13/83 by J. Siwila:  Added facility to display a menu when user has asked
           for a description of some part of the manuals found and the number
           of manuals found is greater than one.  Also made 
           -allow_partial_matches the default.  Fixed cleanup procedures to
           act according to whether or not the menu facility has been invoked.
06/15/83 by J. Siwila:  Changed -dont_allow_partial_matches to the default and 
           added prompt asking user whether or not to do partial match search
           when neither -allow_partial_matches nor -dont_allow_partial_matches 
           has been specified explicitly.  Also turned topics_flag on for all
           cases when partial matches are searched for.
07/18/83 by J. Siwila:  Added -no_description, -no_audience, 
           -no_table_of_contents, and -no_new_features control arguments.
09/01/83 by M. Pierret: Changed to clean up the screen and display without
            menu if any error occurs while setting up the menu.  Changed 
            cleanup handler to cleanup the screen.  Removed -brief.
09/21/83 by M. Pierret: Made many changes to in general clean up the code.
            Added comments and more useful error messages, prompts and menu
            headers.  Added more complete argument checking. Changed to only
            use a menu if video is already on, i.e., to never turn video on.
            Changed to clear bottom window before displaying.
            Changed default database path to >doc>facilities_data_dir.
09/29/83 by M. Pierret: Changed to always open the database when -dbpn is
            specified and close the existing opening, if there is one.
            Changed to print all manuals if -output_file is specified rather
            than setting up a menu. Simplified the setup_menu algorithm.
            Changed -apm to set dont_allow_partial_matches to off (-dapm
            already did the converse).
09/30/83 by Matthew Pierret: Changed to print "where_doc must be followed..."
            instead of "Command name must be followed...". Delayed clearing of
            user_io window until just before shrinking it. Removed an
            invalid ioa_ control string. Changed the clean_up subroutine to use
            a local variable instead of (0) in its external calls. This is because
            dsl_$close complains if it doesn't get a fixed bin (35) last arg.
*/

/*
DESCRIPTION:
   where_doc returns information, as determined by control args, relevant
   to a given topic_name.

   The data base is only opened once per process by either where_doc or
   explain_doc;  the module online_doc_db_index keeps track of the index
   of the opening.
*/

/* START of DECLARATIONS */
/* Automatic */

	dcl     (topic_name, temp_topic_name)
				 char (64) var;
	dcl     topic_array		 (25) char (64) varying;
	dcl     entry_name		 char (64);
	dcl     mrds_database_path	 char (256);
	dcl     output_switch_name	 char (32);
	dcl     output_file_path	 char (256);

	dcl     (accept_control_argument, mrds_scope_set, database_path_sw, output_file_sw, use_menu_display,
	        partial_matches_allowed, dont_allow_partial_matches)
				 bit (1) aligned init ("0"b);
	dcl     yes_sw		 bit (1) aligned;

	dcl     (
	        arg_idx,
	        arg_len,
	        control_argument_idx,
	        manual_idx,
	        manual_array	 (25),
	        manual_number,
	        nargs,
	        number_of_manuals
	        )			 fixed bin;
	dcl     (
	        current_mrds_dbi	 init (0),
	        mrds_dbi		 init (0),
	        code
	        )			 fixed bin (35);

	dcl     output_ptr		 ptr;
	dcl     arg_ptr		 ptr;

	dcl     1 local_display_info	 aligned like display_info;

/* Based */

	dcl     arg		 char (arg_len) based (arg_ptr);

/* Internal static */

	dcl     argument_type	 (1:4) char (64) varying options (constant)
				 init ("topic name", "output file path name", "", "MRDS database path name")
				 internal static;

	dcl     control_argument	 (1:28) char (32) varying options (constant)
				 init ("where_doc", "-output_file", "-of", "-database_pathname", "-dbpn",
				 "-description", "-desc", "-audience", "-aud", "-table_of_contents", "-toc",
				 "-new_features", "-nf", "", "-a", "-all", "-allow_partial_matches", "-apm",
				 "-dont_allow_partial_matches", "-dapm", "-no_description", "-no_desc", "-no_audience",
				 "-no_aud", "-no_table_of_contents", "-no_toc", "-no_new_features", "-no_nf")
				 internal static;

	dcl     myname		 char (9) options (constant) init ("where_doc") internal static;
	dcl     LOWER_CASE_ALPHA	 char (26) init ("abcdefghijklmnopqrstuvwxyz");
	dcl     UPPER_CASE_ALPHA	 char (26) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");

/* Error table */

	dcl     (
	        error_table_$noarg,
	        error_table_$badopt,
	        error_table_$bad_arg,
	        error_table_$not_act_fnc,
	        error_table_$active_function,
	        error_table_$noentry,
	        mrds_error_$invalid_db_index,
	        mrds_error_$tuple_not_found
	        )			 external fixed bin (35);

/*  Entries */

	dcl     absolute_pathname_	 entry (char (*), char (*), fixed bin (35));
	dcl     absolute_pathname_$add_suffix
				 entry (char (*), char (*), char (*), fixed bin (35));
	dcl     active_fnc_err_	 entry () options (variable);
	dcl     command_query_$yes_no	 entry options (variable);
	dcl     com_err_		 entry options (variable);
	dcl     complain		 entry variable options (variable);
	dcl     cu_$arg_ptr		 entry (fixed bin, ptr, fixed bin, fixed bin (35));
	dcl     cu_$af_return_arg	 entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl     display_doc		 entry (ptr, fixed bin (35), fixed bin, ptr, char (*) var, fixed bin (35));
	dcl     dsl_$close		 entry () options (variable);
	dcl     dsl_$dl_scope_all	 entry (fixed binary (35), fixed binary (35));
	dcl     dsl_$open		 entry options (variable);
	dcl     dsl_$retrieve	 entry options (variable);
	dcl     dsl_$set_scope_all	 entry options (variable);
	dcl     online_doc_db_index$set_index
				 entry (fixed bin (35));
	dcl     online_doc_db_index$return_index
				 entry (fixed bin (35));

/* Conditions */

	dcl     cleanup		 condition;

/* Builtins */

	dcl     (after, before, copy, empty, hbound, length, rtrim, string, substr, translate, ltrim, index)
				 builtin;

/* Menu dcls */

	dcl     (
	        video_is_on,
	        choice_flag		 init ("1"b),
	        fkey
	        )			 bit (1) aligned;
	dcl     (choice, choices_idx, number_of_options)
				 fixed bin;

	dcl     menu_io_switch_name	 char (32);
	dcl     choices		 (number_of_options) char (64) var based (choices_ptr);
	dcl     headers		 (2) char (70) var;
	dcl     trailers		 (2) char (60) var;

	dcl     1 user_io_window_info	 like window_position_info;
	dcl     1 current_user_io_window_info
				 like window_position_info;
	dcl     1 menu_window_info	 like window_position_info;
	dcl     1 local_menu_format	 like menu_format;
	dcl     1 local_menu_requirements
				 like menu_requirements;
	dcl     1 local_area_info	 like area_info;

	dcl     (menu_io_ptr, choices_ptr, menu_ptr, work_area_ptr)
				 ptr;

	dcl     video_data_$terminal_iocb
				 ptr external;

	dcl     (addr, null, unspec)	 builtin;

	dcl     work_area		 area (sys_info$max_seg_size) based (work_area_ptr);

	dcl     sys_info$max_seg_size	 ext fixed bin (35);

	dcl     unique_chars_	 entry (bit (*)) returns (char (15));
	dcl     define_area_	 entry (ptr, fixed bin (35));
	dcl     release_area_	 entry (ptr);

/* END OF DECLARATIONS */

/* format: indcomtxt,^indblkcom */

	current_user_io_window_info.version = -1;
	menu_io_ptr, output_ptr, work_area_ptr = null;
	mrds_scope_set = "0"b;
	video_is_on = (video_data_$terminal_iocb ^= null);

	mrds_database_path = ">doc>facilities_data_dir>online_doc.db";
						/* Should be ">site>online_doc.db" or some-such */
	topic_name = "";
	topic_array = "";

	display_info_ptr = addr (local_display_info);
	string (display_info) = "0"b;
	string (display_info.header) = copy ("1"b, length (string (display_info.header)));
	display_info.header.short_name_flag = "0"b;
	display_info.header.topics_flag = "0"b;

	call cu_$af_return_arg (nargs, (null), (0), code);
	if code = 0
	then call active_fnc_err_ (error_table_$active_function, myname, "");
	else if code ^= error_table_$not_act_fnc
	then do;
		call com_err_ (code, myname);
		return;
	     end;

	complain = com_err_;

	if nargs = 0
	then do;
		call complain (error_table_$noarg, myname, "^/Usage: ^a topic_name  {-control_args}", myname);
		return;
	     end;
	accept_control_argument = "0"b;		/* First argument cannot be a control argument. */
	control_argument_idx = 1;			/* First argument must be of argument_type (1) - topic name. */

ARGUMENT_PROCESSING_LOOP:
	do arg_idx = 1 to nargs;
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);
	     if index (arg, "-") ^= 1
	     then do;
		     goto ARG (control_argument_idx);

		/*** The argument is not a control argument.  If no control argument has
		     been processed yet, the argument is of type argument_type (1). If a
		     control argument has been processed but the last control argument does not
		     expect an arguemnt, control_argument_idx is 0 and this case is in error.
		     If an argument to a control argument is expected, it is of type
		     argument_type (control_argument_idx). */

ARG (0):						/* unexpected argument */
		     call complain (error_table_$badopt, myname, "Argument is out of place: ^a.", arg);
		     return;

ARG (1):						/* topic name, immediately follows the command name. */
		     if length (arg) + length (topic_name) >= 64
		     then do;
			     call complain (error_table_$bad_arg, myname,
				"Topic name ""^a ^a"" exceeds the 64 character limit.", topic_name, arg);
			     return;
			end;
		     if length (topic_name) ^= 0
		     then topic_name = topic_name || " ";
		     topic_name = topic_name || ltrim (rtrim (arg));
		     accept_control_argument = "1"b;
		     control_argument_idx = 1;
		     goto NEXT_1;

ARG (2):
		     call absolute_pathname_ (arg, output_file_path, code);
		     if code ^= 0
		     then do;
			     call complain (code, myname, "Output file pathname argument ^a.", arg);
			     return;
			end;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_1;

ARG (4):
		     call absolute_pathname_$add_suffix (arg, "db", mrds_database_path, code);
		     if code ^= 0
		     then do;
			     call complain (code, myname, "Data base pathname argument ^a.", arg);
			     return;
			end;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_1;

NEXT_1:
		end;
	     else if ^accept_control_argument
	     then do;

		/*** A control argument was specified, but the command was not expecting
		     a control argument at this point. It was expecting the argument
		     associated with control_argument(control_argument_idx), which is
		     described in argument_type (control_argument_idx).
		     It should never be the case that accept_control_argument is off and
		     control_argument_idx is equal to 0. */

		     call complain (error_table_$noarg, myname, "^a must be followed by a^[n^] ^a.",
			control_argument (control_argument_idx),
			(index ("aeiouh", substr (argument_type (control_argument_idx), 1, 1)) > 0),
			argument_type (control_argument_idx));
		     return;
		end;
	     else do;

		/*** The argument is a control argument and it is expected. Find the control
		     argument in the control_argument array. The index into this array identifies
		     the case to process in the following case statement (computed goto). */

		     do control_argument_idx = 2 to hbound (control_argument, 1)
			while (control_argument (control_argument_idx) ^= arg);
		     end;
		     if control_argument_idx > hbound (control_argument, 1)
		     then do;
			     call complain (error_table_$badopt, myname, "^a", arg);
			     return;
			end;

		     goto CONTROL_ARG (control_argument_idx);

		/*** Case of control argument with the index control_argument_idx.  In each
		     case where an argument is expected to follow the control argument,
		     accept_control_argument is turned off so that an error occurs if the
		     next argument is a control argument. If no argument is expected,
		     accept_control_argument is turned on, meaning that control arguments are
		     allowed, and control_argument_idx is set to 0, indicating that there is
		     no control argument expecting an argument. */


CONTROL_ARG (2):
CONTROL_ARG (3):					/* -output_file, -of */
		     output_file_sw = "1"b;
		     accept_control_argument = "0"b;
		     control_argument_idx = 2;
		     goto NEXT_ARG;

CONTROL_ARG (4):
CONTROL_ARG (5):					/* -database_pathname, -dbpn */
		     database_path_sw = "1"b;
		     accept_control_argument = "0"b;
		     control_argument_idx = 4;
		     goto NEXT_ARG;

CONTROL_ARG (6):
CONTROL_ARG (7):					/* -description, -desc */
		     display_info.text.description_flag = "1"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (8):
CONTROL_ARG (9):					/* -audience, -aud */
		     display_info.text.audience_flag = "1"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (10):
CONTROL_ARG (11):					/* -table_of_contents, -toc */
		     display_info.text.table_of_contents_flag = "1"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (12):
CONTROL_ARG (13):					/* -new_features, -nf */
		     display_info.text.new_features_flag = "1"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (14):					/* "" */
		     goto NEXT_ARG;

CONTROL_ARG (15):
CONTROL_ARG (16):					/* -all, -a */
		     string (display_info.text) = copy ("1"b, length (string (display_info.text)));
		     string (display_info.header) = copy ("1"b, length (string (display_info.header)));
		     display_info.header.topics_flag = "0"b;
						/* Value of this flag is set depending on whether partial matches are selected. */
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (17):
CONTROL_ARG (18):					/* -allow_partial_match, -acm */
		     partial_matches_allowed = "1"b;
		     dont_allow_partial_matches = "0"b;
		     display_info.header.topics_flag = "1"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (19):
CONTROL_ARG (20):					/* -dont_allow_partial_match, -dacm */
		     partial_matches_allowed = "0"b;
		     dont_allow_partial_matches = "1"b;
		     display_info.header.topics_flag = "0"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (21):
CONTROL_ARG (22):					/* -no_description, -nd  */
		     display_info.text.description_flag = "0"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (23):
CONTROL_ARG (24):					/* -no_audience, -no_aud */
		     display_info.text.audience_flag = "0"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (25):
CONTROL_ARG (26):					/* -no_table_of_contents, -no_toc */
		     display_info.text.table_of_contents_flag = "0"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

CONTROL_ARG (27):
CONTROL_ARG (28):					/* -no_new_features, -nnf */
		     display_info.text.new_features_flag = "0"b;
		     accept_control_argument = "1"b;
		     control_argument_idx = 0;
		     goto NEXT_ARG;

NEXT_ARG:
		     ;
		end;
	end ARGUMENT_PROCESSING_LOOP;

/* format: ^indblkcom,indcomtxt */

	if control_argument_idx ^= 0 & ^accept_control_argument
	then do;

	     /*** An argument was expected since control_argument_idx is non-zero, and
		the argument was not optional, since accept_control_argument is off. */

		call complain (error_table_$noarg, myname, "^a must be followed by a^[n^] ^a.",
		     control_argument (control_argument_idx),
		     (index ("aeiouh", substr (argument_type (control_argument_idx), 1, 1)) > 0),
		     argument_type (control_argument_idx));
		return;
	     end;

/**** End of argument processing.  Execute the command. */

	on cleanup call cleanup_all;

     /*** Prepare to access the online_doc data base by setting MRDS scope and/or
	opening the data base. */

	call online_doc_db_index$return_index (current_mrds_dbi);

	if database_path_sw
	then mrds_dbi = 0;				/* To guarantee opening a new database. */
	else mrds_dbi = current_mrds_dbi;		/* Continue using same opening */

	if mrds_dbi = 0
	then do;

	     /*** The online_doc data base has not been opened yet in this process. Open it. */

		call open_data_base (mrds_database_path, mrds_dbi, code);
		if code ^= 0
		then call cleanup_and_abort (code,
			"^/^10xThe data base is temporarily out of service.  Try again shortly.^/^10xIf this problem persists, see your administrator.^s"
			, "");
	     end;

     /*** Set the MRDS scope to allow this opening to read and to prevent nothing */

	call dsl_$set_scope_all (mrds_dbi, 1, 0, 30, code);
	if code ^= 0
	then if code = mrds_error_$invalid_db_index
	     then do;

		/*** The index held by online_doc_db_index is incorrect. Reset it to zero and
		     re-open the data base. */

		     call online_doc_db_index$set_index (0);
		     call open_data_base (mrds_database_path, mrds_dbi, code);
		     if code ^= 0
		     then call cleanup_and_abort (code,
			     "^/^10xThe data base is temporarily out of service.  Try again shortly.^/^10xIf this problem persists, see your administrator.^s"
			     , "");
		     call dsl_$set_scope_all (mrds_dbi, 1, 0, 30, code);
		end;

	if code ^= 0
	then call cleanup_and_abort (code,
		"^/^10xThe data base is temporarily out of service.  Try again shortly.^/^10xIf this problem persists, see your administrator.^s"
		, "");
	mrds_scope_set = "1"b;

     /*** Canonicalize topic_name before searching */

	do while (index (topic_name, "  ") ^= 0);	/* reduce double-blanks to single */
	     temp_topic_name = after (topic_name, "  ");
	     topic_name = before (topic_name, "  ") || " " || temp_topic_name;
	end;
	topic_name = translate (topic_name, LOWER_CASE_ALPHA, UPPER_CASE_ALPHA);

     /*** Search for topic_name in the entry_name_rel relation. */

	number_of_manuals = 0;

	call dsl_$retrieve (mrds_dbi, "-range (x entry_name_rel) -select x.manual_number -where x.entry_name = .V.",
	     topic_name, manual_number, code);

	if code ^= 0
	then do;

	     /*** No exact match was found for the given topic_name. Search for
		partial matches if the user so requests. This search is a linear
		search of the entire entry_name_rel relation. */

		if code ^= mrds_error_$tuple_not_found
		then call cleanup_and_abort (code,
			"^/This programming error occurred while searching for ^a.^/Please report this error to your adminstrator."
			, (topic_name));

		code = 0;
		if ^partial_matches_allowed & ^dont_allow_partial_matches
		then do;
			call command_query_$yes_no (yes_sw, 0, myname,
			     "There is no exact match for the topic ""^a"". Do you want^/to see if the topic you've asked about partially matches any^/topics in the data base?"
			     ,
			     "Cannot find the topic ""^a"".  Do you want to search for^/partial matches (this can be a time-consuming search)?"
			     , topic_name);
			if ^yes_sw
			then do;
				call clean_up;
				return;
			     end;
			else call partial_matches;
		     end;
		else if partial_matches_allowed
		then call partial_matches;

	     end;
	else
RETRIEVE_ONLY_EXACT_MATCHES:
	     do;

	     /*** An exact match was found for topic_name. Retrieve all other exact matches. */

		display_info.header.topics_flag = "0"b; /* No need to display what the user typed. */

		do while (code = 0 & number_of_manuals < hbound (manual_array, 1));
		     number_of_manuals = number_of_manuals + 1;
		     manual_array (number_of_manuals) = manual_number;
		     topic_array (number_of_manuals) = "";

		     call dsl_$retrieve (mrds_dbi, "-another", topic_name, manual_number, code);
		end;

		topic_array (1) = topic_name;		/* Since this is an match exact, there is only one topic. */

	     end RETRIEVE_ONLY_EXACT_MATCHES;

	if code ^= 0
	then if code ^= mrds_error_$tuple_not_found
	     then call cleanup_and_abort (code,
		     "^/This programming error occurred while searching for ""^a"".^/Please report this error to your adminstrator."
		     , (topic_name));

	if number_of_manuals = 0
	then call cleanup_and_abort (error_table_$noentry, "^/No information was found about ^a.", (topic_name));

	code = 0;


     /*** Display all manuals in manual_arrray. Use menu to selectively
	display manuals only if there are more than one manual, the video system is
	already on and the user requested textual information be displayed on the terminal. */

	if string (display_info.text) ^= "0"b & number_of_manuals > 1 & video_is_on & ^output_file_sw
	then call setup_menu (use_menu_display);	/* If the menu was set up correctly, use_menu_display is on. */

	if output_file_sw
	then do;

	     /*** Output should be directed to output_file_path. */

		output_switch_name = "online_doc_output" || unique_chars_ ("0"b);
		call iox_$attach_name (output_switch_name, output_ptr, ("vfile_ " || output_file_path || " -extend"),
		     null, code);
		if code ^= 0
		then call cleanup_and_abort (code, "^/Output could not be directed to ^a.", (output_file_path));
		call iox_$open (output_ptr, Stream_output, "0"b, code);
		if code ^= 0
		then call cleanup_and_abort (code, "^/Output could not be directed to ^a.", (output_file_path));
	     end;
	else output_ptr = iox_$user_output;

     /*** Select and display manuals. */

	if use_menu_display
	then call menu_display;
	else call display;


	call clean_up;
RETURN:
	return;

open_data_base:
     proc (mrds_database_path, mrds_dbi, code);

/* This subroutine opens the MRDS database at mrds_database_path and sets  */
/* the online_doc_db_index to the newly opened database's index (mrds_dbi). */

	dcl     mrds_database_path	 char (*);
	dcl     mrds_dbi		 fixed bin (35);
	dcl     code		 fixed bin (35);


	call dsl_$open (mrds_database_path, mrds_dbi, 1, code);
	if code = 0
	then call online_doc_db_index$set_index (mrds_dbi);

	return;

     end open_data_base;
%page;
setup_menu:
     proc (sm_menu_was_created);

/* This subroutine sets up a menu from which manuals are to be selected for */
/* display.  If an error occurs, the screen is cleaned up and the parameter */
/* flag sm_menu_was_created is returned with a value of "0"b.               */

	dcl     sm_menu_was_created	 bit (1) aligned;
	dcl     sm_code		 fixed bin (35) init (0);

	sm_menu_was_created = "0"b;

	headers (1) = "The following manuals match your topic.";
	headers (2) = "On which manuals do you wish to see details?  (Choose one at a time.)";
	trailers (1) = "Type the associated number to select a manual.";
	trailers (2) = "-";

     /*** Get info about the current user_io window. Save a copy, use a copy for user_io and use another copy for menu. */

	user_io_window_info.version = window_position_info_version_1;
	call iox_$control (iox_$user_io, "get_window_info", addr (user_io_window_info), sm_code);
	if sm_code ^= 0
	then call sm_cleanup_and_return;

	current_user_io_window_info = user_io_window_info;
	menu_window_info = user_io_window_info;

     /*** Define format of menu. */

	local_menu_format.version = menu_format_version_1;
	local_menu_format.max_width = user_io_window_info.width;
	local_menu_format.max_height = number_of_manuals + 5;
	local_menu_format.n_columns = 1;
	local_menu_format.center_headers = "1"b;
	local_menu_format.center_trailers = "1"b;
	local_menu_format.pad = "0"b;
	local_menu_format.pad_char = "-";

	local_menu_requirements = menu_requirements_version_1;

     /*** Define an work area in which to allocate choices array. */

	unspec (local_area_info) = "0"b;
	local_area_info.version = 1;
	local_area_info.control.extend = "1"b;
	local_area_info.owner = myname;
	local_area_info.size = sys_info$max_seg_size;
	local_area_info.areap = null;
	call define_area_ (addr (local_area_info), sm_code);
	if sm_code ^= 0
	then call sm_cleanup_and_return;
	work_area_ptr = local_area_info.areap;

     /*** Allocate array of choices */

	number_of_options = number_of_manuals + 1;
	alloc choices in (work_area);

     /*** Carve out menu i/o window from user i/o window.  If there is not at
	least five lines for the display window, don't use menu. */

	if user_io_window_info.height > local_menu_format.max_height + 5
	then do;

	     /*** The current user_io window is large enough to fit a menu window and
		a moderately sized (at least 5 lines) user_io window.  Before shrinking
		the user_io window to make room for the menu window, clear the whole
		current user_io window, in effect clearing the new user_io window and the new
		menu window at the same time. */

		call window_$clear_window (iox_$user_io, sm_code);
		if sm_code ^= 0
		then call sm_cleanup_and_return;

	     /*** Set up the origins and heights of the menu and user_io windows.  The
		menu window will begin where the existing user_io window begins; the new
		user_io window will shrink, taking up what's left of the existing user_io window. */

		menu_window_info.extent.height = local_menu_format.max_height;
		user_io_window_info.origin.line = menu_window_info.origin.line + menu_window_info.extent.height;
		user_io_window_info.extent.height =
		     user_io_window_info.extent.height - menu_window_info.extent.height;
		call iox_$control (iox_$user_io, "set_window_info", addr (user_io_window_info), sm_code);
		if sm_code ^= 0
		then call sm_cleanup_and_return;

	     /*** Create the menu window.  An iocb is needed first. */

		menu_io_switch_name = "menu_i/o" || unique_chars_ ("0"b);
		call iox_$find_iocb (menu_io_switch_name, menu_io_ptr, sm_code);
		if sm_code ^= 0
		then call sm_cleanup_and_return;

		call window_$create (video_data_$terminal_iocb, addr (menu_window_info), menu_io_ptr, sm_code);
		if sm_code ^= 0
		then call sm_cleanup_and_return;

	     /*** Set up contents of menu. */

		do choices_idx = 1 to number_of_manuals;
		     call dsl_$retrieve (mrds_dbi,
			"-range (x full_name_rel) -select x.full_name -where x.manual_number = .V.",
			manual_array (choices_idx), choices (choices_idx), sm_code);
		end;

		choices (number_of_options) = "None of the above / No More";

		do choices_idx = 1 to number_of_manuals;
		     choices (choices_idx) = translate (choices (choices_idx), " ", "_");
		end;
		call menu_$create (choices, headers, trailers, addr (local_menu_format), MENU_OPTION_KEYS,
		     work_area_ptr, addr (local_menu_requirements), menu_ptr, sm_code);
		if sm_code ^= 0
		then call sm_cleanup_and_return;

		call menu_$display (menu_io_ptr, menu_ptr, sm_code);
		if sm_code ^= 0
		then call sm_cleanup_and_return;

		sm_menu_was_created = "1"b;
	     end;

SM_RETURN:
	return;

sm_cleanup_and_return:
     proc;

     /*** Return instead of aborting because information can still be display
	without a menu. */

	call cleanup_screen;
	goto SM_RETURN;

     end sm_cleanup_and_return;

     end setup_menu;
%page;

menu_display:
     proc;

/* This subroutine displays information about manuals selected from a */
/* menu.  The menu must already be set up (at menu_io_ptr).               */

	dcl     md_code		 fixed bin (35) init (0);

	choice_flag = "1"b;
	display_info.display_leading_blank_line = output_file_sw;

	do while (choice_flag);
	     call menu_$get_choice (menu_io_ptr, menu_ptr, null, fkey, choice, md_code);
	     if md_code ^= 0
	     then call cleanup_and_abort (md_code, "Unable to get menu choice.^s", "");
	     if fkey
	     then call window_$bell (menu_io_ptr, 0);
	     else if choice < number_of_options
	     then do;
		     manual_number = manual_array (choice);
		     call window_$clear_window (output_ptr, md_code);
		     if md_code ^= 0
		     then call complain (md_code, myname);
		     call display_doc (output_ptr, mrds_dbi, manual_number, display_info_ptr, (topic_array (choice)),
			md_code);
		     if md_code ^= 0
		     then call complain (md_code, myname);
		end;
	     else if choice = number_of_options
	     then do;				/* No mas! No mas! Quit out of menu */
		     choice_flag = "0"b;
		     call cleanup_screen;
		end;
	     else call window_$bell (menu_io_ptr, 0);
	end;

     end menu_display;
%page;

display:
     proc;

/* This subroutine display information about the manuals in manual_array. */
/* This subroutine is used for displaying without menus.                  */

	dcl     d_code		 fixed bin (35) init (0);

	display_info.display_leading_blank_line = "1"b;

	do manual_idx = 1 to number_of_manuals;

	     manual_number = manual_array (manual_idx);
	     call display_doc (output_ptr, mrds_dbi, manual_number, display_info_ptr, (topic_array (manual_idx)),
		d_code);
	     if d_code ^= 0
	     then call complain (d_code, myname, "^/A manual could not be displayed.");

	end;
     end display;
%page;
partial_matches:
     proc;

/* This subroutine searches for entry_names which "partially match" the    */
/* topic name. An entry_name is a partial match if it contains topic name. */

	code = 0;
	display_info.header.topics_flag = "1"b;

	call dsl_$retrieve (mrds_dbi, "-range (x entry_name_rel) -select x.entry_name x.manual_number", entry_name,
	     manual_number, code);

	if code ^= 0
	then if code = mrds_error_$tuple_not_found
	     then call cleanup_and_abort (error_table_$noentry, "^/The online_doc database contains no data.^s", "");
	     else call cleanup_and_abort (code, "^/Unable to access the data base.^s", "");


RETRIEVE_EACH_TUPLE_LOOP:
	do while (code = 0 & number_of_manuals < hbound (manual_array, 1));
	     if index (entry_name, topic_name) ^= 0
	     then do;
		     do manual_idx = 1 to number_of_manuals while (manual_array (manual_idx) ^= manual_number);
		     end;
		     if manual_idx > number_of_manuals
		     then do;
			     number_of_manuals = number_of_manuals + 1;
			     manual_array (number_of_manuals) = manual_number;
			     topic_array (number_of_manuals) = rtrim (entry_name);
			end;
		end;

	     call dsl_$retrieve (mrds_dbi, "-another", entry_name, manual_number, code);

	end RETRIEVE_EACH_TUPLE_LOOP;

	return;

     end partial_matches;
%page;
/* cleanup procedures */

cleanup_and_abort:
     proc (p_code, p_err_msg, p_err_msg_arg);

	dcl     p_code		 fixed bin (35);
	dcl     p_err_msg		 char (*) var;
	dcl     p_err_msg_arg	 char (*);

	if video_is_on
	then call cleanup_screen;
	call clean_up;
	call complain (p_code, myname, p_err_msg, p_err_msg_arg);
	goto RETURN;

     end cleanup_and_abort;

cleanup_all:
     proc;

	call cleanup_screen;
	call clean_up;

     end cleanup_all;

clean_up:
     proc;

	dcl     cu_code		 fixed bin (35) init (0);

	if output_ptr ^= null & output_file_sw
	then do;
		call iox_$close (output_ptr, (cu_code));
		call iox_$detach_iocb (output_ptr, (cu_code));
	     end;

	if mrds_scope_set
	then call dsl_$dl_scope_all (mrds_dbi, (cu_code));
	if current_mrds_dbi ^= 0 & current_mrds_dbi ^= mrds_dbi
	then call dsl_$close (current_mrds_dbi, (cu_code));
	if work_area_ptr ^= null
	then call release_area_ (work_area_ptr);

     end clean_up;

cleanup_screen:
     proc;

	if video_is_on
	then do;
		if menu_io_ptr ^= null ()
		then call window_$destroy (menu_io_ptr, (0));
		if current_user_io_window_info.version = window_position_info_version_1
		then call iox_$control (iox_$user_io, "set_window_info", addr (current_user_io_window_info), (0));
		if menu_io_ptr ^= null
		then call window_$clear_window (iox_$user_io, code);
	     end;


     end cleanup_screen;



%page;
%include display_doc_info;
%page;
%include window_dcls;
%page;
%include menu_dcls;
%page;
%include iox_dcls;
%page;
%include iox_modes;
%page;
%include area_info;
%page;
%include window_control_info;

     end where_doc;





		    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
