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) = "<<>>"; 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) = "<<>>"; 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) = "<<>>"; 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) = "<<>>"; 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) = "<<>>"; 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) = "<<>>"; 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) = "<<>>"; 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) = "<<>>"; 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