



		    PNOTICE_xforum.alm              10/27/88  1532.0r w 10/27/88  1532.0        2448



	dec	1			"version 1 structure
	dec	1			"no. of pnotices
	dec	3			"no. of STIs
	dec	56			"lgth of all pnotices + no. of pnotices
          acc       "Copyright, (C) Honeywell Information Systems Inc., 1988"

	aci	"C1EFSM0E0000"
	aci	"C2EFSM0E0000"
	aci	"C3EFSM0E0000"
	end




		    xforum.pl1                      09/13/88  1325.8rew 09/13/88  1257.6      397413



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



/****^  HISTORY COMMENTS:
  1) change(85-01-08,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed calling sequence of xforum_multics_mode to remove
     the handle_interactive_messages_flag. Also changed the calling sequence of
     xforum_help_$get_help to remove the handle_interactive_messages_flag and
     the function_key_data_ptr. Changed calling sequence of
     xforum_window_mgr$menu_get_choice to remove the arguments
     function_key_data_ptr and handle_interactive_messages. Changed test to
     call xforum_multics_mode to use xforum_user_profile$get_multics_mode
     instead of args.multics_mode. Note that the value of the flag
     returned by get_multics_mode can be changed within the loop that the test
     is being made in.
  2) change(85-01-10,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed call to xforum_process_args_ so that the args structure is no
     longer passed in. Instead just a pointer to the arg_list is input.
     Removed all the calls to xforum_user_profile$set that were based on the
     values in the args structure (this is now done by the
     xforum_process_args_ routine). Now setting values in the
     local_xforum_info structure by calling the appropriate
     xforum_user_profile$get routine. Took the arg_list_ptr and the ptrs
     elements out of the xforum_args structure and made them independent.
     Removed the reference to xforum_args.incl.pl1.
     
     85-01-14 Davids: replaced calls to accept_messages, print_messages, and
     defer_messages with calls to xforum_im_mgr$init, defer_messages, and
     restore_messages.
     
     85-01-18 Davids: Changed version to 1.1c
     
     85-01-23 Davids: Changed version to 1.1d
     
     85-01-24 Davids: Increased the hbound of ptrs from 2 to 3 to accommodate
     the segment used to hold the set_array.
  3) change(85-02-01,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed to version 1.1e.
     
     85-02-06 Davids: Replaced call to xforum_main_options$getting_started with
     call to xforum_getting_started.
     
     85-02-13 Davids: Replaced calls to xforum_getting_started and
     xforum_personalize to xforum_getting_started_menu and
     xforum_personalize_menu
     
     85-02-13 Davids: Changed calling sequence of xforum_help_line_$change
     to include the new F3_message argument.
     
     85-02-14 Davids: Changed the call to xforum_getting_started_menu to
     xforum_help_menus$getting_started. Added the call to
     xforum_help_line_$init;
     
     85-02-18 Davids; Changed to version 1.1f
     
     85-03-06 Davids: Moved the code that nulls xforum_meeting_list_ptr,
     xforum_menu_ptr, and spy_ptr so that it is after the check for a
     recursive call. Nulling xforum_meeting_list_ptr before the call ment
     that after the failure and a return to the first invocation of xforum
     a null pointer fault would happen almost immediately.
  4) change(85-03-07,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed version to 1.1g
     
     85-04-04 Davids: Changed version to 1.1h
     
     85-04-15 Davids: Changed version to 1.1i
     
     85-04-22 Davids: Added xt_cleanup_flag paramater to the call of the
     xforum_im_mgr$restor_origial entry.
     
     85-05-08 Davids: Added comments to all variable declarations and removed
     some declared but not used variables.
     
     85-05-21 Davids: Removed reference to xforum_menu_info.incl.pl1
     it was not being used.
  5) change(86-02-21,LJAdams), approve(86-02-21,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Repositioned call to xforum_help_$init to avoid abort with invalid sci_ptr
     when terminating because of an error in xforum profile.
  6) change(86-05-01,LJAdams), approve(86-05-01,MCR7350),
     audit(86-05-01,Gilcrease), install(86-05-06,MR12.0-1053):
     Changed version number to 2.0.
  7) change(87-04-10,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Changed to allow command_processor_ escapes.  Changed version to 2.1.
  8) change(88-08-09,LJAdams), approve(88-08-09,MCR7766),
     audit(88-08-14,GDixon), install(88-09-13,MR12.2-1109):
     Moved the setting of Shelp switch prior to the call to xforum_help_$init.
                                                   END HISTORY COMMENTS */


executive_forum:
xforum:
     proc;

/*
   BEGIN DESCRIPTION

   function:
      This is the main module of the xforum package. It coordinates the
      calls to lower level routines which perform the initialization
      of the system and the termination of the system. It also creates
      and displays the main menu and processes the user's menu selection.

   description of entry points:
      executive_forum, xforum:
          input:
          output:
          Main entry point.

      reconnect_test:
          input:   
          output:  returns bit (1) aligned, "1"b implies that the current
                     condition frame on the stack is a quit and that the
                     reconnect_quit switch is set to indicate that the quit
                     was caused as a result of a reconnection.
          The reconnect_test entry point is used by the emacs extension to
          determine if a quit is the result of the user hitting the BREAK key
          or a reconnection. It returns a true if the quit was caused by a 
          reconnection. It returns false if the quit was caused by some other
          reason.

   description of internal procedures:
      xforum_terminate: coordinates the termination of the facility. It is
         called during both normal termination and during a cleanup. The
         cleanup_flag is used to distinguish the two. Note that the only
         menu that needs to be destroyed is the main menu. The other menus
         are destroyed in the lower level routines that created them.

      collect_spy_data: records the users choice in a special spy structure.
         The record includes an index which counts the users responses, an
         identifier which indicates what the user is responding to, i.e.
         main menu, help prompt, and the users response.

      record_spy_data: moves the data collected in the spy structure from the
         segment in the users process dir to a segment in
         >udd>m>cp>Davids>xforum>spy directory. No error is reported if some
         reason the data cannot be moved i.e. the directory does not exist.

      fatal_error: is called in response to the xforum_fatal_error
         condition being signaled. It locates the information structure
         associated with the condition and calls xforum_error with the code
         and message from the structure.

      xforum_error: shuts down xforum and reports an error to the user. Xforum
         must first be shut down so that the user can see the error message.
         If the message is displayed and the system then shut down the message
         will be cleared off the screen to fast to read.

      check_for_reconnect: calls find_condition_info_ to get the info pointer
         for the quit condition. It then checks the reconnection_quit switch
         in the quit_info structure.

   known bugs:

   notes:

   history:

      83-11-?? Deryk Barker: Originally coded
   
      84-03-27 Davids: Modified to check the value of forum_version
      before adding the .control suffix to the meeting path. If the
      value of forum_version is 2 the suffix .forum is added instead.
      Modified the call to xforum_find_path_ to include the forum_version
      parameter. The call is first made with the version set to 1 and if
      an error occurs it is tried again with the version = 2. If that fails
      an error is reported to the user
   
      84-03-28 Davids: Added forum_version parameter to display_trans,
      next_trans, and next_ref so that the correct forum_ entry for setting
      the "seen" value could be called. Changed the order of the calls to
      close_meeting and forum_$set_switch_index when the user selected to 
      resign from a meeting in the attend_meeting proc so that the call to
      set_switch_indx is made before the call to close. This fixes the problem 
      of not have a resignation recorded by forum. Modified so that the changed
      flag is updated when the user attends a meeting. The flag for
      participation/remove was already updated. This is needed if the user was 
      previously not a participant. Added code to send a silent message to a
      special mailbox to record the fact that someone used xforum.
   
      84-05-02 Davids: Modified the text of QUERY_USAGE to include "To return
      to top menu press BREAK". Also modified the usage_msg to include "To
      quit, press ESC, then ""q""" and "To quit, press F4". Added a "To return
      to top menu press BREAK" message when a dynamic menu is displayed, there
      used to be no message displayed. Moved code that starts up the video 
      system so that its the first thing so that it can write out a "Executive 
      Forum is setting up - be patient" message immediately. Also added code in
      xforum_terminate to clear user_io after it restores it to its original
      size. Also removed code appearing after the exit_xforum label and the
      call to xforum_terminate code that cleared the window - this only worked 
      if the process was in the video system to start with.
   
      84-05-03 Davids: Modified the help line when in the editor so that it
      indicates that BREAK is used to abort the transaction being entered.
      Changed the condition on length of meeting names from 20 to 26 characters
      - version 2 forums can have longer names than version 1 forums. Changed
      the length of the varaibles that will hold those names from 20 to 26.
      Changed the length of the headers from 38 to 44 to be able to handle the
      extra length. Changed Version to 1.6.
   
      84-05-22 Davids: Moved the call to menu_$destroy to the xforum_terminate
      procedure instead of leaving it as the next thing after the call to
      xforum_terminate at the exit_xforum_label. Also added a call to
      window_$sync after the call to clear the user_io window in 
      xforum_terminate so that the ready message is not lost when you exit
      xforum. Reformated the text on the help line so that F3 could be added.
      Added code to leave the cursor positioned two lines down from the getting
      set up message and in column 1 so that error messages start off at the
      left margin. Changed the last occurance of Use to Press (at least I hope
      its the last). Removed the call to clear the menu window right before the
      call to display the attending meeting menu. This means that the attending
      menu meeting will no longer be redrawn ever time you enter a new meeting.
   
      84-05-24 Davids: Added code to the internal proc get_to_cl to create
      a special multics_mode status window and resize user_io to use most of
      the screen. Also changed the pi handler to destroy the status window
      and resize user_io. This code doesn't work. It clears the user_io
      window which it is not suppose to do and dies badly with the attending
      meeting menu.
   
      84-05-30 Davids: Added code to the pi handler in the attend_meeting
      internal proc and changed the handler in the main xforum proc to
      correctly handle the return from multics mode. The status window is
      destroyed and the user_io window is correctly shrunk, the status info and
      menu are redisplayed. The text in the user_io window that does not
      overlap the menu window is left on the screen. Note that there are still
      circumstances when the user_io window will be cleared when it is
      increased as the user gets into Multics mode. No idea why. Also modified
      the xforum_terminate internal proc to destroy the xforum status window
      (as opposed to the multics mode status window) It has not been doing
      this.
   
     84-06-01 Davids: Removed the call to window_$sync in xforum_terminate it
     was doing no good. The probelm with the lost screens was that my message
     handler was not clearing the status flag. Why this did not effect xmail I
     have no idea.
   
     84-06-05 Davids: Modified xforum_terminate to call two new internal procs.
     output_shut_down_msg is used to restore the original user_io window and
     then output a Executive Forum is shutting down - be paitent message. It
     takes a while to shut down and the user was not given any feedback that
     his F4 was accepted. The record_spy_data routine looks for the directory
     >udd>m>cp>Davids>xforum>spy. If it finds it, it creates a <unique_chars>
     segment in the dir and places in it a copy of the spy structure.
     Also changed the version to 1.7 and removed the call to
     send_message_silent. That form of usage recording is not needed with the
     spy code.
   
     84-06-06 Davids: Added calls to collect_spy_data after all calls to
     menu_$get_choice, xforum_dyn_menu_$get_choice, xforum_help_$get_choice
     and iox_$get_line, and in the quit handlers. This will record the current
     state and the users input.
   
     84-06-07 Davids: Added copy of reconnect_test and associated internal
     procs so that emacs extension can determine that a reconnect has occured.
     Code was copied from xmail_window_manger_.
   
     84-06-12 Davids: Added calls to check_window_status as first thing done
     in all quit handlers. This allows reconnections to work right. Added
     an any_other hander to get_to_cl. This prevents the xforum quit handlers
     to be invoked when quit is signaled in multics mode. Modified xforum_error
     to goto error_exit_xforum instead of just exit_xforum. exit_xforum calls
     xforum_terminate which xforum_error has already done. This second call
     clears the error message from the screen. The error_exit_xforum label
     was added after the exit_xforum label - right after the call to
     xforum_terminate and before return.
   
     84-06-14 Davids: Modified so that xforum_menu_ptr is set to null as one
     of the first things done and in xforum_terminate before the call to
     menu_$destroy the pointer is checked and the call made only if its
     non-null. Changed the start up message to "Executive Forum is setting up -
     Menu will be displayed shortly." and the shut down message to "Executive
     Forum is shutting down - Screen will clear shortly." Changed the version
     to 1.8
   
     84-06-19 Davids: Modified so that all window recreation or changes are
     done via calls to xforum_window_mgr. The invocation and termination of the
     video system and the output of the starting up and shutting down messages
     are also done via the xforum_window_mgr module. The condition xforum_error
     was added to handle fatal errors. Changed the version to 1.9.
   
     84-06-21 Davids: Removed window management take took place before and
     after multics mode and replaced with calls to xforum_window_mgr.
   
     84-06-28 Davids: Removed the internal procedures display_trans,
     enter_trans, next_trans, prev_trans, list_trans, select_trans, next_ref,
     prev_ref, and first_ref and replaced them with calls to the corresponding
     xforum_attend_mtg_options entries. Also changed the version to 2.0.
   
     84-07-05 Davids: replaced calls to menu_$display and menu_$get_choice with
     xforum_window_mgr$menu_display and xforum_window_mgr$menu_get_choice.
     Changed version to 2.1.
   
     84-07-06 Davids: added calls to xforum_status_$update_title to output what
     used to be the menu header. Removed the header parameter from the calls to
     xforum_create_menu_
   
     84-07-10 Davids: Removed internal procedures goto_meeting,
     resign_from_meeting, next_meeting, list_meetings, get_choice_from_menu,
     find_meeting, and prompt_help and replaced then with calls to the
     corresponding xforum_main_option entries.
   
     84-07-25 Davids: Extensively changed Multics mode. Now instead of just
     pushing a new command level what happens is that a prompt is issued and
     the user enters the command. When the command fishes executing a prompt is
     issued again. To return to xforum the user enters a null command, i.e.
     just presses the return key. The help line displays the command being
     executed or if the user is at the prompt a longer version of the prompt.
     Currently the prompts are just filler text because I cannot think of
     really good prompts yet.
   
     84-07-26 Davids: Modified so that the xforum_meeting_info_ptr is obtained
     from args.ptrs (1) instead of arg.ptrs (2). ptrs (1) used to be the 
     xforum_meeting_list_ptr ptr. Modified the xforum_terminate so that it
     just always frees ptrs (1) instead of testing args.meeting_list first.
     The xforum_meeting_list segment is used for the life of the process.
     Modified the get_to_cl routine so that it traps certain conditions and
     prints the error message that the system would. This prevents a new stack
     frame from being pushed. Certain conditions have to be let though.
     Its probably best if get_to_cl is an external routine. It will more than
     likely have to be modified several times before the list of what
     conditions trap and what to let though is correct.
   
     84-07-27 Davids: Replaced calls to internal proc get_to_cl with calls to
     external proc xforum_multics_mode. Removed from the program_interrupt
     handler the code dealing with a return from multics mode and placed the
     code after the call to xforum_multics_mode. Deleted the multics_mode_flag.
   
     84-07-30 Davids: Changed version to 3.0
   
     84-07-31 Davids: Modified so that the help messages conform with the MTB
     and so that title is separated from the pad character by a space.
   
     84-08-13 Davids: Changed version to 3.1. Changed Meetings to Eligible in
     the banner. Added code to handle interactive messages. If the
     handle_interactive_messages flag is set then messages will be defered
     during  startup and accepted again during termination. Also the flag is
     passed to xforum_multics_mode and xforum_window_mgr_$menu_get_choice.
   
     84-08-14 Davids: Changed the main menu to conform to the MTB.
     This deleted the "Resign from Meeting", "Next Attended Meeting", "List
     Meetings", "List Changed Meetings", and "List Attended Meetings" options.
     Added a call to xforum_user_profile$get to set up the profile (currently
     not used) and set the first time flag. 
   
     84-08-15 Davids: Replaced the long argument lists of xforum_main_options
     by a ptr to a structure which is loaded with the information. Also cleaned
     up the dcls. Deleted the internal procs get_help and general_help.
     Replaced get_help with xforum_get_help.
   
     84-08-16 Davids: Replaced calls to xforum_get_help with calls to
     xforum_help_$get_help. Updated the attending meeting menu to reflect the
     MTB and changed the code handling the users choice accordingly.
   
     84-08-29 Davids: Removed the attend_meeting internal proc (moved it to
     xforum_main_options). Added the exit_executive_forum condition handler
     and setting of xforum_info.main_options.use_alternate_fkeys, multics_mode,
     and handle_interactive_messages. These were needed to make the move work
     correctly. Also added the code for correctly handling the getting started
     menu.
   
     84-08-30 Davids: Finally added an xforum_fatal_error handler. Added the
     parameter xt_clean_up flag to xforum_terminate. This value is passed
     to the window_mgr routines call by terminate to control terminal i/o.

     84-09-04 Davids Changed version to 4.0

     84-09-17 Davids: Added code for processing upper case escapse sequences.
     This include declaring XXX2 constants and using them where ever the XXX
     constants are used.

     84-09-25 Davids: Removed references to xforum_trans_array. The array is
     being deleted because it enforces an upper limit on the number of
     transaction that xforum can handle.

     84-09-28 Davids: Removed all references to usage messages and
     xforum_status_$update_usage and redisplay_usage. Replaced them with
     a reference to xforum_help_line.

     84-10-01 Davids: Removed the determination of whether function keys or
     escapse sequences can be used. Replaced it with calls to
     xforum_user_profile. Still make a call to set the value of the
     function_key_data_ptr. This should be removed and calls to
     xforum_user_profile$get_function_key_data_ptr used where the ptr is
     actually needed. However I do not have the time do do that now.

     84-10-02 Davids: Added a call to xforum_user_profile$set_use_function_keys
     with the new arggs element escape_sequences. Added the spy_ptr parameter
     to the xforum_list_meetings$process_args_ call and removed the code that
     created the xforum_spy segment in the pdir.

     84-10-03 Davids: Changed a call from get_temp_segment_ to
     get_temp_segments_ the extra segment is for the seen_map.
     Change release_temp_segment_ to segments_ as well.

     84-10-16 Davids: Updated version to 5.0

     84-10-17 Davids: Changed versions to 5.1

     84-10-22 Davids: Changed message handling so that it is the same as
     Xmail's, except for the -brief control arg for print_messages. Xforum
     will not start using the MR11 message system control args until after a
     controlled release tape is cut.

     84-10-22 Davids: A new version (including todays changes) was installed
     in EXL so the development version's version has been changed to 5.2.

     84-10-25 Davids: Added the xforum_already_active variable. This is
     internal static, inited to "0"b. The first thing xforum does is to see
     if this variable is true. if it is an error message is output. The value
     is set to true immediately after the cleanup routine is established.
     The cleanup routine re-sets it to false.

     84-10-25 Davids: A new version (including todays changes) was installed
     in EXL so the development version's version has been changed to 5.3.

     84-10-29 Davids: A new version (including todays changes) was installed
     in EXL so the development version's version has been changed to 5.4.

     84-11-06 Davids: Changed references to xforum_list_meetings to
     xforum_list_meetings_. Also all references to xforum_help_line to
     xforum_help_line_

     84-11-13 Davids: Version changed to 5.5

     84-11-15 Davids: Auditing changes: 1) Corrected messages to start with an
     upper case letter and end with some puncuation. 2) replaced calls to
     hcs_$make_seg  with calls to initiate_file_$create. 3) Cleaned up dcls so
     that unrefered variables are deleted and undcled builtins are declared.
     Other changes: 1) Reorganized dcls into the standard format.

     84-11-16 Davids: Added the "-brief" argument to the call to
     print_messages This is needed so that the call does not result in a "You
     have no messages" message being output. print_message was incompatibly
     changed.

     84-11-19 Davids: Changed version to 5.6

     84-12-06 Davids: Modified so that xforum_help_$init is called before
     xforum_main_options$getting_started. If the help structure is not
     initiated very strange things will happen when in getting started menu -
     not to friendly. Also changed versions to 1.1a.

     84-12-14 Davids: Changed version to 1.1b


   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     com_err_		 entry () options (variable);
	dcl     cu_$arg_list_ptr	 entry (ptr);
	dcl     find_condition_frame_	 entry (ptr) returns (ptr);
	dcl     find_condition_info_	 entry (ptr, ptr, fixed bin (35));
	dcl     get_system_free_area_	 entry () returns (ptr);
	dcl     get_temp_segments_	 entry (char (*), (*) ptr, fixed bin (35));
	dcl     hcs_$status_minf	 entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35));
	dcl     initiate_file_$create	 entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));
	dcl     xforum_create_menu_	 entry ((*) char (*) var, ptr, ptr, fixed bin (35));
          dcl     xforum_get_str_	 entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
          dcl     xforum_get_str_$init	 entry options(variable);
	dcl     xforum_help_$get_help	 entry (ptr, char (*), (*) char (*) var, ptr, ptr);
	dcl     xforum_help_$init	 entry options(variable);
	dcl     xforum_help_$term	 entry options (variable);
	dcl     xforum_help_line_$change entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_help_line_$init entry;
	dcl     xforum_help_menus$getting_started entry (ptr, ptr);
	dcl     xforum_im_mgr$defer_messages entry ();
	dcl     xforum_im_mgr$init	 entry ();
	dcl     xforum_im_mgr$restore_original entry (bit (1) aligned);
	dcl     xforum_main_options$goto_meeting entry (ptr);
	dcl     xforum_main_options$modify_meeting_list entry (ptr);
	dcl     xforum_main_options$next_meeting entry (ptr);
	dcl     xforum_multics_mode	 entry (fixed bin);
	dcl     xforum_personalize_menu entry (ptr, ptr);
	dcl     xforum_list_meetings_$xforum_process_args_ entry (ptr, char (*), ptr, fixed bin (35));
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_status_$initialize
				 entry options (variable);
	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     xforum_status_$update_total entry (char (*));
	dcl     xforum_status_$update_title entry (char (*));
	dcl     xforum_status_$update_new entry (char (*));
	dcl     xforum_status_$update_banner entry (char (*));
	dcl     xforum_user_profile$get entry (bit (1) aligned);
	dcl     xforum_user_profile$get_function_key_data_ptr entry () returns (ptr);
	dcl     xforum_user_profile$get_menu_always entry () returns (bit (1));
	dcl     xforum_user_profile$get_multics_mode entry () returns (bit (1));
	dcl     xforum_user_profile$get_handle_interactive_messages entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$menu_display entry (ptr);
	dcl     xforum_window_mgr$menu_get_choice entry (ptr, bit (1) aligned, fixed bin);
	dcl     xforum_window_mgr$prepare_to_shut_down entry (bit (1));
	dcl     xforum_window_mgr$shut_down_xforum_windows entry (bit (1));
	dcl     xforum_window_mgr$resynch_windows entry (fixed bin, bit (1));
	dcl     xforum_window_mgr$set_up_xforum_windows entry options (variable);

/* CONDITIONS */

	dcl     (
	        cleanup,
	        exit_executive_forum,
	        program_interrupt,
	        quit,
	        xforum_fatal_error,
	        xforum_redisplay_menu
	        )			 condition;

/* INTERNAL AUTOMATIC */

	dcl     x_arg_list_ptr	 ptr;		/* points to list of args that xforum was invoked with */
	dcl     x_choice		 fixed bin;	/* user's choice from the menu or function key */
	dcl     x_code		 fixed bin (35);	/* standard error code */
	dcl     x_first_time_user	 bit (1) aligned;	/* "1"b if this is the very first time the user has used xforum */
	dcl     x_fkey		 bit (1) aligned;	/* "1"b if choice stands for which function key was presswed */
	dcl     x_menu_window_height	 fixed bin;	/* number of lines used by the menu */
	dcl     x_ptrs		 (3) ptr;		/* used to get pointers to temp segments */
	dcl     x_xforum_banner	 char (40);	/* second line of status window for main menu */
	dcl     x_xforum_menu_ptr	 ptr;		/* pointer to the main menu */
	dcl     1 x_xforum_info	 like xforum_info;	/* structure used to give data to xforum_main_options entries */
	dcl     1 x_xforum_menu_requirements like menu_requirements; /* used to tell menu_ what the menu looks like */
          dcl     Shelp                  bit(1);		/* indicates if help has been initialized	*/
          dcl     Serror		 bit(1);
						

/* INTERNAL STATIC */

	dcl     x_xforum_already_active bit (1) init ("0"b) internal static;
						/* "1"b imples that xforum is already on the stack */

/* CONSTANTS */

	dcl     (
                  ANSWER_LENGTH          fixed bin init (256),
                                                            /* maximum length for response */
	        x_FIRST_MENU	 fixed bin init (2),/* fkey choice for F2 or ESCf */
	        x_FIRST_MENU2	 fixed bin init (9),/* fkey choice for ESCF */
	        x_HELP		 fixed bin init (1),/* fkey choice for F1 or ESC? */
	        x_ME		 char (6) init ("xforum"), /* name used in messages */
	        x_MULTICS		 fixed bin init (8),/* fkey choice for F8 or ESCe */
	        x_MULTICS2		 fixed bin init (15), /* fkey choice for ESCE */
	        x_PREV_MENU		 fixed bin init (3),/* fkey choice for F3 or ESCp */
	        x_PREV_MENU2	 fixed bin init (10), /* fkey choice for ESCP */
	        x_QUIT		 fixed bin init (4),/* fkey choice for F4 or ESCq */
	        x_QUIT2		 fixed bin init (11), /* fkey choice for ESCQ */
	        x_REDISPLAY		 fixed bin init (5),/* fkey choice for F5 or ESCr */
	        x_REDISPLAY2	 fixed bin init (12), /* fkey choice for ESCR */
	        x_CHOICES		 (7) char (38) varying init (
				 "Go To Changed Meeting",
				 "Go To Attended Meeting",
				 "Go To Eligible Meeting",
				 "Go To Next Changed Meeting",
				 "Modify Meeting List",
				 "Personalize Exec Forum",
				 "Getting Started"),/* options in main menu */
	        x_HEADERS		 (1) char (33) varying init ("Executive Forum (Version 2.1)")
						/* first line of main menu status window */
	        )			 internal static options (constant);

/* BUILTINS */

	dcl     (
	        addr,
	        char,
	        ltrim,
	        null,
	        rtrim
	        )			 builtin;


/* BASED */

/* INCLUDE FILES */

%include access_mode_values;
%page;
%include condition_info;
%page;
%include condition_info_header;
%page;
%include forum_dcls;
%page;
%include forum_flags;
%page;
%include forum_info;
%page;
%include forum_user_trans;
%page;
%include function_key_data;
%page;
%include iox_dcls;
%page;
%include menu_dcls;
%page;
%include quit_info;
%page;
%include terminal_info;
%page;
%include window_dcls;
%page;
%include xforum_data_;
%page;
%include xforum_error_info;
%page;
%include xforum_info;
%page;
%include xforum_meeting_info;
%page;
%include xforum_meeting_list;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;
%page;
%include xforum_windows;
%page;
%include xforum_prompts;


%include xforum_answers;




          answer_array.N = 0;
          answer_array.max_length = ANSWER_LENGTH;

	if x_xforum_already_active
	then do;
	     call ioa_ ("Executive Forum may not be called recursively.^/To re-enter Executive Forum logout and log back in.");
	     goto error_exit_xforum;
	end;
          else do;
	   Shelp = "0"b;				/* help has not yet been initialized		*/
	   Serror = "0"b;
	   end;

	on xforum_fatal_error
	   begin;
	   if Serror then do;			/* because of new block activation revert	*/
						/* will not work				*/
	      call ioa_ ("^/^10x A fatal error has occured. Please restart xforum^/");
	      call xforum_get_str_ ((RETURN_PROMPT), addr(answer_array), "", "", "", x_code);
	      goto error_exit_xforum;
	    end;
	   Serror = "1"b;
	   call fatal_error;
	   end;

	xforum_meeting_list_ptr = null ();
	x_xforum_menu_ptr = null ();
	spy_ptr = null ();

	call cu_$arg_list_ptr (x_arg_list_ptr);

	on cleanup
	   begin;
	   call xforum_terminate ("1"b);
	   call ioa_ ("^/^10x A fatal error has occured. Please restart xforum^/");
	   call xforum_get_str_ ((RETURN_PROMPT), addr(answer_array), "", "", "", x_code);
	   end;

	x_xforum_already_active = "1"b;

	call xforum_window_mgr$set_up_xforum_windows;
						/* set up xforum windows (and video if necessary) */

	Shelp = "1"b;
	call xforum_help_$init;			/* initialize help_ system			*/

	call xforum_user_profile$get (x_first_time_user);

	call xforum_list_meetings_$xforum_process_args_ (x_arg_list_ptr, x_ME, spy_ptr, x_code);
	if x_code ^= 0 then do;
	     call xforum_terminate ("0"b);
	     return;
	end;

	call xforum_help_line_$init;

	call xforum_im_mgr$init;

	call xforum_get_str_$init;
	 
	if xforum_user_profile$get_handle_interactive_messages ()
	then call xforum_im_mgr$defer_messages;

	if xforum_meeting_list.no_selected = 0 then
	     call xforum_error (0, "No meetings were selected.");

	call get_temp_segments_ (x_ME, x_ptrs, x_code);
	if x_code ^= 0 then do;
	     call com_err_ (x_code, x_ME, "Trying to get temp segments for forum list.");
	     return;
	end;

	xforum_meeting_info_ptr = x_ptrs (1);
	xforum_meeting_info.seen_map_ptr = x_ptrs (2);
	xforum_meeting_info.set_array_ptr = x_ptrs (3);

	xforum_system_area_ptr = get_system_free_area_ ();

	call xforum_status_$initialize;

	function_key_data_ptr = xforum_user_profile$get_function_key_data_ptr ();

	on exit_executive_forum goto exit_xforum;
 
	x_xforum_info.main_options.xforum_mtg_list_ptr = xforum_meeting_list_ptr;
	x_xforum_info.main_options.xforum_sys_area_ptr = xforum_system_area_ptr;
	x_xforum_info.main_options.function_key_data_ptr = function_key_data_ptr;
	x_xforum_info.main_options.spy_ptr = spy_ptr;
	x_xforum_info.main_options.menu_always_flag = xforum_user_profile$get_menu_always ();
	x_xforum_info.main_options.use_alternate_fkeys = "1"b;
	x_xforum_info.main_options.multics_mode = xforum_user_profile$get_multics_mode ();
	x_xforum_info.main_options.handle_interactive_messages = xforum_user_profile$get_handle_interactive_messages ();

	if x_first_time_user
	then call xforum_help_menus$getting_started (spy_ptr, xforum_system_area_ptr);

	call ioa_$rsnnl ("Eligible ^d, Attended ^d, Changed ^d",
	     x_xforum_banner, (0), no_selected, no_participant, no_changed);

	call xforum_status_$update_banner (x_xforum_banner);

	call xforum_status_$update_title ((x_HEADERS (1)));

	call xforum_help_line_$change ("10010000"b, "", "", "");

	call xforum_status_$redisplay (x_code);
	if x_code ^= 0 then
	     call xforum_error (x_code, "Unable to display in status window.");

/* create the xforum menu */

	x_xforum_menu_requirements.version = menu_requirements_version_1;

	call xforum_create_menu_ (x_CHOICES, addr (x_xforum_menu_requirements), x_xforum_menu_ptr, x_code);

	if x_code ^= 0 then
	     call xforum_error (x_code, "Unable to create menu.");

	call xforum_window_mgr$resynch_windows (x_xforum_menu_requirements.lines_needed, "1"b);


/* display xforum menu */

	call xforum_window_mgr$menu_display (x_xforum_menu_ptr);

	on xforum_redisplay_menu
	     call xforum_window_mgr$menu_display (x_xforum_menu_ptr);/* for redisplay function	      */

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$bell (xforum_windows.menu.iocb, (0));
		call xforum_help_line_$change ("10010000"b, "", "", "");
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_1, "QUIT");
		goto xforum_get_choice;
	     end;

	on program_interrupt
	     begin;
		call xforum_help_line_$change ("10010000"b, "", "", "");
		call xforum_status_$redisplay ((0));
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		goto xforum_get_choice;
	     end;


/* get choice from xforum menu */

xforum_get_choice:
	do while ("1"b);
	     call xforum_window_mgr$menu_get_choice (x_xforum_menu_ptr, x_fkey, x_choice);

	     x_xforum_info.main_options.choice = x_choice;

	     if x_fkey
	     then call collect_spy_data (SPY_AT_1, "F" || rtrim (ltrim (char (x_choice))));
	     else call collect_spy_data (SPY_AT_1, rtrim (ltrim (char (x_choice))));

	     if x_fkey then do;
		if x_choice = x_HELP
		then do;
		     call xforum_help_$get_help (x_xforum_menu_ptr, "Executive Forum", x_CHOICES,
			spy_ptr, xforum_system_area_ptr);
		     call xforum_help_line_$change ("10010000"b, "", "", "");
		end;
		else if x_choice = x_FIRST_MENU | x_choice = x_FIRST_MENU2
		then goto xforum_get_next_choice;
		else if x_choice = x_PREV_MENU | x_choice = x_PREV_MENU2
		then goto xforum_get_next_choice;
		else if x_choice = x_QUIT | x_choice = x_QUIT2
		then goto exit_xforum;
		else if x_choice = x_REDISPLAY | x_choice = x_REDISPLAY2
		then call xforum_redisplay_;
		else if (x_choice = x_MULTICS | x_choice = x_MULTICS2) & xforum_user_profile$get_multics_mode ()
		then do;
		     call xforum_multics_mode (x_menu_window_height);
		     call xforum_window_mgr$resynch_windows (x_menu_window_height, "0"b);
		     call xforum_help_line_$change ("10010000"b, "", "", "");
		     call xforum_status_$redisplay ((0));
		     call xforum_window_mgr$menu_display (x_xforum_menu_ptr);
		end;
		else call window_$bell (xforum_windows.menu.iocb, (0));
	     end;
	     else do;
		if x_choice = CHANGED_MTG
		then do;
		     call xforum_main_options$goto_meeting (addr (x_xforum_info));
		end;
		else
		     if x_choice = ATTENDED_MTG
		then do;
		     call xforum_main_options$goto_meeting (addr (x_xforum_info));
		end;
		else
		     if x_choice = ELIGIBLE_MTG
		then do;
		     call xforum_main_options$goto_meeting (addr (x_xforum_info));
		end;
		else
		     if x_choice = NEXT_MTG
		then do;
		     call xforum_main_options$next_meeting (addr (x_xforum_info));
		end;
		else
		     if x_choice = MODIFY_MTG_LIST
		then call xforum_main_options$modify_meeting_list (addr (x_xforum_info));
		else
		     if x_choice = PERSONALIZE
		then call xforum_personalize_menu (spy_ptr, xforum_system_area_ptr);
		else
		     if x_choice = GET_STARTED
		then call xforum_help_menus$getting_started (spy_ptr, xforum_system_area_ptr);
	     end;

	     call iox_$control (xforum_windows.bottom.iocb, "reset_more",
		null, (0));			/* get back in step		      */

xforum_get_next_choice:
	     call xforum_status_$update_total ("");
	     call xforum_status_$update_new ("");
	     call xforum_help_line_$change ("10010000"b, "", "", "");
	     call ioa_$rsnnl ("Eligible ^d, Attended ^d, Changed ^d",
		x_xforum_banner, (0), no_selected, no_participant,
		no_changed);
	     call xforum_status_$update_banner (x_xforum_banner);
	     call xforum_status_$update_title ((x_HEADERS (1)));
	     call xforum_status_$redisplay ((0));
	     call xforum_window_mgr$resynch_windows (x_xforum_menu_requirements.lines_needed, "0"b);

	     call xforum_window_mgr$menu_display (x_xforum_menu_ptr);
	end;

exit_xforum:
	call xforum_terminate ("0"b);

error_exit_xforum:
	return;


xforum_terminate: proc (xt_cleanup_flag);

/* PARAMETERS */

	dcl     xt_cleanup_flag	 bit (1);		/* (input) "1"b implies called because of a cleanup condition */

/* INTERNAL AUTOMATIC */

	dcl     xt_code		 fixed bin (35);	/* standard error code */


	call xforum_window_mgr$prepare_to_shut_down (xt_cleanup_flag);

	call record_spy_data;

	call release_temp_segments_ (x_ME, x_ptrs, xt_code);

	if x_xforum_menu_ptr ^= null
	then call menu_$destroy (x_xforum_menu_ptr, xt_code);

	if Shelp then do;
	   call xforum_help_$term;
	   Shelp = "0"b;				/* help has been terminated			*/
	   end;

	call xforum_window_mgr$shut_down_xforum_windows (xt_cleanup_flag);

	x_xforum_already_active = "0"b;

	if xforum_user_profile$get_handle_interactive_messages ()
	then call xforum_im_mgr$restore_original ((xt_cleanup_flag));

     end xforum_terminate;

collect_spy_data: proc (csd_where, csd_response);

/* PARAMETERS */

	dcl     csd_where		 fixed bin;	/* (input) location response was collected */
	dcl     csd_response	 char (*);	/* (input) user's response */





	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;






record_spy_data: proc;

/* INTERNAL AUTOMATIC */

	dcl     rsd_code		 fixed bin (35);	/* standard error code */
	dcl     rsd_spy_ptr		 ptr;		/* pointer to segment spy data will be recorded in */
	dcl     rsd_unusedb1	 bit (1) aligned;	/* unused output from initiate_file_$create */
	dcl     rsd_unusedfb24	 fixed bin (24);	/* unused output from system routines */

	if spy_ptr = null () then goto exit_record_spy_data;

	call hcs_$status_minf (">udd>m>cp>Davids>xforum", "spy", 0, 2, rsd_unusedfb24, rsd_code);
	if rsd_code ^= 0 then goto exit_record_spy_data;

	rsd_spy_ptr = null ();
	call initiate_file_$create (">udd>m>cp>Davids>xforum>spy", unique_chars_ ("0"b),
	     RW_ACCESS, rsd_spy_ptr, rsd_unusedb1, rsd_unusedfb24, rsd_code);
	if rsd_spy_ptr = null ()
	then goto exit_record_spy_data;

	rsd_spy_ptr -> spy = spy_ptr -> spy;

exit_record_spy_data:
	return;

     end record_spy_data;

fatal_error: proc;

/* INTERNAL AUTOMATIC */

	dcl     fe_code		 fixed bin (35);	/* standard system error code */
	dcl     fe_xforum_error_info_ptr ptr;		/* ptr to structure containing info about the error */
	dcl     1 fe_condition_info	 like condition_info; /* structure containing info about condition being signaled */





	call find_condition_info_ (null (), addr (fe_condition_info), fe_code);
	if fe_code ^= 0
	then call xforum_error (fe_code, "A fatal error has occured - no information is available.");

	if fe_condition_info.condition_name ^= "xforum_fatal_error"
	then call xforum_error (0, "A fatal error has occured - no information is available.");

	fe_xforum_error_info_ptr = fe_condition_info.info_ptr;

	call xforum_error (fe_xforum_error_info_ptr -> xforum_error_info.code,
	     "^/A fatal error has occured while in the " ||
	     rtrim (fe_xforum_error_info_ptr -> xforum_error_info.name) ||
	     " module.^/" ||
	     fe_xforum_error_info_ptr -> xforum_error_info.reason);

     end fatal_error;




xforum_error: proc (xe_code, xe_explanation);

/* PARTAMETERS */

	dcl     xe_code		 fixed bin (35);	/* (input) standard error code */
	dcl     xe_explanation	 char (*);	/* (input) message to send to the user */





	call xforum_terminate ("0"b);
	call com_err_ (xe_code, "xforum", xe_explanation);
	goto error_exit_xforum;
     end xforum_error;

reconnect_test: entry returns (bit (1) aligned);


/* PARAMETERS */

	dcl     rt_reconnect_sw	 bit (1) aligned;	/* (output) "1"b if quit signaled because of reconnection */




	call xforum_window_mgr$check_window_status;

	call check_for_reconnect (rt_reconnect_sw);
	return (rt_reconnect_sw);			/* reconnect_test entry */

check_for_reconnect: proc (cfr_reconnect_quit);

/* PARAMETERS */

	dcl     cfr_reconnect_quit	 bit (1) aligned parameter; /* (output) "1"b if quit signaled because of reconnection */

/* AUTOMATIC */

	dcl     cfr_stack_ptr	 ptr;		/* pointer to the stack frame */
	dcl     01 cfr_cond_info	 like condition_info; /* info about the condition */


	cfr_reconnect_quit = "0"b;
	cfr_cond_info.version = condition_info_version_1;
	cfr_cond_info.info_ptr = null ();
	cfr_cond_info.flags.pad1 = "0"b;
	cfr_cond_info.pad2 = "0"b;
	cfr_cond_info.pad3 = "0"b;
	cfr_stack_ptr = find_condition_frame_ (null ());
	if cfr_stack_ptr ^= null ()
	then do;
	     call find_condition_info_ (cfr_stack_ptr, addr (cfr_cond_info), (0));
	     if cfr_cond_info.info_ptr ^= null ()
	     then do;
		quit_info_ptr = cfr_cond_info.info_ptr;
		cfr_reconnect_quit = quit_info.switches.reconnection_quit;
	     end;
	end;
     end check_for_reconnect;

     end executive_forum;





		    xforum_attend_mtg_utilities.pl1 08/06/87  1025.1rew 08/06/87  1014.9      448677



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


/****^  HISTORY COMMENTS:
  1) change(85-02-21,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Written by extracting things out of the xforum_ent_attend_mtg_menu
     and xforum_sub_attend_mtg_menus modules.
     
     85-03-25 Davids: Added calls to timer_manager_$sleep after calls
     to com_err_ so that the user will have time to read the message.
     The timer calls were not placed after some calls to com_err_ in
     copy_to_name because the screen is not cleared after those calls.
     
     85-03-26 Davids: Added the set_up_meeting entry point.
     
     85-03-28 Davids: Added code to set_up_meeting so that the old
     xforum_meeting_info structure is not zeroed if it already contains
     information about the meeting.  This will happen if the user
     leaves a meeting and then reenters it without going to another
     meeting.  The forum meeting is still opened, the seen map updated
     and other meeting statistics are still updated.  The current
     comment information is the oinly thing that is really saved.
  2) change(85-04-17,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Modified the next_unread_comment entry so that it saves the
     original current comment and flags and so that it has a quit
     handler that will restore the current comment and flags and get a
     pointer to the first current comment which is returned.  This
     solves the problem of having a meeting with lots of deleted or
     expunged comments, asking for the next unread, hitting BREAk and
     being left with a current comment that has been deleted or
     expunged.  Error list entry #8.
     
     85-05-01 Davids: Modified next_unread_comment so that if the error
     code returned from xforum_trans_$read is non 0 and neither deleted
     or reaped it will find the next unread comment.  It was just
     telling the user that the next one would be found but the code to
     find it was missing so the user would be in a loop.
     
     85-05-20 Davids: Added header comments and cleaned up some dcls.
     
     85-06-20 Davids: Changed calling sequence of xforum_format_$append
     so that the bit_count parameter which is input/output comes after
     all the input parameters (i.e.  the bit (1) switch).
  3) change(87-04-13,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Changed to allow command_processor_ escapes.
                                                   END HISTORY COMMENTS */

xforum_attend_mtg_utilities: proc;

/*
   BEGIN DESCRIPTION

   function:
      This module contains functions that are used by both the
      xforum_ent_attend_mtg_menu and the xforum_sub_attend_mtg_menu modules.

   description of entry points:
      xforum_attend_mtg_utilities:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error
         condition will be signaled with an "internal programming error" error
         message.

      set_up_meeting:
         input:   ptr              pointer to meeting_list structure
                  ptr              pointer to meeting_info structure
                  fixed bin        index of meeting in meeting_list
                  bit (1) aligned  "1"b => subject oriented attending menu in use
         output:  fixed bin        meeting index used by forum, 0 => meeting not opened
                  char (256)        subject of current comment chain
                  char (256)       chairs msg. "" => no message or no need to print message
         This entry calls forum to open a forum meeting and sets up information
         that xforum needs to know about. The meeting path is obtained from the
         meeting list. The new meeting name and index are compared to the previously
         opened name and index. If they are the same it is assumed that it is the
         same meeting and the old info is reused. This old info includes the current
         set of selected comments. Both name and index are used because it was felt
         that either one by itself might not be enough, i.e. two meeting with the
         same name or a resorted meeting list so that the same index refers to
         a different meeting. If the call to forum fails it is assumed that the
         meeting list has been invalidated by someone changing the name or access
         on the meeting and a message to that effect is output to the user. The
         participation and changed flags are also turned off (and the counts
         decremented) for that meeting. Given that the meeting is opened ok. Then
         if the participant flag is off it is turned on. For a version 2 forum the
         transaction map is obtained, a pseudo transaction map is obtained for version 1
         forums by assuming that all comments prior to the last one the user has seen
         have all been seen. If the previous information is still to be used
         the current comment information must be checked to be sure that it can
         still be used. For the case of changing from entry oriented to subject oriented
         there are sets of current comments that cannot be used, i.e. ranges and sets.
         For these cases the last current comment is set to the last comment in
         the range or set. The chairman message is obtained and returned only if the
         current comment has been set to 1 which means that the user has never atteneded
         the meeting before. The current comment is also read, if the comment cannot be read
         the first comment in the meeting is read and the current comment set to that.
         If that cannot be read a programming error message is output to the user,

      copy_to_name:
         input:   ptr              pointer to the spy structure
         output:  char (32)        name of segment
                  ptr              pointer to segment
                  fixed bin (24)   bit count of segment
         This entry prompts the user for the name of a segment and returns the
         name, pointer and bit count of the segment. The user can input
         either an absolute or relative pathname. Null names are handled by
         printing an error message and the prompt again. "?" is handled by a
         call to xforum_help_$display with the parameters of "xforum_prompt" 
         and "file_name" and then reissusing the prompt. "??" is handled by
         printing an error message and the prompt. The user's response is
         recorded in the spy segment as either "name" or "pathname". Pathname
         is used if the user's response has either a > or a < in it. If the 
         segment indicated by the user cannot be initiated an error message is
         printed and the returned name, ptr and bit count values set to "",
         null and 0. A quit handler also sets the returned values to "", null,
         and 0.

      next_unread_comment:
         input:   ptr              pointer to meeting_info structure
                  fixed bin        index forum uses to ID meeting
                  fixed bin        version of forum meeting
         output:  ptr              pointer to next unread comment or null
         This entry returns a pointer to the forum_user_trans structure of the
         next unread comment, or a null if there are no more unread comments.
         It uses the next_unread element in the xforum_meeting_info structure
         to identify that comment. It then calls xforum_trans_$read to get a
         pointer to it. If the call to read fails because the comment has been
         deleted or expunged then the seen map is marked so that it shows its
         has been seen and the unread_count in xforum_meeting_info is
         decremented. In addition for version 2 meetings the seen switch for
         the comment is set. The next unread comment is then located by looping
         through the seen map - starting with the deleted/expunged comment.
         This new comment is then read and the cycle repeats itself. If some
         other error was returned by the read operation. An error message is
         output and a new unread comment is found. The cycle then repeats.

      update_status:
         input:   ptr              pointer to meeting_info structure
                  fixed bin        index of current comment, 0 implies no current comment
                  char (*)         subject of current comment, used for subject oriented menu
                  fixed bin        version of forum meeting
                  fixed bin        index forum uses to ID meeting
         output:
         This entry updates the contents of the status window, sets seen flags,
         and finds the next unread comment. If the index of the current comment is
         non-zero it will set the forum seen flag or the last_seen_idx depending
         on forum version. It will also set the xforum comment seen map to record
         that the comment has been seen and find the next unseen comment based on
         the xforum seen map. It always makes a call to forum to get the current
         status of the meeting, including the last transaction in the meeting. If
         the meeting has had comments added to it since the xforum_seen_map was
         last updated then the map is extended and the comments marked as unseen.
         The unread count is updated and if there currently were no unread
         comments next_unread is set to the first new comment. The xforum status
         line is then rebuilt using the lastest values of total, and new. The help
         line changed to show F1, F3, and F4.

      close_meeting:
         input:   ptr              pointer to meeting_info structure
                  ptr              pointer to meeting_list structure
                  fixed bin        index of meeting in the meeting list
                  fixed bin        index forum uses to ID meeting
                  ptr              pointer to the attend meeting menu
         output:
         This entry closes a meeting and destroys the associated attend meeting
         menu. The meeting is closed by calls forum_$close. After its closed
         then if the meeting was flaged as having been changed and there are
         no new comments the changed flag is turned off and the changed count
         decremented. 

      enter_trans:
         input:   ptr              pointer to meeting_info structure
                  fixed bin        index forum uses to ID meeting
                  bit (1) aligned  "1"b implies reply mode, "0"b is talk mode
                  ptr              pointer to spy structure
                  bit (1) aligned  "1"b implies subject oriented meeting attendance,
                                   "0"b implies entry order attendance
         output:
         This entry sets up and calls the lisp extension for replying to and
         creating comments. There are two modes, reply mode and talk mode.
         In reply mode the current comments are written to a specially created
         file caled xforum_view_seg in the pdir. The segment will eventually
         be read into the top window of emacs. The segment xforum_trans which
         is also created in the pdir is used to house the new comment. The
         emacs extension IS NOT FOUND BY SEARCH RULES. It is found by
         determining the current referencing dir and creating the absolute
         path to the extension by using the referencing dir and the name of the
         extension. Note that the pointers to xforum_trans, xforum_view_seg and
         the extension are stored in internal static so once the extension is
         used you cannot use a new one. When the user exits the extension the
         new comment is in the xforum_trans segment. The first 9 characters of
         segment must be "Subject: " or an error will be reported. The subject
         is extracted and placed in its own variable of 500 characters. Embeded
         new-lines are allowed by terminating the subject with an ESC
         character. forum_$enter_trans is used to enter the comment and itr
         returns the comment number so it can be reported to the user. If the
         new comment number is greater than 1 + the last known comment number
         i.e. last_trans stored in xforum_meeting_info it means that there are
         new comments. The transaction number returned is used as a new last
         and the seen map, unread_count, and next_unread index are all updated.

   description of internal procedures:
      collect_spy_data: Similar to all the other collect_spy_data procedures. See the
      xforum module. Note that this procedure is duplicated so as to save the
      expense of an external call for a commonly executed, very short program,
      whose output is used only durning development or special site exposure.

      error: Similar to all the other error procedures. It records in an internal
      static structure the details of an error and then signals the
      xforum_fatal_error condition.

   known bugs:

   notes:
      85-05-20 Davids: collect_spy_data could be placed in an include file.

   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

	dcl     forum_error_table_$invalid_trans_idx fixed bin (35) ext static;
	dcl     forum_error_table_$trans_deleted fixed bin (35) ext static;
	dcl     forum_error_table_$trans_reaped fixed bin (35) ext static;

/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     emacs_		 entry (ptr, char (*), char (*), ptr, fixed bin (35));
	dcl     expand_pathname_	 entry (char (*), char (*), char (*), fixed bin (35));
	dcl     get_pdir_		 entry () returns (char (168));
	dcl     hcs_$fs_get_path_name	 entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
	dcl     hcs_$make_ptr	 entry (ptr, char (*), char (*), ptr, fixed bin (35));
	dcl     hcs_$set_bc_seg	 entry (ptr, fixed bin (24), fixed bin (35));
	dcl     initiate_file_	 entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
	dcl     initiate_file_$create	 entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35));
          dcl     xforum_get_str_	 entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     menu_$destroy	 entry (ptr, fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_format_$append	 entry (ptr, ptr, bit (1) aligned, fixed bin (24), fixed bin (35));
	dcl     xforum_format_$write	 entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_selected_trans$first entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_selected_trans$next entry (ptr, ptr, fixed bin (35));
	dcl     xforum_help_line_$change entry (bit (8) aligned, char (*), char (*), char (*));
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_help_line_$push entry (bit (8) aligned, char (*), char (*), char (*));
	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     xforum_status_$update_current entry (char (*));
	dcl     xforum_status_$update_new entry (char (*));
	dcl     xforum_status_$update_title entry (char (*));
	dcl     xforum_status_$update_total entry (char (*));
	dcl     xforum_trans_$first_trans entry (ptr, fixed bin (35));
	dcl     xforum_trans_$read	 entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_user_profile$get_remove_menu_while_editing entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$resynch_windows entry (fixed bin, bit (1));

/* CONDITIONS */

	dcl     quit		 condition;

/* INTERNAL AUTOMATIC */

	dcl     xforum_meeting_info_ptr ptr;		/* pointer to meeting_info structure */
	dcl     xforum_meeting_list_ptr ptr;		/* pointer to meeting_list structure */

		         
/* INTERNAL STATIC */

	dcl     01 xamu_xforum_error_info like xforum_error_info internal static;
						/* used to record error info to be output to the user */

/* CONSTANTS */

	dcl     (
	        xamu_QUERY_USAGE	 char (69) init ("Press  ? and RETURN:help  BREAK:Do not copy comments"),
	        xamu_ME		 char (27) init ("xforum_attend_mtg_utilities"),
	        xamu_OFF		 bit (1) aligned init ("0"b),
	        xamu_ON		 bit (1) aligned init ("1"b),
	        xamu_REPLY		 bit (1) aligned init ("1"b),
	        xamu_SUBJECT	 bit (1) aligned init ("1"b)
	        )			 internal static options (constant);

/* BUILTINS */

	dcl     (
	        addr,
	        after,
	        before,
	        divide,
	        index,
	        length,
	        null,
	        rtrim,
	        string,
	        substr,
	        unspec
	        )			 builtin;

/* BASED */


/* INCLUDE FILES */

%include access_mode_values;
%page;
%include forum_dcls;
%page;
%include forum_flags;
%page;
%include forum_user_trans;
%page;
%include xforum_error_info;
%page;
%include xforum_meeting_info;
%page;
%include xforum_meeting_list;
%page;
%include xforum_spy;
%page;
%include xforum_windows;
%page;
%include xforum_prompts;

%include xforum_answers;

%include xforum_help_infos;


	call error (0, "Internal programming error - xforum_attend_mtg_utilities$xforum_attend_mtg_utilities called.");

set_up_meeting: entry (sum_xforum_meeting_list_ptr, sum_xforum_meeting_info_ptr, sum_midx, sum_subject_oriented,
	sum_fidx, sum_subject, sum_chairman_msg);

/* PARAMETERS */

	dcl     sum_xforum_meeting_list_ptr ptr;	/* (input) pointer to meeting_list structure */
	dcl     sum_xforum_meeting_info_ptr ptr;	/* (input) pointer to meeting_info structure */
	dcl     sum_midx		 fixed bin;	/* (input) index of meeting in meeting_list */
	dcl     sum_subject_oriented	 bit (1) aligned;	/* (input) "1"b => subject oriented attending menu in use */
	dcl     sum_fidx		 fixed bin;	/* (output) meeting index used by forum, 0 => meeting not opened */
	dcl     sum_subject		 char (256);	/* (output) subject of current comment chain */
	dcl     sum_chairman_msg	 char (256);	/* (output) chairs msg. "" => no message or no need to print message */

/* INTERNAL AUTOMATIC */

	dcl     sum_code		 fixed bin (35);	/* standard error code */
	dcl     sum_i		 fixed bin;	/* loop index */
	dcl     sum_old_info_still_good bit (1) aligned;	/* "1"b implies that data in meeting_info structure still valid */
	dcl     sum_seen_map_ptr	 ptr;		/* pointer to the seen_map string */
	dcl     sum_set_array_ptr	 ptr;		/* pointer to the set_array structure */

	xforum_meeting_list_ptr = sum_xforum_meeting_list_ptr;
	xforum_meeting_info_ptr = sum_xforum_meeting_info_ptr;
	sum_fidx = 0;
	sum_subject = "";
	sum_chairman_msg = "";


	if xforum_meeting_info.lidx = sum_midx & xforum_meeting_info.name = forums (sum_midx).long_name
	then sum_old_info_still_good = "1"b;
	else sum_old_info_still_good = "0"b;

	if ^sum_old_info_still_good
	then do;
	     sum_seen_map_ptr = xforum_meeting_info.seen_map_ptr; /* zero everything */
	     sum_set_array_ptr = xforum_meeting_info.set_array_ptr; /* but the seen_map_ptr */
	     unspec (xforum_meeting_info) = "0"b;	/* and the set_array_ptr */
	     xforum_meeting_info.seen_map_ptr = sum_seen_map_ptr;
	     xforum_meeting_info.set_array_ptr = sum_set_array_ptr;
	     xforum_meeting_info.name = forums (sum_midx).long_name;
	end;

	if forums (sum_midx).forum_version = 1 then
	     call forum_$open_forum (forums (sum_midx).directory,
		rtrim (forums (sum_midx).long_name) || ".control", sum_fidx, sum_code);
	else call forum_$open_forum (forums (sum_midx).directory,
		rtrim (forums (sum_midx).long_name) || ".forum", sum_fidx, sum_code);
	if sum_code ^= 0
	then do;
	     call ioa_ ("The ^a meeting^/has been deleted or renamed since your meeting list was created.",
		xforum_meeting_list.forums (sum_midx).long_name);
	     call ioa_ ("To update your meeting list exit Executive Forum^/and reinvoke it with the -force control argument.");
	     if xforum_meeting_list.forums (sum_midx).participant
	     then do;
		xforum_meeting_list.forums (sum_midx).participant = "0"b;
		no_participant = no_participant - 1;
	     end;
	     if xforum_meeting_list.forums (sum_midx).changed
	     then do;
		xforum_meeting_list.forums (sum_midx).changed = "0"b;
		no_changed = no_changed - 1;
	     end;
	     call timer_manager_$sleep (4, "11"b);
	     goto exit_set_up_meeting;
	end;

	forums (sum_midx).been_to = xamu_ON;		/* remember where you've been */

	call forum_$forum_limits (sum_fidx, ONLY_UNDELETED,
	     xforum_meeting_info.last_seen, xforum_meeting_info.first_trans,
	     xforum_meeting_info.last_trans, xforum_meeting_info.new_trans,
	     forum_flags_word, sum_code);
	if sum_code ^= 0 then do;
	     call com_err_$suppress_name (sum_code, xamu_ME,
		"Getting forum_limits for ^a.", xforum_meeting_info.name);
	     goto exit_set_up_meeting;
	end;

	if ^forums (sum_midx).participant		/* keep tables up to date      */
	then do;
	     forums (sum_midx).participant = xamu_ON;
	     forums (sum_midx).removed = xamu_OFF;
	     no_participant = no_participant + 1;
	     if xforum_meeting_info.last_seen < xforum_meeting_info.last_trans
	     then do;
		forums (sum_midx).changed = xamu_ON;
		no_changed = no_changed + 1;
	     end;
	end;

	if forums (sum_midx).forum_version = 2
	then do;
	     call forum_$get_transaction_map_idx (sum_fidx, "", xforum_meeting_info.seen_map_ptr -> seen_map_string, sum_code);
	     if sum_code ^= 0
	     then do;
		call com_err_$suppress_name (sum_code, "", "Could not get seen transaction map.");
		return;
	     end;
	     xforum_meeting_info.next_unread = -1;
	     xforum_meeting_info.unread_count = 0;
	     do sum_i = 1 to xforum_meeting_info.last_trans;
		if ^xforum_meeting_info.seen_map_ptr -> seen_map (sum_i)
		then do;
		     xforum_meeting_info.unread_count = xforum_meeting_info.unread_count + 1;
		     if xforum_meeting_info.next_unread = -1
		     then xforum_meeting_info.next_unread = sum_i;
		end;
	     end;
	end;
	else do;
	     do sum_i = 1 to xforum_meeting_info.last_seen;
		xforum_meeting_info.seen_map_ptr -> seen_map (sum_i) = "1"b;
	     end;
	     do sum_i = xforum_meeting_info.last_seen + 1 to xforum_meeting_info.last_trans;
		xforum_meeting_info.seen_map_ptr -> seen_map (sum_i) = "0"b;
	     end;
	     xforum_meeting_info.next_unread = xforum_meeting_info.last_seen + 1;
	     xforum_meeting_info.unread_count = xforum_meeting_info.last_trans - xforum_meeting_info.last_seen;
	end;

	xforum_meeting_info.lidx = sum_midx;
						/* note which one we are	      */

	xforum_meeting_info.idx = sum_fidx;

	if sum_old_info_still_good
	then do;
	     if sum_subject_oriented & string (xforum_meeting_info.flags) ^= "0"b
	     then do;
		if xforum_meeting_info.flags.all | xforum_meeting_info.flags.new
		then xforum_meeting_info.current = xforum_meeting_info.last_seen;
		else
		     if xforum_meeting_info.flags.range
		then xforum_meeting_info.current = xforum_meeting_info.high;
		else
		     if xforum_meeting_info.flags.set
		then do;
		     sum_i = xforum_meeting_info.set_array_ptr -> set_array.number;
		     xforum_meeting_info.current = xforum_meeting_info.set_array_ptr -> set_array.index (sum_i);
		end;
		else
		     if xforum_meeting_info.flags.allref
		then xforum_meeting_info.current = xforum_meeting_info.current_ref;
		unspec (xforum_meeting_info.flags) = "0"b;
	     end;
	end;
	else xforum_meeting_info.current = xforum_meeting_info.last_seen;

	if xforum_meeting_info.current = 0
	then do;
	     xforum_meeting_info.current = 1;

	     call forum_$get_message (sum_fidx, sum_chairman_msg, sum_code);
	     if sum_code ^= 0
	     then sum_chairman_msg = "";
	end;

	if xforum_meeting_info.current ^= 0
	then do;
	     call xforum_trans_$read (xforum_meeting_info.current, forum_user_trans_ptr, sum_code);
	     if sum_code ^= 0
	     then do;
		call xforum_trans_$first_trans (forum_user_trans_ptr, sum_code);
		xforum_meeting_info.current = forum_user_trans.trans_no;
	     end;

	     if sum_code = 0
	     then do;
		if forum_user_trans.subject_length <= length(sum_subject)
		then sum_subject = forum_user_trans.subject;
		else sum_subject = substr (forum_user_trans.subject, 1, length(sum_subject));
		free forum_user_trans;
	     end;
	     else do;
		call ioa_ ("A programming error has occured.^/   The comments in this meeting cannot be read.");
		call timer_manager_$sleep (4, "11"b);
		goto exit_set_up_meeting;
	     end;
	end;

exit_set_up_meeting:
	return;

copy_to_name: entry (ctn_spy_ptr, ctn_name, ctn_seg_ptr, ctn_bc);

/* PARAMETERS */

	dcl     ctn_spy_ptr		 ptr;		/* (input) pointer to the spy structure */
	dcl     ctn_name		 char (32);	/* (output) name of segment */
	dcl     ctn_seg_ptr		 ptr;		/* (output) pointer to segment */
	dcl     ctn_bc		 fixed bin (24);	/* (output) bit count of segment */

/* INTERNAL AUTOMATIC */

	dcl     ctn_code		 fixed bin (35);	/* standard error code */
	dcl     ctn_dir_name	 char (168);	/* path of the dir containing the requested seg */
	dcl     ctn_entry_name	 char (32);	/* name of the segment */
	dcl     ctn_reply		 char (200);	/* buffer for user to enter reply */
						/* extra long because we don't know what he will type */
	dcl     ctn_unused_b1	 bit (1) aligned;	/* unused output from called entry */

          dcl      reply                 char (200) var;

/* EXTERNAL ENTRY */

          dcl      error_table_$long_record	
                                         fixed bin(35) ext static;
    

	answer_array.N = 0;				/* all answers acceptable			*/
          answer_array.max_length = length(ctn_dir_name);	/* max length of file name is 168		*/

	spy_ptr = ctn_spy_ptr;
	ctn_name = "";
	ctn_seg_ptr = null ();
	ctn_bc = 0;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_help_line_$push ("0"b, "", "", xamu_QUERY_USAGE);

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call collect_spy_data (SPY_AT_15, "QUIT");
		ctn_name = "";
		ctn_seg_ptr = null ();
		ctn_bc = 0;
		goto exit_copy_to_name;
	     end;

	ctn_code = 1;
	do while (ctn_code ^= 0);
               ctn_code = 0;
	     call xforum_get_str_ ((FILE_PROMPT), addr(answer_array), PROMPT_HELP, "file_name", reply, ctn_code);

               if ctn_code = error_table_$long_record
	     then do;
                    call ioa_ ("File name must be less than ^i characters.^/", answer_array.max_length);
		ctn_code = 1;
		end;
	     ctn_reply = substr (reply, 1, length(reply));
						/* strip off new line char */

	     if rtrim (ctn_reply) = ""
	     then do;
		call com_err_$suppress_name (0, "", "^/A file name must be entered. To return to the menu press BREAK.^/");
		ctn_code = 1;
	     end;
	     else if ctn_reply = "??"
	     then do;
		call collect_spy_data (SPY_AT_15, "??");
		call ioa_ ("A menu of all possible file names cannot be constructed.^/");
		ctn_code = 1;
	     end;
	     else do;
		call expand_pathname_ (ctn_reply, ctn_dir_name, ctn_entry_name, ctn_code);
		if ctn_code = 0
		then ctn_name = ctn_entry_name;
		else do;
		     call collect_spy_data (SPY_AT_15, "invalid");
		     call com_err_$suppress_name (ctn_code, "", "^a is not a valid file name.", ctn_reply);
		end;
	     end;
	end;

	if (index (ctn_reply, ">") > 0) | (index (ctn_reply, "<") > 0)
	then call collect_spy_data (SPY_AT_15, "pathname");
	else call collect_spy_data (SPY_AT_15, "name");

	call initiate_file_$create (ctn_dir_name, ctn_entry_name, RW_ACCESS, ctn_seg_ptr, ctn_unused_b1, ctn_bc, ctn_code);
	if ctn_code ^= 0
	then do;
	     call com_err_$suppress_name (ctn_code, xamu_ME,
		"Could not find or create the file ^a>^a.", ctn_dir_name, ctn_entry_name);
	     call timer_manager_$sleep (3, "11"b);
	     ctn_name = "";
	     ctn_seg_ptr = null ();
	     ctn_bc = 0;
	end;

exit_copy_to_name:
	call xforum_help_line_$pop;

	return;

next_unread_comment: entry (nuc_xforum_meeting_info_ptr, nuc_fidx, nuc_version, nuc_forum_user_trans_ptr);

/* PARAMETERS */

	dcl     nuc_xforum_meeting_info_ptr ptr;	/* (input) pointer to meeting_info structure */
	dcl     nuc_fidx		 fixed bin;	/* (input) index forum uses to ID meeting */
	dcl     nuc_version		 fixed bin;	/* (input) version of forum meeting */
	dcl     nuc_forum_user_trans_ptr ptr;		/* (output) pointer to next unread comment or null */

/* INTERNAL AUTOMATIC */

	dcl     nuc_code		 fixed bin (35);	/* standard error code */
	dcl     nuc_found		 bit (1);		/* "1" imples that an unread comment was found */
	dcl     nuc_i		 fixed bin;	/* loop index */
	dcl     nuc_old_current	 fixed bin;	/* IDs the current comment before the search begins */
	dcl     nuc_old_flags	 bit (6) unaligned; /* IDs the current comment before the search begins */

	xforum_meeting_info_ptr = nuc_xforum_meeting_info_ptr;
	nuc_forum_user_trans_ptr = null ();
	nuc_found = "0"b;
	nuc_old_current = xforum_meeting_info.current;
	nuc_old_flags = string (xforum_meeting_info.flags);

	on quit
	     begin;
		xforum_meeting_info.current = nuc_old_current;
		unspec (xforum_meeting_info.flags) = nuc_old_flags;
		call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, nuc_code);
		if nuc_code = 0
		then nuc_forum_user_trans_ptr = forum_user_trans_ptr;
		else nuc_forum_user_trans_ptr = null ();
		goto exit_next_unread_comment;
	     end;

	do while (xforum_meeting_info.next_unread ^= -1 & ^nuc_found);
	     xforum_meeting_info.current = xforum_meeting_info.next_unread;

	     call xforum_trans_$read (xforum_meeting_info.current, forum_user_trans_ptr, nuc_code);
	     if nuc_code = forum_error_table_$trans_deleted |
		nuc_code = forum_error_table_$trans_reaped
	     then do;
		xforum_meeting_info.seen_map_ptr -> seen_map (xforum_meeting_info.current) = "1"b;
		xforum_meeting_info.unread_count = xforum_meeting_info.unread_count - 1;
		if nuc_version = 2
		then call forum_$set_seen_switch (nuc_fidx, "", xforum_meeting_info.current, xamu_ON, nuc_code);
		xforum_meeting_info.next_unread = -1;
		do nuc_i = xforum_meeting_info.current + 1 to xforum_meeting_info.last_trans while (xforum_meeting_info.next_unread = -1);
		     if ^xforum_meeting_info.seen_map_ptr -> seen_map (nuc_i)
		     then xforum_meeting_info.next_unread = nuc_i;
		end;
	     end;
	     else
		if nuc_code ^= 0
	     then do;
		call ioa_ ("Comment #^i has not yet been read but cannot be obtained,", xforum_meeting_info.current);
		call ioa_ ("will find the next unread comment.");
		call timer_manager_$sleep (3, "11"b);
		xforum_meeting_info.next_unread = -1;
		do nuc_i = xforum_meeting_info.current + 1 to xforum_meeting_info.last_trans while (xforum_meeting_info.next_unread = -1);
		     if ^xforum_meeting_info.seen_map_ptr -> seen_map (nuc_i)
		     then xforum_meeting_info.next_unread = nuc_i;
		end;
	     end;
	     else nuc_found = "1"b;			/* get out of the loop */
	end;

	if nuc_found
	then nuc_forum_user_trans_ptr = forum_user_trans_ptr;

exit_next_unread_comment:
	return;

update_status: entry (us_xforum_meeting_info_ptr, us_trans_no, us_subject, us_version, us_fidx);

/* PARAMETERS */

	dcl     us_xforum_meeting_info_ptr ptr;		/* (input) pointer to meeting_info structure */
	dcl     us_trans_no		 fixed bin;	/* (input) index of current comment, 0 implies no current comment */
	dcl     us_subject		 char (*);	/* (input) subject of current comment, used for subject oriented menu */
	dcl     us_version		 fixed bin;	/* (input) version of forum meeting */
	dcl     us_fidx		 fixed bin;	/* (input) index forum uses to ID meeting */

/* INTERNAL AUTOMATIC */

	dcl     us_code		 fixed bin (35);	/* standard error code */
	dcl     us_current_text	 char (80);	/* middle part of second line of status window for attending menu */
	dcl     us_i		 fixed bin;	/* loop index */
	dcl     us_last_trans	 fixed bin;	/* index of last comment in meeting */
	dcl     us_new_text		 char (12);	/* last part of second line of status window for attending menu */
	dcl     us_total_text	 char (11);	/* first part of second line of status window for attending menu */
	dcl     us_unused_b36	 bit (36) aligned;	/* unused output from system call */

	xforum_meeting_info_ptr = us_xforum_meeting_info_ptr;

	if us_trans_no ^= 0
	then do;
	     if us_version = 2
	     then call forum_$set_seen_switch (us_fidx, "", us_trans_no, xamu_ON, us_code);

	     if (us_version = 1) & (us_trans_no > xforum_meeting_info.last_seen)
	     then call forum_$set_last_seen_idx (us_fidx, us_trans_no, xamu_ON, us_code);

	     if ^xforum_meeting_info.seen_map_ptr -> seen_map (us_trans_no)
	     then do;
		xforum_meeting_info.seen_map_ptr -> seen_map (us_trans_no) = "1"b;
		xforum_meeting_info.unread_count = xforum_meeting_info.unread_count - 1;
		if xforum_meeting_info.next_unread = us_trans_no
		then do;
		     xforum_meeting_info.next_unread = -1;
		     do us_i = us_trans_no + 1 to xforum_meeting_info.last_trans while (xforum_meeting_info.next_unread = -1);
			if ^xforum_meeting_info.seen_map_ptr -> seen_map (us_i)
			then xforum_meeting_info.next_unread = us_i;
		     end;
		end;
	     end;
	end;

	call forum_$forum_limits (us_fidx, ONLY_UNDELETED,
	     xforum_meeting_info.last_seen,
	     xforum_meeting_info.first_trans,
	     us_last_trans,
	     xforum_meeting_info.new_trans, us_unused_b36, us_code);

	if us_last_trans > xforum_meeting_info.last_trans
	then do;
	     do us_i = xforum_meeting_info.last_trans + 1 to us_last_trans;
		xforum_meeting_info.seen_map_ptr -> seen_map (us_i) = "0"b;
		xforum_meeting_info.unread_count = xforum_meeting_info.unread_count + 1;
	     end;
	     if xforum_meeting_info.next_unread = -1
	     then xforum_meeting_info.next_unread = xforum_meeting_info.last_trans + 1;
	     xforum_meeting_info.last_trans = us_last_trans;
	end;

	call ioa_$rsnnl ("Total: ^d", us_total_text, (0), xforum_meeting_info.last_trans);

	call ioa_$rsnnl ("Unread: ^d", us_new_text, (0), xforum_meeting_info.unread_count);

	if us_subject ^= ""
	then do;
	     if index (us_subject, "Re: ") ^= 1
	     then call ioa_$rsnnl ("Current Subject: ^a", us_current_text, (0), us_subject);
	     else call ioa_$rsnnl ("Current Subject: ^a", us_current_text, (0), substr (us_subject, 5));
	end;
	else do;
	     if xforum_meeting_info.flags.set
	     then us_current_text = "Current comment(s): " || set_array.spec;
	     else call ioa_$rsnnl (
		     "Current comment(s): ^[^[all^]^[aref^]^[new^]^[^d:^d^s^]^;^s^s^s^s^s^s^d^]",
		     us_current_text, (0),
		     unspec (xforum_meeting_info.flags ^= "0"b),
		     xforum_meeting_info.flags.all,
		     xforum_meeting_info.flags.allref,
		     xforum_meeting_info.flags.new,
		     xforum_meeting_info.flags.range, xforum_meeting_info.low,
		     xforum_meeting_info.high, xforum_meeting_info.current);
	end;


	call xforum_help_line_$change ("10110000"b, "Leave Meeting", "", "");
	call xforum_status_$update_total (us_total_text);
	call xforum_status_$update_new (us_new_text);
	call xforum_status_$update_current (us_current_text);
	call xforum_status_$redisplay ((0));

	return;

close_meeting: entry (cm_xforum_meeting_info_ptr, cm_xforum_meeting_list_ptr, cm_midx, cm_fidx, cm_menu_ptr);

/* PARAMETERS */

	dcl     cm_xforum_meeting_info_ptr ptr;		/* (input) pointer to meeting_info structure */
	dcl     cm_xforum_meeting_list_ptr ptr;		/* (input) pointer to meeting_list structure */
	dcl     cm_midx		 fixed bin;	/* (index) index of meeting in the meeting list */
	dcl     cm_fidx		 fixed bin;	/* (index) index forum uses to ID meeting */
	dcl     cm_menu_ptr		 ptr;		/* (input) pointer to the attend meeting menu */






	xforum_meeting_info_ptr = cm_xforum_meeting_info_ptr;
	xforum_meeting_list_ptr = cm_xforum_meeting_list_ptr;


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

	if forums (cm_midx).changed
	then if xforum_meeting_info.new_trans = 0
	     then do;
		forums (cm_midx).changed = xamu_OFF;
		no_changed = no_changed - 1;
	     end;

	if cm_menu_ptr ^= null
	then call menu_$destroy (cm_menu_ptr, (0));

	cm_fidx = -1;
	cm_menu_ptr = null ();

	return;

enter_trans: entry (et_xforum_meeting_info_ptr, et_fidx, et_spy_ptr, et_flavour, et_attend_mtg_type);

/* PARAMETERS */

	dcl     et_xforum_meeting_info_ptr ptr;		/* (input) pointer to meeting_info structure */
	dcl     et_fidx		 fixed bin;	/* (index) index forum uses to ID meeting */
	dcl     et_flavour		 bit (1) aligned;	/* (input) "1"b impl;ies reply mode, "0"b is talk mode */
	dcl     et_spy_ptr		 ptr;		/* (input) /* (input) pointer to spy structure */
	dcl     et_attend_mtg_type	 bit (1) aligned;	/* (input) "1"b implies subject oriented meeting attendance, */
						/* "0"b implies entry order attendance */

/* INTERNAL AUTOMATIC */

	dcl     et_bc		 fixed bin (24);	/* bit count of segment containing the just entered comment */
	dcl     et_chairman_msg	 char (256);	/* chairman msg for the mtg */
	dcl     et_chars		 fixed bin (24);	/* number of chars in just entered comments */
	dcl     et_code		 fixed bin (35);	/* standard error code */
	dcl     et_emacs_flavour	 char (40);	/* tells emacs extension what to do either */
						/* talk, reply, if subject oriented includes current comment index */
	dcl     et_i		 fixed bin;	/* loop index */
	dcl     et_my_label		 label;		/* needed to determine referencing dir for emacs extension */
	dcl     et_prefix_len	 fixed bin;	/* length of text string preceeding the subject in the just entered comment */
	dcl     et_reply_no		 fixed bin;	/* index of comment being replied to */
	dcl     et_temp_line	 char (80);	/* first line of status window when editing a reply */
	dcl     et_seg		 char (et_chars) based (et_trans.trans_seg_ptr); /* just entered comment */
	dcl     et_sj		 char (500) varying;/* subject of just enetered comment */
	dcl     et_str		 char (510) varying;/* subject of just enetered comment */
						/* plus the "Subject: " string and a terminating ESC character */
	dcl     et_subj_len		 fixed bin;	/* length of the subject */
	dcl     et_trans_num	 fixed bin;	/* index of just eneterd comment */
	dcl     et_txt_len		 fixed bin;	/* length of actual comment, i.e. no subject, prefix or ESC */
	dcl     et_unusedb1		 bit (1) aligned;	/* unused output from system call */
	dcl     et_unusedfb24	 fixed bin (24);	/* unused output from system call */
	dcl     et_view_seg_bc	 fixed bin (24);	/* bit count of segment containing comment(s) being replied to */

	dcl     1 et_my_overlay	 based (addr (et_my_label)), /* used too get referencing dir for emacs extension */
		2 my_addr		 ptr,		/* segment i'm part of */
		2 my_stack	 ptr;		/* my stack frame */

	dcl     1 et_trans_seg	 based (et_trans.trans_seg_ptr), /* structure of segment containing just entered comment */
		2 prefix		 char (et_prefix_len) unal, /* the string "Subject:" */
		2 subj		 char (et_subj_len) unal, /* the text of the subject */
		2 esc_char	 char (1) unal,	/* ESC char terminates subject text */
		2 new_line	 char (1) unal,	/* new line char */
		2 txt		 char (et_txt_len) unal; /* text of comment */

/* INTERNAL STATIC */

	dcl     01 et_trans		 internal static,	/* need to get these only once per process */
		02 process_dir	 char (168),	/* process dir path */
		02 ext_dir	 char (168),	/* dir containing emacs extension */
		02 ext_seg	 char (32),	/* name of emacs extebsion */
		02 ext_ptr	 ptr,		/* pointer to emacs extension */
		02 have_trans_seg	 bit (1) unaligned init ("0"b), /* "1"b implies we have a segment to put new comments in */
		02 have_view_seg	 bit (1) unaligned init ("0"b), /* "1"b implies we have a segment to copy comment(s) being replied intgo */
		02 trans_seg_ptr	 ptr,		/* pointer to seg to put just created comment into */
		02 view_seg_ptr	 ptr;		/* pointer to put comment(s) being replied into */


/* CONSTANTS */

	dcl     et_ESC		 char (1) init ("") internal static options (constant);
						/* escape character 33 octal used to terminate subject */
          dcl     MAX_SUBJECT_LENGTH     fixed bin internal static options (constant) init (256);
	


	spy_ptr = et_spy_ptr;
	xforum_meeting_info_ptr = et_xforum_meeting_info_ptr;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call ioa_ ("Comment not entered.");
		call timer_manager_$sleep (3, "11"b);
		goto exit_enter_trans;
	     end;

	if et_flavour = xamu_REPLY
	then do;
	     call xforum_trans_$read (xforum_meeting_info.current,
		forum_user_trans_ptr, et_code);
	     if et_code ^= 0
	     then do;
		call com_err_$suppress_name (et_code, xamu_ME, "Could not read the comment you want to reply to.");
		call timer_manager_$sleep (3, "11"b);
		goto exit_enter_trans;
	     end;
	     if et_attend_mtg_type = xamu_SUBJECT
	     then call ioa_$rsnnl ("Replying on subject ^a in the ^a meeting", et_temp_line, (0),
		     forum_user_trans.subject, xforum_meeting_info.name);
	     else call ioa_$rsnnl ("Replying to comment no. ^d in the ^a meeting", et_temp_line, (0),
		     forum_user_trans.trans_no, xforum_meeting_info.name);
	     call xforum_status_$update_title (et_temp_line);
	     call xforum_status_$redisplay ((0));
	     call xforum_window_mgr$resynch_windows (-1, "1"b);
	     if et_attend_mtg_type = xamu_SUBJECT
	     then et_temp_line = "       ESCl:previous page of comments  ESCh:next page of comments";
	     else call ioa_$rsnnl ("       ESCl:previous page of comment ^d  ESCh:next page of comment ^d",
		     et_temp_line, (0), forum_user_trans.trans_no, forum_user_trans.trans_no);
	     call xforum_help_line_$change ("0"b, "", "", et_temp_line);
	     if et_attend_mtg_type = xamu_SUBJECT
	     then free forum_user_trans;
	end;
	else call xforum_help_line_$change ("0"b, "", "", "Press  RETURN:enter subject  BREAK:abort entry");

	if xforum_user_profile$get_remove_menu_while_editing () & et_flavour ^= xamu_REPLY
	then do;
	     call ioa_$rsnnl ("Entering a new comment in the ^a meeting",
		et_temp_line, (0), xforum_meeting_info.name);
	     call xforum_status_$update_title (et_temp_line);
	     call xforum_status_$redisplay ((0));
	     call xforum_window_mgr$resynch_windows (-1, "1"b);
	end;


	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call ioa_ ("Please wait for editor...");

	if et_flavour = xamu_REPLY & xforum_meeting_info.current = 0 then do;
	     call com_err_$suppress_name (0, xamu_ME, "Invalid current comment specifier for replying to.");
	     call timer_manager_$sleep (3, "11"b);
	     goto exit_enter_trans;
	end;


	if ^et_trans.have_trans_seg then do;
	     call initiate_file_$create (get_pdir_ (), "xforum.trans", RW_ACCESS,
		et_trans.trans_seg_ptr, et_unusedb1, et_unusedfb24, et_code);
	     if et_trans.trans_seg_ptr = null then do;
		call com_err_$suppress_name (et_code, xamu_ME, "Cannot get temp segment for comment.");
		call timer_manager_$sleep (3, "11"b);
		goto exit_enter_trans;
	     end;

	     et_trans.ext_seg = "xforum_emacs_ext_";
	     et_my_label = here;
here:
	     call hcs_$make_ptr (et_my_overlay.my_addr, et_trans.ext_seg, "symbol_table",
		et_trans.ext_ptr, et_code);
	     if et_code ^= 0 then do;
		call com_err_$suppress_name (et_code, xamu_ME, "Trying to load emacs extensions.");
		call timer_manager_$sleep (3, "11"b);
		goto exit_enter_trans;
	     end;

	     call hcs_$fs_get_path_name (et_trans.ext_ptr, et_trans.ext_dir, (0),
		(et_trans.ext_seg), et_code);
	     if et_code ^= 0 then do;
		call com_err_$suppress_name (et_code, xamu_ME, "Trying to load emacs extensions.");
		call timer_manager_$sleep (3, "11"b);
		goto exit_enter_trans;
	     end;

	     et_trans.have_trans_seg = xamu_ON;
	     et_trans.process_dir = get_pdir_ ();
	end;

	if et_flavour = xamu_REPLY & ^et_trans.have_view_seg then do;
	     call initiate_file_$create (get_pdir_ (), "xforum_view_seg", RW_ACCESS,
		et_trans.view_seg_ptr, et_unusedb1, et_unusedfb24, et_code);
	     if et_trans.view_seg_ptr = null then do;
		call com_err_$suppress_name (et_code, xamu_ME, "Cannot get temp segment for comment.");
		call timer_manager_$sleep (3, "11"b);
		goto exit_enter_trans;
	     end;

	     et_trans.have_view_seg = xamu_ON;
	end;

	call hcs_$set_bc_seg (et_trans.trans_seg_ptr, 0, (0));

	if et_flavour = xamu_REPLY
	then do;
	     if et_attend_mtg_type = xamu_SUBJECT
	     then do;
		call ioa_$rsnnl ("reply_by_subject                [^i]", et_emacs_flavour, (0), xforum_meeting_info.current);
		et_view_seg_bc = 0;
		xforum_meeting_info.flags.allref = "1"b;
		xforum_meeting_info.current_ref = xforum_meeting_info.current;
		call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, et_code);
		do while (et_code ^= forum_error_table_$invalid_trans_idx);
		     if et_code = 0
		     then do;
			call xforum_format_$append (forum_user_trans_ptr, et_trans.view_seg_ptr, "1"b, et_view_seg_bc, et_code);
			call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, et_code);
		     end;
		end;
		xforum_meeting_info.flags.allref = "0"b;
	     end;
	     else do;
		et_emacs_flavour = "reply";
		call xforum_format_$write (forum_user_trans_ptr,
		     et_trans.view_seg_ptr, et_code);
	     end;
	end;
	else et_emacs_flavour = "talk";

	if (et_flavour = xamu_REPLY) then do;
	     call forum_$get_message (et_fidx, et_chairman_msg, et_code);
	     if et_code = 0
	     then call ioa_ (rtrim (et_chairman_msg));
	end;

	call emacs_ (xforum_windows.bottom.iocb,
	     rtrim (et_trans.process_dir) || ">xforum.trans",
	     rtrim (et_trans.ext_dir) || ">" || rtrim (et_trans.ext_seg),
	     addr (et_emacs_flavour), et_code);
	if et_code ^= 0 then do;
	     if et_flavour = xamu_REPLY
	     then call collect_spy_data (SPY_AT_8, "QUIT");
	     else call collect_spy_data (SPY_AT_9, "QUIT");
	     call ioa_ ("Comment not entered.");
	     call timer_manager_$sleep (3, "11"b);
	     et_code = 0;
	     goto exit_enter_trans;
	end;

	call initiate_file_ (et_trans.process_dir, "xforum.trans", RW_ACCESS,
	     et_trans.trans_seg_ptr, et_bc, et_code);
						/* get bit count		      */
	if et_trans.trans_seg_ptr = null
	then do;
	     et_trans.have_trans_seg = xamu_OFF;
	     call com_err_$suppress_name (et_code, xamu_ME, "Getting bit count of comment.");
	     call timer_manager_$sleep (3, "11"b);
	     goto exit_enter_trans;
	end;

	if et_bc = 0 then do;
	     call com_err_$suppress_name (0, xamu_ME, "No data in comment.");
	     call timer_manager_$sleep (3, "11"b);
	     goto exit_enter_trans;
	end;

	et_chars = divide (et_bc, 9, 17, 0);

	et_str = before (et_seg, et_ESC);

	if substr (et_str, 1, 9) ^= "Subject: " then do;
	     call com_err_$suppress_name (0, xamu_ME, "No subject in comment.");
	     call timer_manager_$sleep (3, "11"b);
	     goto exit_enter_trans;
	end;

	et_sj = after (et_str, "Subject: ");
	et_prefix_len = 9;

	et_subj_len = length (et_sj);

          if et_subj_len > MAX_SUBJECT_LENGTH then do;
	      call com_err_$suppress_name (0, xamu_ME, "Max subject length (256 chars) exceeded.");
	      call timer_manager_$sleep (3, "11"b);
                goto exit_enter_trans;
	end;

	et_txt_len = et_chars - (et_prefix_len + et_subj_len + 2);

	if et_flavour = xamu_REPLY
	then et_reply_no = xforum_meeting_info.current;
	else et_reply_no = 0;

	call forum_$enter_trans (xforum_meeting_info.idx, et_trans_seg.txt,
	     et_reply_no, et_trans_seg.subj, xamu_OFF, et_trans_num, et_code);
	if et_code ^= 0 then do;
	     call com_err_$suppress_name (et_code, xamu_ME, "Trying to enter comment.");
	     call timer_manager_$sleep (3, "11"b);
	     goto exit_enter_trans;
	end;

	if et_trans_num > xforum_meeting_info.last_trans + 1
	then do;
	     do et_i = xforum_meeting_info.last_trans + 1 to et_trans_num - 1;
		xforum_meeting_info.seen_map_ptr -> seen_map (et_i) = "0"b;
		xforum_meeting_info.unread_count = xforum_meeting_info.unread_count + 1;
	     end;
	     if xforum_meeting_info.next_unread = -1
	     then xforum_meeting_info.next_unread = xforum_meeting_info.last_trans + 1;
	end;

	xforum_meeting_info.seen_map_ptr -> seen_map (et_trans_num) = "1"b;
	xforum_meeting_info.last_trans = et_trans_num;

	call ioa_ ("Comment ^d entered into the ^a meeting.", et_trans_num,
	     xforum_meeting_info.name);
	call timer_manager_$sleep (3, "11"b);

exit_enter_trans:
	return;

collect_spy_data: proc (csd_where, csd_response);

/* PARAMETERS */

	dcl     csd_where		 fixed bin;	/* (input) location response was collected */
	dcl     csd_response	 char (*);	/* (input) user's response */





	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

error: proc (e_code, e_message);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with the error */
	dcl     e_message		 char (*);	/* (input) message to be output to user */





	xamu_xforum_error_info.name = xamu_ME;
	xamu_xforum_error_info.entry = "";
	xamu_xforum_error_info.doing = "";
	xamu_xforum_error_info.code = e_code;
	xamu_xforum_error_info.reason = e_message;

	call signal_ ("xforum_fatal_error", null (), addr (xamu_xforum_error_info), null ());

     end error;

     end xforum_attend_mtg_utilities;




		    xforum_create_menu_.pl1         04/25/86  0814.5rew 04/24/86  1513.4       43857



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(85-05-21,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed the values of max_width and max_height in the
     actual_menu_format structure to reflect the actual width of the menu
     window and a height equal to the sum of the current menu and bottom
     window heights instead of the constants 80 and XFORUM_WINDOW_HEIGHT
     which was decleared in xforum_menu_info.incl.pl1 and had a value of 11.
     removed the reference to xforum_menu_info.incl.pl1 and updated the
     the header comments.
                                                   END HISTORY COMMENTS */


xforum_create_menu_: proc (choices, requirements_ptr, menu, code);

/*
   BEGIN DESCRIPTION

   function:
      This procedure creates the "static" menus displayed in the menu window. 
      It takes care of the details of header and trailer construction and the
      info structures needed by the menu_$create_menu procedure, both
      simplifying the interface for the callers and enforcing some consistency
      among menus.

   description of entry points:
      xforum_create_menu_:
         input:   (*) char (*) varying  text describing the menu options
                  ptr                   ptr to the menu_requirements structure
                                        note that contents of structure is output
         output:  ptr                   pointer to the menu structure
                  fixed bin (35)        standard error code
         The menu created has no header line and a single trailing line made up
         of dashes. It has 2 columns. The menu is created in the system free
         area and should be freed when no longer used. 

   description of internal procedures:

   known bugs:

   notes:

   history:
      83-??-?? Deryk Barker: Written.

      84-07-06 Davids: Changed header from a parameter to an automatic
      variable. Set its value to "" so that the menu software will generate
      a menu with no header. The menu header has been moved to the status
      window so that it will still appear if the process has local menu
      display.

      84-11-06 Davids: Redid declaration section.

   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     choices		 (*) char (*) varying; /* (input) text describing the menu options */
	dcl     requirements_ptr	 ptr;		/* (input) ptr to the menu_requirements structure */
	dcl     menu		 ptr;		/* (output) pointer to the menu structure */
	dcl     code		 fixed bin (35);	/* (output) standard error code */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     get_system_free_area_	 entry () returns (ptr);

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

	dcl     headers		 (1) char (1) varying; /* constant info to appear on top of the menu */
	dcl     trailer		 (1) char (1) varying; /* constant info to appear on the bottom of the menu */
	dcl     1 actual_menu_format	 aligned like menu_format; /* local copy of the menu_format structure */

/* INTERNAL STATIC */

/* CONSTANTS */

	dcl     (
	        PAD_CHAR		 init ("-") char (1), /* used to center header and trailer info in window */
	        OPTION_CODES	 (35) init (	/* keys for selecting menu options */
				 "1", "2", "3", "4", "5", "6", "7", "8", "9",
				 "a", "b", "c", "d", "e", "f", "g", "h", "i", "j",
				 "k", "l", "m", "n", "o", "p", "q", "r", "s", "t",
				 "u", "v", "w", "x", "y", "z") char (1) unal
	        )			 internal static options (constant);

/* BUILTINS */

	dcl     addr		 builtin;

/* BASED */

/* INCLUDE FILES */

%include menu_dcls;
%page;
%include xforum_windows;

	menu_requirements_ptr = requirements_ptr;
	trailer (1) = PAD_CHAR;
	headers (1) = "";

	actual_menu_format.version = menu_format_version_1;
	actual_menu_format.max_width = xforum_windows.menu.extent.width;
	actual_menu_format.max_height = xforum_windows.menu.extent.height + xforum_windows.bottom.extent.height;
	actual_menu_format.n_columns = 2;
	actual_menu_format.center_headers = "1"b;
	actual_menu_format.center_trailers = "1"b;
	actual_menu_format.pad = "0"b;
	actual_menu_format.pad_char = PAD_CHAR;


	call menu_$create (choices, headers, trailer, addr (actual_menu_format), OPTION_CODES,
	     get_system_free_area_ (), menu_requirements_ptr, menu, code);

	return;

     end xforum_create_menu_;




		    xforum_data_.cds                12/07/87  1328.2r w 12/07/87  1321.7       13158




/* HISTORY COMMENTS:
  1) change(86-01-17,LJAdams), approve(86-02-18,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     This program creates the xforum data structure for the help search
     directories.
                                                   END HISTORY COMMENTS */

xforum_data_:
	proc;

dcl  create_data_segment_ entry (ptr, fixed bin (35));

dcl  1 cdsa	     aligned like cds_args;

dcl  code		     fixed bin (35);

dcl  name		     char (12) aligned static init
                         ("xforum_data_") options (constant),
     exclude_pad         (1) char (32) aligned static options (constant) init
		     ("pad*");

dcl (dim,
     addr,
     size,
     string)	     builtin;

%include xforum_data_;

dcl 1 xforum_data aligned,
      2 help_dirs,
        3 N fixed bin,
        3 dir_array (2) char(168);


/* Set up help directory search paths */

xforum_data.help_dirs.N = dim(xforum_data.dir_array, 1);

xforum_data.dir_array(1) = ">doc>ss>xforum";
xforum_data.dir_array(2) = ">doc>info";

/* Now set up call to create data base */

cdsa.sections (1).p = addr (xforum_data);
cdsa.sections (1).len = size (xforum_data);
cdsa.sections (1).struct_name = "xforum_data";
cdsa.seg_name = name;
cdsa.num_exclude_names = 1;
cdsa.exclude_array_ptr = addr (exclude_pad);
string (cdsa.switches) = "0"b;
cdsa.switches.have_text = "1"b;
call create_data_segment_ (addr (cdsa), code);

% include cds_args;

end xforum_data_;




		    xforum_default_fkeys_.pl1       04/25/86  0814.5rew 04/24/86  1513.4       36486



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



/****^  HISTORY COMMENTS:
  1) change(84-11-06,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Improved the functional description and redid the declarations.
                                                   END HISTORY COMMENTS */


xforum_default_fkeys_: proc () returns (ptr) /* must be quick */;

/*
   BEGIN DESCRIPTION

   function:
      This module creates a static function key data structure that does not
      depend on function keys that are part of the currently used terminal. The
      function key mapping is:
              1:  ESC?           9:   ESCF
              2:  ESCf           11:  ESCP
              3:  ESCp           12:  ESCQ
              4:  ESCq           13:  ESCR
              5:  ESCr           14:  ESCL
              6:  ESCl           15:  ESCH
              7:  ESCh           16:  ESCE
              8:  ESCe

   description of entry points:
      xforum_default_fkeys_:
         input:
         output:  returns (ptr)    A pointer to the function_key_data structure
         The function key data structure is allocated in the system_free_area_.
         A pointer to the structure is keep in internal static. If a call is
         made and the internal static pointer is not null then the pointer
         value is returned. If the pointer is null, the structure is allocated,
         the static pointer value set, and the pointer value returned. Note
         that the structure is NOT FREED when xforum terminates. It is a small
         structure and it was decided to leave it around so that it could be
         used in another invocation of xforum.

   description of internal procedures:

   known bugs:

   notes:

   history:
      83-??-?? Deryk Barker: written.

      84-09-17 Davids: Added the upper case letters to the list of pseudo
      function keys.

   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     get_system_free_area_	 entry () returns (ptr);

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

	dcl     i			 fixed bin;	/* loop index */

/* INTERNAL STATIC */

	dcl     default		 static ptr init (null); /* pointer to the allocated structure */

/* CONSTANTS */

	dcl     (
	        ESC		 init ("") char (1), /* escape character, \033 */
	        PSEUDO_KEYS		 init ("?fpqrlheFPQRLHE") char (15) /* second characters in the */
	        )			 internal static options (constant); /* pseudo function keys */

/* BUILTINS */

          dcl     length                 builtin;
          dcl     null		 builtin;
          dcl     substr                 builtin;

/* BASED */

	dcl     default_fkey_seq	 char (default -> function_key_data.seq_len) /* string defining the pseudo */
				 based (default -> function_key_data.seq_ptr); /* function key character sequences */
	dcl     system_area		 area based (get_system_free_area_ ()); /* system free area */

/* INCLUDE FILES */

%include function_key_data;

	if default ^= null ()
	then return (default);

	function_key_data_highest = length (PSEUDO_KEYS);

	allocate function_key_data set (default) in (system_area);
	default -> function_key_data.version = function_key_data_version_1;
	default -> function_key_data.seq_len = 2 * function_key_data_highest;

	allocate default_fkey_seq in (system_area);
	do i = 1 to function_key_data_highest;
	     substr (default_fkey_seq, 2 * i - 1, 1) = ESC;
	     substr (default_fkey_seq, 2 * i, 1) = substr (PSEUDO_KEYS, i, 1);
	     default -> function_key_data.function_keys (i, KEY_PLAIN).sequence_index = 2 * i - 1;
	     default -> function_key_data.function_keys (i, KEY_PLAIN).sequence_length = 2;
	end;

	return (default);

     end xforum_default_fkeys_;




		    xforum_dyn_menu_.pl1            08/06/87  1025.1rew 08/06/87  1014.1      278163



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



/****^  HISTORY COMMENTS:
  1) change(85-01-08,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Removed the function_key_data_ptr paramater from the calling
     sequence of get_choice.  Replaced it with a call to
     xforum_user_profile$get_function_key_data_ptr.
     
     85-04-02 Davids: Added the entry point display_and_get_choice.
     This entry will, given an array of options, create a dynamic menu
     of those options, display the sub menus created and process the
     function keys.  It will also add to the original list of options a
     special option that will go at the end of each sub menu.
     
     85-04-03 Davids: Added the entry point prompt_instead_of_menu.
     This entry point will prompt the user from some input.  It will
     handle the cases of input too long, blank line input, and ?.  It
     will return other responses.  It will also handle the help line
     and quit.  This entry was put in this module because it prompts
     the user for a response that could have been selected via a
     dynamic menu.  It cannot check that response against the choices
     on the menu because in some cases a special array of menu options
     will not be built unless the user explicily asks for a menu.
  2) change(85-04-16,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed the way that the prompt option was being added to the
     array of choices in the display_and_get_choice routine.  It was
     adding a choice to the array incrementing the count and then if
     the count indicated the prompt option should be added, adding it
     and incrementing the count again.  When the loop exited it
     automaticaly added a prompt option to the end.  This worked OK
     except for the case where the options exactly fited in a set of
     menus.  Then the prompt option automatically added caused a
     subscript out of bounds condition.  The solution was to move the
     test for adding the prompt option in the loop from after the
     addition of a choice to before it.  This way the loop terminates
     before the final prompt option can be added.
     
     85-05-24 Davids: Converted the create, display, get_choice, and
     destroy entry points to internal procs.  Replaced the return after
     the main entry point to a call to error and added the error proc.
     Replaced global variable references in create, display,
     get_choice, and destroy with internal variables that conform to
     the prefix naming convension.  Replaced the begin block in create
     that was used to declare a temporary array of choices to be passed
     to menu by just overlaying the input array of choices.  This
     eliminated the loop that was required to load the temporary array.
  3) change(85-05-28,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Completed variable cleanup and testing of new create code.  Also
     added a call to free the xdm_dyn_menu structure after all the
     menus are destroyed in the destroy procedure.  Removed the
     included file function_key_data, the only thing being used was the
     declaration of the function_key_data_ptr variable.  That is now
     declared locally in the get_choice procedure.  Updated the
     functional descriptions of the internal procedures.
     
     85-05-29 Davids: Added the functional descriptions of the entry points.
  4) change(87-04-13,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Changed to allow command_processor_ escapes.
                                                   END HISTORY COMMENTS */


xforum_dyn_menu_: proc ();

/*
   BEGIN DESCRIPTION

   function:
      This module manages dynamic menus. Dynamic menus are menus with no fixed
      content that are displayed in the bottom window.

   description of entry points:
      xforum_dyn_menu:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error
         condition will be signaled with an "internal programming error" error
         message.

      display_and_get_choice:
         input:   (*) char (*)    choices in the menu
                  fixed bin       number of choices
                  char (*)        title of the menu
                  char (*)        text of menu option that will abort menu and
                                  display prompt
                  char (*)        help line break message
                  fixed bin       identifies location for spy recording
                  ptr             points to xforum_spy structure /* 
         output:  fixed bin       index into choices array that user selected
                                  or -1 if user selected the "prompt_me" option
         This entry will create, display, get the user's choice, and destroy
         a dynamic menu. A dynamic menu appears in the bottom (user_io) window.
         The title of the menu is overlaid on the bottom line of the top (menu)
         window and is replaced with dashes (-) when the menu is destroyed.
         There can be any number of choices in the dynamic menu. If there are
         more choices than can fit in the bottom window several menus will be
         created. The last option of each menu is the prompt_option. This
         option should be used to allow the user to indicate that he does not
         want to select from a menu but wants to be prompted. The user's choice
         is collected in the spy structure as either a function key or the
         menu option - the actual name of the choice is not recorded. 
         A zero index returned indicates that the user made no choice and
         wants to abort the selection process. This is the result of a QUIT.

      prompt_instead_of_menu:
         input:   char (*)          for help line to indicate where BREAK will
                                    put the user
                  char (*)          variable part of prompt
                  char (*)          description of object to be entered,
                                    initial capital and plural
                  char (*)          description of object to be entered,
                                    lower case and singular
                  char (*)          prompt info seg identifier
                  fixed bin         id for what is being asked for
                  ptr               pointer to spy segment
         output:  char (*) varying  user's response
         This entry is used to prompt the user for a choice that could also be
         obtained from a dynamic menu. It is part of the this module because it
         is so closely associated with dynamic menus. If the index returned
         from a call to display_and_get_choice is -1 this entry should be
         called. Similarly if this entry returns ?? then display_and_get_choice
         should be called. This entry prompts the user for some input. The
         reply is checked for length and must not be longer than the output
         parameter associated with the response. A null response is also
         checked for. If either of these two cases occur an error message is
         output and the prompt repeated. If the user enters a question mark
         the xforum_help info file is searched for the input help text id and
         the text displayed to the user, after that the prompt is repeated.
         Any other text is passed on to the called. NOTE that the response
         is not comapred with the choices on the dynamic menu because it is
         possible that the choice would not appear on the menu, i.e. the user
         changed his forum search rules so that new meetings not in the 
         meeting search list can be found. He could enter a new meeting name
         via a prompt and have it found but could not select it via a dynamic
         menu of the meetings in the meeting list. This is also why there are
         two separate entries instead of 1 entry which handles both the
         prompt and the menu. A null string is returned in the event of a QUIT.

   description of internal procedures:
      create: This procedure creates a set of menus each of which has two
      columns, 1 header line and no trailing line. Each menu except possibly
      the last menu in the set will have 2N options where N = lines in user_io
      window - 1. Each menu is created by overlaying the input list of options
      and giving them in blocks of 2N to menu_$create. The xdm_dyn_menu
      structure is allocated in the xforum_system_free area and loaded.

      display: This procedure calls menu_$display to display one of the dynamic
      menus. The dynamic menu to be displayed is indentified by an index into
      the dynamic menu structure array. The pointer to that structure is also
      input.

      get_choice: This procedure is used to get the user's choice from a
      dynamic menu. Like display the dynamic menu is identified by an index
      into the dynamic menu structure array and the pointer to that structure
      is also input. The menu_$get_choice routine is called to actually get the
      user's choice. If the error code returned by menu_ is 
      window_status_pending a call to iox_ is made to reset the status pending
      flag and the call to menu_ repeated.

      destroy: This procedure frees all the allocated space associated with the
      dynamic menus.

      collect_spy_data: Similar to all the other collect_spy_data procedures.
      See the xforum module. Note that this procedure is duplicated so as to
      save the expense of an external call for a commonly executed, very short
      program, whose output is used only during development or special site
      exposure.

      error: Similar to all the other error procedures. It records in an
      internal static structure the details of an error and then signals the
      xforum_fatal_error condition.

   known bugs:

   notes:

   history:
      83-12-?? DBarker: dynamic menu procedure for executive_forum - "adapted" 
      from xmail's code.

      84-03-29 Davids: Modified to check for a window_status_pending error
      being returned from menu_$get_choice in the get_choice entry. If that
      error is returned the status is reset and the call to menu_$get_choice
      repeated. Any other error will just cause the call to menu_$get_choice to
      be repeated.

      84-11-14 Davids: Auditing changes: 1) Added a return statement before the
      create entry so calls to the main entry do not fall into create. 2) In
      the create entry changed the return statement in the begin block to a
      goto exit_create and added the exit_create label before the final return.
      3) In get_choice changed the variable that controls the loop from P_code
      to a local variable and set the value of P_code from the local variable
      once the loop terminates. Other Changes: rearranged the declarations;
      removed all the declarations from the create begin block except those
      declarations that must be part of the block. Also move the external
      declarations from get_choice.
   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

	dcl     iox_$user_io	 ptr ext static;
	dcl     video_et_$window_status_pending fixed bin (35) ext static;

/* ENTRIES */

          dcl     ioa_		 entry() options(variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
          dcl     xforum_get_str_	 entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
	dcl     signal_		 entry () options (variable);
	dcl     window_$bell	 entry (ptr, fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     window_$overwrite_text entry (ptr, char (*), fixed bin (35));
	dcl     window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));
	dcl     window_$sync	 entry (ptr, fixed bin (35));
	dcl     xforum_help_line_$push entry (bit (8) aligned, char (*), char (*), char (*));
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_user_profile$get_function_key_data_ptr entry () returns (ptr);

/* CONDITIONS */

	dcl     quit		 condition;

/* INTERNAL AUTOMATIC */

	dcl     xdm_dyn_menup	 ptr;		/* pointer to the xdm_dyn_menu structure */
	dcl     xdm_n_menus		 fixed bin;	/* number of submenus needed to display all the choices */

/* INTERNAL STATIC */

	dcl     01 xdm_xforum_error_info like xforum_error_info internal static;

/* CONSTANTS */

	dcl     (
	        xdm_ME		 char (16) init ("xforum_dyn_menu_"), /* module name */
	        xdm_OPTION_CODES	 (61) char (1) unal
				 init ("1", "2", "3", "4", "5", "6", "7", "8", "9",
				 "a", "b", "c", "d", "e", "f", "g", "h", "i", "j",
				 "k", "l", "m", "n", "o", "p", "q", "r", "s", "t",
				 "u", "v", "w", "x", "y", "z", "A", "B", "C", "D",
				 "E", "F", "G", "H", "I", "J", "K", "L", "M", "N",
				 "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X",
				 "Y", "Z"),	/* keys for menu choices */
	        xdm_REDISPLAY	 fixed bin init (5),/* function keys for redisplay */
	        xdm_REDISPLAY2	 fixed bin init (12),
	        xdm_SCROLL_DOWN	 fixed bin init (6),/* function keys for previous menu */
	        xdm_SCROLL_DOWN2	 fixed bin init (13),
	        xdm_SCROLL_UP	 fixed bin init (7),/* function keys for next menu */
	        xdm_SCROLL_UP2	 fixed bin init (14)
	        )			 internal static options (constant);
	

/* BUILTINS */

	dcl     (
	        addr,
	        ceil,
	        char,
	        divide,
	        float,
	        hbound,
	        length,
	        ltrim,
                  maxlength,
	        mod,
	        null,
	        rtrim,
	        substr
	        )			 builtin;

/* BASED */

	dcl     xdm_based_area	 area based (xforum_system_area_ptr); /* area xdm_dyn_menu allocated in */

	dcl     1 xdm_dyn_menu	 aligned based (xdm_dyn_menup), /* info about all the submenus created */
		2 nth_menu	 fixed bin,	/* number of submenus created */
		2 menu_array	 (0:xdm_n_menus - 1 refer (xdm_dyn_menu.nth_menu)),
		  3 location	 ptr,		/* pointer to menu structure for menu_ */
		  3 first_option	 fixed bin,	/* index into original array of first option in submenu */
		  3 option_count	 fixed bin;	/* number of options in submenu */


/* INCLUDE FILES */

%include menu_dcls;
%page;
%include window_status;
%page;
%include xforum_error_info;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;
%page;
%include xforum_windows;
%page;
%include xforum_prompts;


%include xforum_answers;


%include xforum_help_infos;


	call error (0, "Internal programming error - xforum_dyn_menu$xforum_dyn_menu called.");

display_and_get_choice: entry (dagc_choices, dagc_num_choices, dagc_title, dagc_prompt_option,
	dagc_help_line_break_message, dagc_spy_position, dagc_spy_ptr, dagc_selected_index);


/* PARAMETERS */

	dcl     dagc_choices	 (*) char (*);	/* (input) choices in the menu */
	dcl     dagc_num_choices	 fixed bin;	/* (input) number of choices */
	dcl     dagc_title		 char (*);	/* (input) title of the menu */
	dcl     dagc_prompt_option	 char (*);	/* (input) text of menu option that will */
						/*         abort menu and display prompt */
	dcl     dagc_help_line_break_message char (*);	/* (input) help line break message */
	dcl     dagc_spy_position	 fixed bin;	/* (input) identifies location for spy recording */
	dcl     dagc_spy_ptr	 ptr;		/* (input) points to xforum_spy structure */
	dcl     dagc_selected_index	 fixed bin;	/* (output) index into dagc_choices array that user selected */
						/*          or -1 if user selected the "prompt me" option */

/* INTERNAL AUTOMATIC */

	dcl     dagc_choice		 fixed bin;	/* user's choice on the submenu currently displayed */
	dcl     dagc_code		 fixed bin (35);	/* standard error code */
	dcl     dagc_dyn_menup	 ptr;		/* points to the xdm_dyn_menu structure */
	dcl     dagc_items_per_menu	 fixed bin;	/* number of choices per submenu */
	dcl     dagc_fkey		 bit (1) aligned;	/* "1"b imples that user selected a function key */
	dcl     dagc_menu_index	 fixed bin;	/* index of a submenu */
	dcl     dagc_number_dashes	 fixed bin;	/* left column of title when centered in window */
	dcl     dagc_number_of_menus	 fixed bin;	/* total number of submenus needed to display all the choices */
	dcl     dagc_option_index	 fixed bin;	/* user's choice based on total number of choices */

	dcl     1 dagc_dyn_menu_req	 aligned,		/* describes the submenus */
		2 options_per_menu	 fixed bin,
		2 options_last_menu	 fixed bin,
		2 n_menus		 fixed bin;

/* CONSTANTS */

	dcl     dagc_DASHES		 char (80) init ("--------------------------------------------------------------------------------")
				 internal static options (constant); /* used to restore the top menus */
						/* bottom line of dashes when routine returns to caller */

	spy_ptr = dagc_spy_ptr;

	dagc_items_per_menu = (xforum_windows.bottom.height - 1) * 2;
	dagc_number_of_menus = ceil (float (dagc_num_choices) / float (dagc_items_per_menu - 1));
						/* The last item doesn't count its ENTER... */


	begin;
	     dcl	   dagc_i		      fixed bin;	/* array index */
	     dcl	   dagc_j		      fixed bin;	/* loop index */
	     dcl	   dagc_names	      (dagc_num_choices + dagc_number_of_menus) char (32) varying;
						/* submenu choices, including the "prompt me" choices */
	     dcl	   dagc_nindex	      (dagc_num_choices + dagc_number_of_menus) fixed bin;
						/* maps choices in dagc_names array to original indicies in */
						/* dagc_choices array and maps "prompt me" choices to -1 */

	     dagc_i = 1;
	     dagc_dyn_menup = null ();

	     on quit
		begin;
		     call collect_spy_data (dagc_spy_position, "QUIT");
		     dagc_selected_index = 0;
		     goto exit_get_choice_from_menu;
		end;

	     do dagc_j = 1 to dagc_num_choices while (dagc_i <= (dagc_num_choices + dagc_number_of_menus));
		if mod (dagc_i, dagc_items_per_menu) = 0
		then do;
		     dagc_names (dagc_i) = dagc_prompt_option;
		     dagc_nindex (dagc_i) = -1;
		     dagc_i = dagc_i + 1;
		end;
		dagc_names (dagc_i) = dagc_choices (dagc_j);
		dagc_nindex (dagc_i) = dagc_j;
		dagc_i = dagc_i + 1;
	     end;
	     dagc_names (dagc_i) = dagc_prompt_option;
	     dagc_nindex (dagc_i) = -1;

	     call create (dagc_names,
		addr (xforum_windows.bottom.position), addr (dagc_dyn_menu_req),
		dagc_dyn_menup, dagc_code);
	     if dagc_code ^= 0
	     then go to exit_get_choice_from_menu;

	     call xforum_help_line_$push ("00000110"b, "", dagc_help_line_break_message, "");

	     dagc_menu_index = 0;

	     dagc_number_dashes = (xforum_windows.menu.position.width - length (dagc_title)) / 2;
	     call window_$position_cursor (xforum_windows.menu.iocb,
		xforum_windows.menu.extent.height, dagc_number_dashes, (0));
	     call window_$overwrite_text (xforum_windows.menu.iocb, (dagc_title), (0));

	     do while ("1"b);
display_submenu:
		call display (dagc_dyn_menup, dagc_menu_index, dagc_code);
		if dagc_code ^= 0
		then go to exit_get_choice_from_menu;

		call get_choice (dagc_dyn_menup, dagc_menu_index,
		     dagc_choice, dagc_fkey, dagc_code);
		if dagc_code ^= 0
		then go to exit_get_choice_from_menu;

		if dagc_fkey
		then call collect_spy_data (dagc_spy_position, "F" || rtrim (ltrim (char (dagc_choice))));
		else call collect_spy_data (dagc_spy_position, rtrim (ltrim (char (dagc_choice))));

		if ^dagc_fkey
		then do;
		     dagc_option_index =
			dagc_menu_index * dagc_dyn_menu_req.options_per_menu + dagc_choice;
		     dagc_selected_index = dagc_nindex (dagc_option_index);
		     go to exit_get_choice_from_menu;
		end;
		else if dagc_choice = xdm_REDISPLAY | dagc_choice = xdm_REDISPLAY2
		then do;
		     call xforum_redisplay_;
		     goto display_submenu;		/* Q and D - but WTH */
		end;
		else if dagc_choice = xdm_SCROLL_UP | dagc_choice = xdm_SCROLL_UP2
		then dagc_menu_index =
			mod (dagc_menu_index + 1, dagc_dyn_menu_req.n_menus);
		else if dagc_choice = xdm_SCROLL_DOWN | dagc_choice = xdm_SCROLL_DOWN2
		then dagc_menu_index =
			mod (dagc_menu_index - 1, dagc_dyn_menu_req.n_menus);
		else call window_$bell (xforum_windows.menu.iocb, (0));
	     end;					/* do while ... */

exit_get_choice_from_menu:
	     call destroy (dagc_dyn_menup);
	     call window_$clear_window (xforum_windows.bottom.iocb, (0));

	     call window_$position_cursor (xforum_windows.menu.iocb,
		xforum_windows.menu.extent.height, dagc_number_dashes, (0));
	     call window_$overwrite_text (xforum_windows.menu.iocb, substr (dagc_DASHES, 1, length (dagc_title)), (0));
	     call window_$sync (xforum_windows.menu.iocb, (0));

	     call xforum_help_line_$pop;
	end;

	return;

prompt_instead_of_menu: entry (piom_help_line_break_text, piom_prompt_text, piom_error_text_1,
	piom_error_text_2, piom_help_id, piom_spy_id, piom_spy_ptr, piom_response);

/* PARAMETERS */

	dcl     piom_help_line_break_text char (*);	/* (input) for help line to indicate where BREAK will put the user */
	dcl     piom_prompt_text	 char (*);	/* (input) variable part of prompt */
	dcl     piom_error_text_1	 char (*);	/* (input) description of object to be */
						/*         entered, initial capital and plural */
	dcl     piom_error_text_2	 char (*);	/* (input) description of object to be */
						/*         entered, lower case and singular */
	dcl     piom_help_id	 char (*);	/* (input) prompt info seg identifier */
	dcl     piom_spy_id		 fixed bin;	/* (input) id for what is being asked for */
	dcl     piom_spy_ptr	 ptr;		/* (input) pointer to spy segment */
	dcl     piom_response	 char (*) varying;	/* (output) user's response */

/* INTERNAL AUTOMATIC */

	dcl     piom_reply		 char (256);	/* user's reply */
          dcl     piom_code		 fixed bin (35);
		    
/* EXTERNAL ENTRY */

          dcl     error_table_$long_record	
                                         fixed bin(35) ext static;
		    

	spy_ptr = piom_spy_ptr;

	call xforum_help_line_$push ("0"b, "", "", "Press  ? and RETURN:help  BREAK:" || piom_help_line_break_text);

	on quit
	     begin;
		piom_response = "";
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		goto exit_prompt_instead_of_menu;
	     end;

	piom_reply = "";
          answer_array.N = 0;				/* Accept all answers			*/
          answer_array.max_length = maxlength (piom_response);

          do while (piom_reply = "");
	   call xforum_get_str_ ((piom_prompt_text || " (or ?? for menu): "), addr(answer_array), PROMPT_HELP, piom_help_id, piom_response, piom_code);

             if piom_code = error_table_$long_record
             then do;
	        call ioa_ ("^a cannot be more than ^i characters long.", piom_error_text_1, maxlength(piom_response));
	        call ioa_ ("Please try again or press BREAK to ^a.", piom_help_line_break_text);
	        end;

	   piom_reply = substr (piom_response, 1);
	   if piom_reply ^= ""
             then call collect_spy_data (piom_spy_id, substr (piom_response, 1));
          end;

exit_prompt_instead_of_menu:
	call xforum_help_line_$pop;

	return;

create: proc (c_choices, c_window_infop, c_dyn_menu_reqp, c_dyn_menup, c_code);

/* PARAMETERS */

	dcl     c_choices		 (*) char (32) varying; /* (input) text of the menu options */
	dcl     c_window_infop	 ptr;		/* (input) pointer to a window_position_info str */
	dcl     c_dyn_menu_reqp	 ptr;		/* (input) pointer to a dyn_menu_req structure */
	dcl     c_dyn_menup		 ptr;		/* (output) pointer to a dyn_menu structure */
	dcl     c_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     c_done_with_choices	 bit (1);		/* "1"b imples that all the choices have been placed in a submenu */
	dcl     c_menu_no		 fixed bin;	/* index of a submenu */
	dcl     c_choice_count	 fixed bin;	/* count of choices already placed in a submenu */
	dcl     c_header		 (1) char (80) varying; /* header line, gives current submenu */
						/* number and total number of submenus */
	dcl     c_slots_avail	 fixed bin;	/* number of choices that can fit in the submenu */
						/* 2 columns of choices, 1 line of window for header */
	dcl     c_slots_needed	 fixed bin;	/* number of choices for all submenus */
	dcl     c_submenu_choices_count fixed bin;	/* number of choices in a submenu */
	dcl     c_submenu_choices_ptr	 ptr;		/* pointer to the first choice in a submenu */
	dcl     01 c_menu_format	 aligned like menu_format; /* describes the menu to be created by menu_ */
	dcl     01 c_menu_requirements aligned like menu_requirements; /* describes the requirements of the menu */

/* BASED */

	dcl     c_submenu_choices	 (c_submenu_choices_count) char (32) varying based (c_submenu_choices_ptr);
						/* choices for a given submenu */
	dcl     01 c_dyn_menu_req	 aligned based (c_dyn_menu_reqp), /* describes the submenus created */
		02 options_per_menu	 fixed bin,
		02 options_last_menu fixed bin,
		02 n_menus	 fixed bin;
	dcl     01 c_window_info	 like window_position_info based (c_window_infop);
						/* describes the window the menus will be displayed in */

	c_dyn_menup = null ();
	c_code = 0;

	c_slots_avail = 2 * (c_window_info.height - 1);	/* 2 columns, 1 header, no trailers */
	c_slots_needed = hbound (c_choices, 1);

	xdm_n_menus = divide (c_slots_needed + c_slots_avail - 1, c_slots_avail, 17, 0);

	allocate xdm_dyn_menu in (xdm_based_area);

	c_menu_format.version = menu_format_version_1;
	c_menu_format.max_width = c_window_info.width;
	c_menu_format.max_height = c_window_info.height;
	c_menu_format.n_columns = 2;
	c_menu_format.center_headers = "1"b;
	c_menu_format.center_trailers = "1"b;
	c_menu_format.pad = "0"b;
	c_menu_format.pad_char = " ";

	c_menu_requirements.version = menu_requirements_version_1;

	c_choice_count = 1;
	c_done_with_choices = "0"b;

	do c_menu_no = 0 to xdm_dyn_menu.nth_menu;
	     c_submenu_choices_ptr = addr (c_choices (c_choice_count));
	     if c_choice_count + c_slots_avail > c_slots_needed
	     then c_submenu_choices_count = c_slots_needed - c_choice_count + 1;
	     else c_submenu_choices_count = c_slots_avail;
	     c_choice_count = c_choice_count + c_slots_avail;

	     xdm_dyn_menu.menu_array (c_menu_no).option_count = c_submenu_choices_count;
	     xdm_dyn_menu.menu_array (c_menu_no).first_option = c_menu_no * c_slots_avail + 1;

	     call ioa_$rsnnl ("Choices (menu ^d of ^d)", c_header (1), (0), c_menu_no + 1, xdm_n_menus);

	     call menu_$create (c_submenu_choices, c_header, "",
		addr (c_menu_format), xdm_OPTION_CODES, xforum_system_area_ptr,
		addr (c_menu_requirements),
		xdm_dyn_menu.menu_array (c_menu_no).location, c_code);

	     if c_code ^= 0
	     then goto exit_create;

	end;					/* do c_menu_no = ... */

	if c_dyn_menu_reqp ^= null
	then do;
	     c_dyn_menu_req.options_per_menu = c_slots_avail;
	     c_dyn_menu_req.options_last_menu = xdm_dyn_menu.menu_array (xdm_n_menus - 1).option_count;
	     c_dyn_menu_req.n_menus = xdm_n_menus;
	end;

	c_dyn_menup = xdm_dyn_menup;

exit_create:
	return;

     end create;

display: proc (d_dyn_menup, d_index, d_code);

/* PARAMETERS */

	dcl     d_dyn_menup		 ptr;		/* (input) pointer to the dyn_menu structure */
	dcl     d_index		 fixed bin;	/* (input) index of submenu to display */
	dcl     d_code		 fixed bin (35);	/* (output) standard error code */





	d_code = 0;
	xdm_dyn_menup = d_dyn_menup;

	call menu_$display (iox_$user_io, xdm_dyn_menu.menu_array (d_index).location, d_code);

	return;

     end display;

get_choice: proc (gc_dyn_menup, gc_index, gc_choice, gc_fkey, gc_code);

/* PARAMETERS */

	dcl     gc_dyn_menup	 ptr;		/* (input) pointer to the dyn_menu structure */
	dcl     gc_index		 fixed bin;	/* (input) index of the submenu being answered */
	dcl     gc_choice		 fixed bin;	/* (output) index of choice from menu or function key */
	dcl     gc_fkey		 bit (1) aligned;	/* (output) "1" implies that choice is a function key */
	dcl     gc_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     gc_function_key_data_ptr ptr;		/* pointer to the function_key_data structure for the users terminal */
	dcl     gc_ignore2		 fixed bin (35);	/* ignored output from system call */
	dcl     01 gc_window_status_info like window_status_info; /* local copy of window_status_info structure */





	gc_code = 1;
	gc_window_status_info.version = window_status_version_1;
	xdm_dyn_menup = gc_dyn_menup;
	gc_function_key_data_ptr = xforum_user_profile$get_function_key_data_ptr ();

	do while (gc_code ^= 0);
	     call menu_$get_choice (iox_$user_io,
		xdm_dyn_menu.menu_array (gc_index).location, gc_function_key_data_ptr,
		gc_fkey, gc_choice, gc_code);
	     if gc_code = video_et_$window_status_pending
	     then call iox_$control (iox_$user_io, "get_window_status", addr (gc_window_status_info), gc_ignore2);
	end;

	return;

     end get_choice;

destroy: proc (des_dyn_menup);

/* PARAMETERS */

	dcl     des_dyn_menup	 ptr;		/* (input) pointer to dyn_menu structure to be freed */

/* INTERNAL AUTOMATIC */

	dcl     des_i		 fixed bin;	/* loop index */





	xdm_dyn_menup = des_dyn_menup;

	if xdm_dyn_menup ^= null ()
	then do;
	     do des_i = 0 to xdm_dyn_menu.nth_menu;
		call menu_$destroy (xdm_dyn_menu.menu_array (des_i).location, (0));
	     end;
	     free xdm_dyn_menup -> xdm_dyn_menu;
	end;

	return;

     end destroy;

collect_spy_data: proc (csd_where, csd_response);


/* PARAMETERS */

	dcl     csd_where		 fixed bin;	/* (input) location response was collected */
	dcl     csd_response	 char (*);	/* (input) user's response */





	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

error: proc (e_code, e_message);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with the error */
	dcl     e_message		 char (*);	/* (input) message to be output to user */





	xdm_xforum_error_info.name = xdm_ME;
	xdm_xforum_error_info.entry = "";
	xdm_xforum_error_info.doing = "";
	xdm_xforum_error_info.code = e_code;
	xdm_xforum_error_info.reason = e_message;

	call signal_ ("xforum_fatal_error", null (), addr (xdm_xforum_error_info), null ());

     end error;

     end xforum_dyn_menu_;




		    xforum_emacs_ext_.lisp          08/20/86  2313.4r w 08/20/86  2245.0      267705



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

;;; HISTORY COMMENTS:
;;;  1) change(85-01-21,Davids), approve(86-02-04,MCR7350),
;;;     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
;;;     Modified so that the table of commands uses "CTL" for the
;;;     control key instead of "C" and "ESC" for the escape key instead
;;;     of "E".  Changed the way the subject is determined for reply
;;;     mode.  It now looks for the character <ESC> which now separates
;;;     the subject from the comment.  It then deletes the <ESC>
;;;     character and takes that location as the end of the subject.
;;;     It does all this instead of just going to the end of the line
;;;     because the subject might be several lines long (i.e.  have
;;;     embedded <NL>s).
     
;;;     85-01-22 Davids: Modified xforum:finish so that it puts an ESC
;;;     character at the end of subject text.
     
;;;     85-03-04 Davids: Added the reply_by_subject mode.  This acts like
;;;     reply mode except when things are being set up in xforum:reply.
;;;     If its by_subject a string representing the transaction number is
;;;     obtained and a search is made to position the buffer to the
;;;     transaction.
;;;  2) change(85-06-25,Davids), approve(86-02-04,MCR7350),
;;;     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
;;;     Removed all references to xforum_help_line_$pop.  Replaced all
;;;     references of xforum_help_line_$push_general_message_only with
;;;     calls to xforum_help_line_$change_general_message_only.  This was
;;;     easier than trying to figure out all the places that pops would be
;;;     needed.  Without the pops you would get help_line stack overflows
;;;     after entering about 7 comments in a row.
;;;  3) change(86-02-06,LJAdams), approve(86-02-18,MCR7350),
;;;     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
;;;     Added command-quit to quit handler for reconnect.
;;;                                                      END HISTORY COMMENTS


;;; Emacs extension to implement Executive Forum functions.
;;; Deryk Barker December 1983
;;; A certain amount of "borrowing" from xmail stuff
;;; 84-04-03 Senft: changed size of mini-buffer from 5 to 3
;;; 84-06-12 Schimke: Modified for compatibility with xmail extension:
;;;          commented out many of the extended features which require the site
;;;          to have full emacs (these may be added back compatibly with xmail 
;;;          at a future date), improved quit handler to warn before destroying
;;;          unsaved text, installed improved yesp function.
;;;
;;; 84-08-01 Davids: Modified xforum:instructions for reply mode to make the
;;; instructions correspond to the xforum MTB. Also modified xforum:help so
;;; that a better prompt is issued to the user and so that the ? response
;;; gives the appropriate list of commands. This was the extended features that
;;; were commented out by Dave.
;;;
;;; 84-08-02 Davids:modified xforum:insert-file and xforum:modify-subject
;;; to call xforum_status_$push_help_line, pop_help_line, and update_help_line.
;;; This improves help message handling. Also replaced references to
;;; transaction with references to comment in the help text.
;;;
;;; 84-08-06 Davids: Modified go-to-beginning-of-buffer to check and see if
;;; the user is currently in the minibuffer and if so to just use the standard
;;; go-to-beginning-of-buffer
;;;
;;; 84-08-10 Davids: Added missing commands to the help table and created a 
;;; separate table for reply mode. Added the display-buffer-as-pintout function
;;; and deleted the loadlib of e_macops_. Loading e_macops_ was very expensive
;;; to get just one same function. Add documentation to some of the commands
;;; which were still missing it.
;;;
;;; 84-10-01 Davids: Changed calls to xforum_status_$push_help_line,
;;; pop_help_line and update_help_line to
;;; xforum_help_line$push_general_message_only, pop, and
;;; push_general_message_only.
;;;
;;; 84-10-16 Davids: Changed the help line for modifing the subject so that
;;; it has the same format as the help line when entering a new subject. That
;;; help line is displayed by xforum_attend_mtg_options.
;;;
;;; 84-11-19 Davids: Changed xforum_help_line calls to xforum_help_line_
;;; calls. 
;;;
;;; 84-11-26 Davids: Added a test to the xforum:refill function so that it
;;; calls xforum:beginning-of-paragraph only if it is not already at the
;;; the beginning of the paragraph. The beginning of paragraph function will
;;; move you to the beginning of the next paragraph if you are at the beginning
;;; of the current paragraph. 
;;;

;;; Load in the necessary include files.
(%include e-macros)  
(%include backquote)

;;; To use in debug mode, remove the semicolon at the beginning of this line:
;(sstatus feature debug)

(declare
  ;; These are functions defined elsewhere in Emacs.
  (*lexpr minibuffer-response xforum:minibuffer-response report-error-noabort
	xforum:quit-handler)
  (*expr e_lap_$rtrim emacs$get_info_ptr error-table eval-lisp-line
         file-insert fill-current-line fill-mode go-to-end-of-line
         describe-key kill-to-beginning-of-line kill-lines lowercase-ttp
         loadlib redisplay-current-window-relative
         mark-at-current-point-p minibuffer-clear-all signalquit buffer-kill
         prev-line-command quit-force redisplay-command save-same-file
         search-not-charset-forward set-minibuffer-size user_info_$homedir
         eval:internal exists-file set-permanent-key e_lap_$return-string
         set-the-mark beginning-of-paragraph runoff-fill-region get_pdir_
         end-of-paragraph expand-window-to-whole-screen rdis-choose-echo-linex
         create-new-window-and-go-there find-file-subr at-beginning-of-paragraph
         emacs$set_emacs_return_code twiddle-chars twiddle-words e_cline_
         key-prompt get-key-binding get-key-name describe-internal forward-search)
  ;; Global variables.
  (special xforum:subject-text 
	 xforum:transaction-mark xforum:header-info xforum:mode xforum:sleep
	 xforum:silent-instructions known-buflist paragraph-definition-type
	 whitespace-charactertbl minibufferp mode-line-hook fill-prefix
	 suppress-minibuffer no-minibuffer-<> suppress-remarks
	 quit-on-break buffer-creation-hook default-fill-column
	 rdis-splln-mark selected-window transaction trans_string 
	 good-word-charactertbl quit-handler-invoked
           rdis-mbuf-transient-linex minibufwindow)
;;; Test for reconnect.
  (defpl1 xforum$reconnect_test "" (return bit (1) aligned)))

(eval-when (eval compile)
	 ;; Force output to the minibuffer.
	 (defun force-minibuffer-print macro (form)
	        `(let ((suppress-minibuffer nil))
		    suppress-minibuffer
		    (minibuffer-print . ,(cdr form))))
	 ;; Macro-defining-macro for mode checking.
	 (defun defmode macro (form)
	        `(defun ,(make_atom (catenate (cadr form) "-mode"))
		      macro (form)
		      '(eq xforum:mode ',(cadr form))))
	 ;; Define the known modes.
	 (defmode talk)
	 (defmode reply)
           (defmode reply_by_subject)
	 )

(defun xforum:setup ()
       (expand-window-to-whole-screen)

       ;;; Set the internal options of Emacs.
       (or (status feature debug)
	 (setq mode-line-hook 'xforum:mode-line	;Empty mode line.
	       paragraph-definition-type 2	;The "right" one.
	       suppress-minibuffer t		;No minibuffer output.
	       no-minibuffer-<> t		;No "<>" after mbuf input.
	       suppress-remarks t		;No Reading/Writing transactions.
	       default-fill-column 72.	;Fill column for all buffers.
	       fill-column 72.		;Fill column for this buffer.
	       quit-on-break t		;Quit Emacs on BREAK.
	       quit-handler-invoked nil         ;Not yet
	       buffer-creation-hook 'xforum:turn-on-fill  ;Turn on fill mode.
	       ))

       ;;; Set internal variables to xforum.
       (setq xforum:subject-text nil
	   xforum:silent-instructions t
	   xforum:sleep 3)

       ;;; Set these keys for all buffers.
       (mapc '(lambda (x) (set-permanent-key (car x) (cadr x)))
	   '(
	   ("ESC-N"	next-screen)
	   ("ESC-P"	prev-screen)
	   ("^F"		forward-char)
	   ("^B"		backward-char)
	   ("^P"		prev-line-command)
	   ("^N"		next-line-command)
	   ("^Y"		yank)
	   ("CR"		new-line)
	   ("ESC-F"	forward-word)
	   ("ESC-B"	backward-word)
	   ("^K"		kill-lines)
	   (""	rubout-char)
	   (""  	rubout-char)
	   ("#"		rubout-char)
	   ("^D"		delete-char)
	   ("@"		kill-to-beginning-of-line)
	   ("ESC-#"	rubout-word)
	   ("ESC-\177"	rubout-word)
	   ("ESC-"	rubout-word)
	   ("ESC-D"	delete-word)
	   ("\"		escape-char)
	   ("ESC-R"	xforum:redisplay-command)
	   ("ESC-Q"	xforum:finished)
	   ("^A"		go-to-beginning-of-line)
	   ("^E"		go-to-end-of-line)
	   ("ESC-<"	xforum:go-to-beginning-of-buffer)
	   ("ESC->"	go-to-end-of-buffer)
             ("ESC-?"         xforum:help)
	   ))

       ;; Load in help package 
       ;; This isn't necessary when e_self_documentor_ gets bound with emacs_ 
       (loadlib 'e_self_documentor_)

;;; If we are debugging, set ESC-ESC.

       (and (status feature debug)
	  (set-permanent-key "ESC-ESC" 'xforum:debugger)))

;;; Function to create empty mode line.
(defun xforum:mode-line () (list "" ""))

;;; ^L: redisplay full screen and print instructions.
(defcom xforum:redisplay-command
        &doc "Clears and then redisplays the text being worked on. The text
will be redisplayed so that the current line is centered in the window."
        (redisplay-command)
        (xforum:instructions))

;;; Turn on fill mode.
(defun xforum:turn-on-fill (n) n (fill-mode))

;;; Main function.  Do housekeeping, call correct mode function.
(defun xforum:start ()
       (xforum:setup)
       (fill-mode)
       (set-minibuffer-size 3)
       (setq xforum:mode
	   (make_atom
	     (e_lap_$rtrim
	       (e_lap_$return-string (emacs$get_info_ptr) 0 32.))))
       (or (reply-mode) (reply_by_subject-mode)
	 (destroy-buffer-contents))
       (go-to-beginning-of-buffer)
       (or (reply-mode)(talk-mode)(reply_by_subject-mode) (redisplay))
       (go-to-end-of-buffer)
       (setq xforum:silent-instructions t)
       (cond ((talk-mode) (xforum:talk))
	   ((reply-mode) (xforum:reply))
             ((reply_by_subject-mode) (xforum:reply)))
       (setq xforum:silent-instructions nil)
       (setq xforum:transaction-mark (set-mark))
       (set-minibuffer-size 2)
       (cond ((or (reply-mode) (reply_by_subject-mode))
	    (set-key "ESC-H"  'xforum:page-other-window)
	    (set-key "ESC-L"  'xforum:unpage-other-window))
	   ((talk-mode) 
	    (set-key "ESC-U"  'xforum:modify-subject)))
       
       (set-key "ESC-G"	'xforum:insert-file)
       (set-key "ESC-M"	'xforum:refill)
       (set-key "^B"	'xforum:backward-char)
       (set-key "^P"	'xforum:prev-line-command)
       (set-key "ESC-B"	'xforum:backward-word)
       (set-key "\177"	'xforum:rubout-char)
       (set-key ""        'xforum:rubout-char)
       (set-key "#"		'xforum:rubout-char)
       (set-key "ESC-#"	'xforum:rubout-word)
       (set-key "ESC-\177"	'xforum:rubout-word)
       (set-key "ESC-"	'xforum:rubout-word)
       (set-key "ESC-P"	'xforum:prev-screen)
       (set-key "ESC-<"	'xforum:go-to-beginning-of-buffer)
       (xforum:instructions))

;;; Main function for TALK mode.
(defun xforum:talk ()
       (prog nil
         (xforum:redisplay-command)
         (setq xforum:subject-text
	     (minibuffer-response "Enter Subject: "))
         again
         (cond ((samepnamep xforum:subject-text (substr " " 1 (stringlength xforum:subject-text)))
	      (ring-tty-bell)
	      (setq xforum:subject-text
		  (minibuffer-response "You must enter a Subject: "))
	      (go again)))
         (insert-string "Subject: ")
         (insert-string xforum:subject-text)
         (new-line)))

(defcom xforum:modify-subject &numeric-argument (&reject)
        &doc "Displays the current subject in the minibuffer and allows you
to edit it using normal control keys and escape sequences. When you have
finished modifying the subject , carriage return will change it in the
comment you are entering."
        (e_cline_ "xforum_help_line_$change_general_message_only ""Press  RETURN:enter new subject""")
        (let ((suppress-minibuffer nil)) suppress-minibuffer
	   (setq xforum:subject-text
	         (minibuffer-response "Enter new subject: " NL xforum:subject-text))
	   (prog nil
	         again
	         (cond ((samepnamep xforum:subject-text (substr " " 1 (stringlength xforum:subject-text)))
		      (ring-tty-bell)
		      (setq xforum:subject-text
			  (minibuffer-response "You must enter a Subject: "))
		      (go again))))
	   (save-excursion
		 (go-to-beginning-of-buffer)
		 (skip-to-whitespace)		;past Subject
		 (skip-over-whitespace)		;to subject-text
		 (without-saving
		   (kill-lines))
		 (insert-string xforum:subject-text)
		 (next-line)))
        (xforum:instructions))

;;; Main function for REPLY mode.
(defun xforum:reply ()
       (let ((this-buffer current-buffer))
	  (create-new-window-and-go-there)
	  (go-to-or-create-buffer this-buffer))
       (select-other-window)
       (find-file-subr
         (catenate (e_lap_$rtrim (get_pdir_)) ">xforum_view_seg"))
       (go-to-beginning-of-buffer)
       (new-line)				;looks nicer
       (next-line)				;past header blurb
       (skip-to-whitespace)			;past Subject:
       (skip-over-whitespace)			;to subject itself
       (if (looking-at "Re: ")
	 (skip-to-whitespace)
	 (skip-over-whitespace))		;past Re:
       (with-mark m
	        (forward-search "")
	        (rubout-char)
	        (setq xforum:subject-text (catenate "Re: "
					    (point-mark-to-string m)
					    )))
       (select-other-window)
       (go-to-beginning-of-buffer)
       (insert-string "Subject: ")
       (insert-string xforum:subject-text)
       (new-line)
       (redisplay)
       (cond ((reply_by_subject-mode)
            (select-other-window)
	  (go-to-beginning-of-buffer)
            (setq trans_string (e_lap_$rtrim (e_lap_$return-string (emacs$get_info_ptr) 32. 8.)))
            (forward-search trans_string)
            (redisplay-current-window-relative 1)
            (select-other-window))))


;;; These functions replace the normal Emacs functions to make sure
;;; that the user cannot touch the transaction subject.

;;; Replaces ^B command.
(defcom xforum:backward-char &numeric-argument (&repeat)
        &doc "Moves backwards one character in the buffer. Tabs and newline 
characters at the end of lines count as single characters.
$$$ will not allow you to stray backwards into the
comment subject"
        (or (mark-at-current-point-p xforum:transaction-mark)
	  (let ((numarg nil)) (backward-char))))

;;; Replaces ^P command.
(defcom xforum:prev-line-command &numeric-argument (&repeat)
        &doc "Move to previous line of buffer. $$$
will attempt to stay in the same horizontal position. It will not allow
you to stray back into the comment subject."
        (or (mark-on-current-line-p xforum:transaction-mark)
	  (let ((numarg nil)) (prev-line-command))))

;;; Replaces ESC-B command.
(defcom xforum:backward-word &numeric-argument (&repeat)
        &doc "Moves backwards one word in the buffer.
$$$ will not allow you to stray backwards into the
comment subject."
        (let ((numarg nil)) (backward-word))
        (or (point>markp xforum:transaction-mark)
	  (go-to-mark xforum:transaction-mark)))

;;; Replaces ESC-< command
(defcom xforum:go-to-beginning-of-buffer &numeric-argument (&reject)
        &doc "Moves back to the beginning of the comment - i.e.
to the beginning of the first line after the Subject: header.
If you are answering a prompt, the cursor will move to the first character of
your answer."
        (cond (minibufferp (go-to-beginning-of-buffer))
              (t (go-to-mark xforum:transaction-mark))))

;;; Replaces ^T command
(defcom xforum:twiddle-chars &numeric-argument (&reject)
        &doc "Twiddles (transposes, interchanges) the two characters 
immediately to the left of the cursor, unless this would involve disturbing 
the comment subject line."
       (with-mark m
	        (backward-char)
	        (cond ((point>markp xforum:transaction-mark)
		     (go-to-mark m)
		     (twiddle-chars))
		    (t
		      (go-to-mark m)))))

;;; Replaces ESC-T command
(defcom xforum:twiddle-words &numeric-argument (&reject)
        &doc "Twiddles (transposes, interchanges) the two words to the left of
the cursor. The cursor will first go to the end of a word if you are in the 
middle of it. If either word is a part of the Subject: line 
$$$ has no effect."
       (with-mark m
	        (and (charset-member (curchar) good-word-charactertbl)
		   (forward-word))
	        (do-times 2 (backward-word))
	        (forward-char)
	        (cond ((point>markp xforum:transaction-mark)
		     (go-to-mark m)
		     (twiddle-words))
		    (t
		      (go-to-mark m)))))

;;; Replaces ESC-V command.
(defcom xforum:prev-screen &numeric-argument (&repeat)
        &doc "Displays the previous screen (one back) of
this buffer, and leaves the cursor sitting either at the top of the screen
or immediately after the Subject: line, whichever is appropriate. A numeric 
argument (e.g. ESC 5 $$$) will move back that many screens."
        (cond ((mark-on-current-line-p xforum:transaction-mark))
	    ('else (prev-screen)
		 (or (point>markp xforum:transaction-mark)
		     (go-to-mark xforum:transaction-mark)))))

;;; ESC-^V
(defcom xforum:page-other-window &numeric-argument (&pass)
        &doc "Displays the next screen (one forward) of the comment
to which you are replying. A numeric  argument
(e.g. ESC 5 $$$) will move forward that many screens."
        (let ((origwindow selected-window))
	   (unwind-protect
	     (progn
	       (select-other-window)
	       (if (null numarg)(next-screen)
		 else (if (> numarg 0)(next-screen)
			else (setq numarg (- numarg))
			(prev-screen))))
	     (select-window origwindow))))

;;; -1 ESC-^V.
(defcom xforum:unpage-other-window &numeric-argument (&pass)
        &doc "Displays the previous screen (one backward) of the comment
to which you are replying. A numeric  argument
(e.g. ESC 5 $$$) will move backward that many
screens."
        (let ((numarg (- (or numarg 1))))
	   (xforum:page-other-window)))

;;; Replaces \177, # command.
(defcom xforum:rubout-char &numeric-argument (&repeat)
        &doc "Deletes the previous character - i.e. the one to the
left of the cursor. $$$ will not let you delete any of the 
Subject: line."
        (or (mark-at-current-point-p xforum:transaction-mark)
	  (let ((numarg nil))  (rubout-char))))

;;; Replaces ESC-\177, ESC-# command.
(defcom xforum:rubout-word &numeric-argument (&repeat)
        &doc "Deletes the word to the left of the cursor. More specifically
deletes characters backwards until the beginning of the word. 
$$$ will not allow you to delete back into the 
Subject: line. Successive $$$s are merged and may be
 retrieved with a single ^Y."
        (with-mark here
	         (let ((numarg nil)) (backward-word))
	         (cond ((point>markp xforum:transaction-mark)
		      (wipe-point-mark here))
		     (t
		       (go-to-mark here)
		       (wipe-point-mark xforum:transaction-mark)))))

;;; For re-filling a region.
(defcom xforum:refill &numeric-argument (&reject)
        &doc "Fills (reformats) the current paragraph, lining up left margin."
	   (save-excursion
	     (cond ((not (at-beginning-of-paragraph)) (xforum:beginning-of-paragraph)))
	     (set-the-mark)
	     (end-of-paragraph)
	     (without-saving (runoff-fill-region))))

;;; Go to beginning, but NOT INTO SUBJECT LINE!
(defcom xforum:beginning-of-paragraph &numeric-argument (&repeat)
        &doc "Moves the cursor to the beginning of the current paragraph,
or to the beginning of the previous paragraph if already at the beginning of the
current. The beginning of the first line of a paragraph is the beginning of 
the paragraph. A paragraph is deemed to be started by an indented line. 
$$$ will not move the cursor into the Subject:
line. A numeric argument (e.g. ESC 5 $$$) will
go back that many paragraphs."
       (beginning-of-paragraph)
       (or (point>markp xforum:transaction-mark)
	 (go-to-mark xforum:transaction-mark)))

;;; For inserting files into the buffer.
(defcom xforum:insert-file &numeric-argument (&reject)
        &doc "Will prompt you for the pathname of
a file which will be inserted into the current buffer at the point where the 
cursor is. The cursor will be returned to its current point after insertion."
        (save-excursion
          (minibuffer-clear-all)
	(e_cline_ "xforum_help_line_$change_general_message_only ""Enter file name followed by RETURN, just press RETURN to abort"""))
	(file-insert (xforum:get-good-file "Get comment from file: "))
	(xforum:instructions)))

;;; For giving the user help via describe-key
(defcom xforum:help &numeric-argument (&reject)
        &doc "Will prompt you for the command you want help with. Entering
a ""?"" will produce a table of all the valid commands with a very short
description."
        (cond (minibufferp (ring-tty-bell))
	    (t (let ((suppress-minibuffer nil)) suppress-minibuffer
		  (let ((key (key-prompt "Enter Command Key Sequence or ? for general help: ")))
		       (cond
		         ((not (and (= (car key) 0) (= (car (cdr key)) 77)))
			(let ((symbol (get-key-binding key))
			      (description (get-key-name key)))
			     (describe-internal description symbol "Press CTLg (control-g) when ready to continue")))
		         (t
			 (init-local-displays)
			 (local-display-generator-nnl "Press CTLg (control-g) when ready to continue")
			 (local-display-generator-nnl " ")
			 (local-display-generator-nnl "(ESCx = press escape key then press x;   BS = BACKSPACE = Ch;")
			 (local-display-generator-nnl " CTLx = hold CONTROL key down while pressing x)")
			 (cond
			   ((talk-mode)
			    (local-display-generator-nnl "CTLf: Forward Char    ESCn: Next Screen             @: Erase to Start of Line")
			    (local-display-generator-nnl "CTLb: Backward Char   ESCp: Previous Screen         CTLk: Erase to End of Line")
			    (local-display-generator-nnl "ESCf: Forward Word    ESC<: Start of Comment        CTLy: Retrieve Erased Text")
			    (local-display-generator-nnl "ESCb: Backward Word   ESC>: End of Comment          ESCg: Get File")
			    (local-display-generator-nnl "CTLa: Start of Line   CTLd: Erase Char              ESCm: Adjust Paragraph")
			    (local-display-generator-nnl "CTLe: End of Line     BS: Backward Erase Char       ESCr: Redisplay Screen")
			    (local-display-generator-nnl "CTLn: Next Line       ESCd: Erase Word              ESCq: Enter Comment")
			    (local-display-generator-nnl "CTLp: Previous Line   ESCBS: Backward Erase Word    ESCu: Change Subject")
			    (local-display-generator-nnl "                                                    ESC?: Editor Help"))
			   ((or (reply-mode) (reply_by_subject-mode))
			    (local-display-generator-nnl "CTLf: Forward Char   ESCp: Previous Screen       CTLy: Retrieve Erased Text")
			    (local-display-generator-nnl "CTLb: Backward Char  ESC<: Start of Reply        ESCg: Get File")
			    (local-display-generator-nnl "ESCf: Forward Word   ESC>: End of Reply          ESCm: Adjust Paragraph")
			    (local-display-generator-nnl "ESCb: Backward Word  CTLd: Erase Char            ESCr: Redisplay Screen")
			    (local-display-generator-nnl "CTLa: Start of Line  BS: Backward Erase Char     ESCl: Previous Page of Comment")
			    (local-display-generator-nnl "CTLe: End of Line    ESCd: Erase Word            ESCh: Next Page of Comment")
			    (local-display-generator-nnl "CTLn: Next Line      ESCBS: Backward Erase Word  ESCq: Enter Reply")
			    (local-display-generator-nnl "CTLp: Previous Line  @: Erase to Start of Line   ESC?: Editor Help")
			    (local-display-generator-nnl "ESCn: Next Screen    CTLk: Erase to End of Line")))
			 (end-local-displays))))
		  (xforum:instructions)))))

(defun display-buffer-as-printout ()
       (save-excursion
         (init-local-displays)
         (go-to-beginning-of-buffer)
         (do-forever
	 (local-display-generator (curline-as-string))
	 (if (lastlinep) (stop-doing))
	 (next-line))))

;;; Display set of instructions in the minibuffer.
(defun xforum:instructions ()
       (let ((suppress-minibuffer nil)) suppress-minibuffer
	  (cond ((or minibufferp xforum:silent-instructions))
;	        ((eq current-buffer 'change-header)
;	         (minibuffer-clear-all)
;	         (minibuffer-print
;		 "Entering or modifying the ""Subject"" text.")
;	         (minibuffer-print "Enter ESC q when done."))
	        ((talk-mode)
	         (minibuffer-clear-all)
                   (e_cline_ "xforum_help_line_$change_general_message_only ""Press  ESC?:help  BREAK:abort entry  ESCq:enter comment  ESCu:modify_subject"""))
	        ((or (reply-mode) (reply_by_subject-mode))
	         (minibuffer-clear-all)
                   (minibuffer-print " ")
	         (minibuffer-print "Press  ESC?:help  BREAK:abort entry  ESCq:enter reply in meeting"))
	        (t
		(minibuffer-clear-all)
		(minibuffer-print "enter ESC q when done."
;*ESC-G*			        "     Enter ESC g to insert a file."
			        ))
	        )))

(defun xforum:set-minibuffer-line (lineno)
       (setq rdis-mbuf-transient-linex (+ lineno (car minibufwindow))))       

;;; Finished entire transaction; write out and punt if all is OK.
(defcom xforum:finished
        &doc "Enters your comment into the meeting and returns you to the
menu."
        (emacs$set_emacs_return_code 0)
        (and minibufferp (command-quit))
        (go-to-beginning-of-buffer)
        (forward-search xforum:subject-text)
        (insert-string "")
        (go-to-mark xforum:transaction-mark)
        (cond ((search-not-charset-forward whitespace-charactertbl)
	     (save-same-file)
	     (xforum:quit-force))
	    ((xforum:yesp "There is no comment.  Quit? ")
	     (xforum:quit-handler nil))
	    (t (xforum:instructions)
	       (command-quit))))

;;; Get a filename of a file that exists and can be read.
(defun xforum:get-good-file (prompt)
       (do ((name (xforum:minibuffer-response prompt)
	        (xforum:minibuffer-response prompt)))
	 ((xforum:good-file? name) name)))

;;; Check a file for validity: can we read it?
(defun xforum:good-file? (name)
       (let ((suppress-minibuffer nil))
	  suppress-minibuffer
	  (setq name (e_lap_$trim name))
	  (cond ((nullstringp name)
	         (minibuffer-print "Aborting file read.")
	         (sleep 1)
                   (xforum:instructions)
	         (command-quit)))
	  (let ((exists? (catch (exists-file name 4) pgazonga)))
	       (cond ((null exists?)
		    (minibuffer-print "File not found.")
		    (ring-tty-bell)
		    nil)
		   ((atom exists?) nil)
		   (t t)))))

(declare (special rdis-mbuf-transient-linex minibufwindow))
(defun xforum:minibuffer-response lexpr
       (prog1 (apply 'minibuffer-response (listify lexpr))
	    (setq rdis-mbuf-transient-linex (1+ (car minibufwindow)))))

;;; These three little horrible things make sure that all XFORUM buffers
;;; are flushed so that tasking Emacs will not encounter them again.

;;; This one handles plain old ESC Q.
(defun xforum:quit-force ()
       (xforum:hidey-hole-trick)
       (quit-force))

;;; This one handles the BREAK key.
(defun xforum:quit-handler arg arg
       (cond (quit-handler-invoked)		;are we recursing?
	   ((not (zerop (xforum$reconnect_test)))
	    (xforum:redisplay-command)	;reconnect
	    (command-quit))
	   (t (cond (buffer-modified-flag	;break key
		    (setq quit-handler-invoked t)  ;prevent recursion
		    (cond ((xforum:yesp "Any pending work will be lost. Do you really want to quit?  ")
			 (xforum:hidey-hole-trick)	;yes, quit
			 (signalquit))
			(t (xforum:instructions)  ;no, not quitting
			   (setq quit-handler-invoked nil)
			   (command-quit))))
		  (t (signalquit))))))	     ;buffer not changed, quit	      

;;; This is the guy that really does the trick.
(defun xforum:hidey-hole-trick ()
       (or minibufferp
	 (go-to-or-create-buffer '|_<XFORUM_HIDEY_HOLE>_|))
       (do ((buffers known-buflist (cdr buffers)))
	 ((null buffers))
	 (or (and (eq current-buffer (car buffers))
		(not minibufferp))
	     (buffer-kill (car buffers)))))

;;; And this little piggy went to market.
(defun xforum:go-to-market ()
       (sstatus interrupt 16. 'xforum:quit-handler)
       (cond ((status feature debug)
	    (xforum:setup)
	    (minibuffer-print "Debug: (xforum:start) to start."))
	   (t (xforum:start))))

(defun xforum:yesp (prompt)
       (prog (response ret-value)
	   (minibuffer-clear-all)
	   (xforum:set-minibuffer-line 1)
	   (do-forever
	     (setq response (minibuf-response (catenate prompt "  ") NL))
	     (cond ((or (samepnamep response "yes")
		      (samepnamep response "y"))
		  (setq ret-value t)(stop-doing))
		 ((or (samepnamep response "no")
		      (samepnamep response "n"))
		  (setq ret-value nil)(stop-doing))
		 (t (force-minibuffer-print "Please answer ""yes"" or ""no"".")
		    (ring-tty-bell))))
	   (minibuffer-clear-all)
	   (return ret-value)))

;;; Debugging function.
(defcom xforum:debugger
        (minibuffer-print
	(eval
	  (read-from-string (minibuffer-response "XFORUM DBG> ")))))

;;; Patch decimal-rep, which is in e_macops_ (should be in e_basic_)
(defun decimal-rep (x)
       (let ((ibase 10.) (base 10.) (*nopoint t))
	  (maknam (exploden x))))

;;; Start the extension.
(xforum:go-to-market)




		    xforum_ent_attend_mtg_menu.pl1  08/06/87  1025.1rew 08/06/87  1013.8      485199



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


/****^  HISTORY COMMENTS:
  1) change(84-06-18,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Created by extracting the relavent internal procedures from the
     xforum module.
     
     84-08-01 Davids: Extensive changes to enter_trans code.  Code that
     resizes the windows and outputs the new header (for reply), help
     message, and "Please wait for editor" message moved to the front.
     Help messages changed to reflect MTB.  Multiple returns replaced
     by a goto exit...  statement.
     
     84-08-02 Davids: Replaced references to transaction in enter_trans
     code with references to comment.  Made the coment entered
     confirmation message conform with the MTB.
     
     84-08-07 Davids: replaced a reference to nt_fidx in the parameter
     list of next_ref with a reference to nr_fidx.  This was screwing
     up the call which set the flag indicating that the transaction had
     been seen.  The error was not being reported because the code was
     not being checked!  The structure of the code in both next_ref and
     next_trans has been changed so that the error code returned from
     setting the flag is checked.
  2) change(84-08-16,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     updated the call to xforum_help_$display for the case where the
     user responds to the comment specification prompt with a ?  to
     reflect the new info file name and section.  Also removed code
     which is no longer returned, xforum_fatal_error is signaled.
     Added the entry points copy_comments, next_unread_trans, and
     meeting_maintenance.  These new entries just issue a "have not be
     implemented yet" message.  The code dealing with the now unused
     entry points (attending meeting doesn't do things like next ref)
     was not removed because itwill be needed again when the second
     attending menu is built.
     
     84-09-26 Davids: Added the update_status procedure and removed
     code from the individual entries that the seen switches and
     last_seen value.  Added to the prev_trans, prev_ref, and first_ref
     entries the parameters for meeting version and forum meeting
     index.  These are necessary because this routine now updates the
     seen switches for each transaction.
     
     84-09-27 Davids: Added the copy_comments code.
  3) change(84-09-28,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Removed all references to a usage message and calls to
     xforum_status_$update_usage, push_usage, pop_usage.  Replaced them
     with the corresponding xforum_help_line entries.
     
     84-10-01 Davids: Removed a lingering reference to
     xforum_status_$push_help_line.  Also added a code check after the
     call to xforum_trans_$read for the reply mode of enter_trans.  If
     the user trys to reply without reading the comment first, its
     possible that the comment has been deleted and a bad pointer
     reference will result in the ioa_$rsnnl call.
     
     84-10-03 Davids: Added code in the update_status procedure to
     update the seen_map.  Also changed the new label to Unread.
     
     84-10-04 Davids: Added the code that actually implements the
     next_unread_trans entry point.  Modified the enter_trans code so
     that it also sets the seen_map bits.
     
     84-10-11 Davids: Replaced references to transactions in the
     listing header, the current comment header, and a message with
     references to comments.  Added code to copy_comments so that a
     null file name will be identified and an error message output.
  4) change(84-10-16,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed the help line when entering a new discussion to reflect
     that E?  is not available and to indicate that the RETURN key will
     enter the subject.
     
     84-10-18 Davids: Changed status messages for copy comments which
     said "Comments being written to X" and "N comments written to X"
     so that written is now copied.
     
     84-10-26 Davids: In select_trans_spec modified help line to
     indicate tha a BREAK will leave the current comments unchanged.
     Also so a responding to the prompt with just a return will leave
     the current comments unchanged.  Also changed the spy stuff so
     that the actual transaction number or transaction range is not
     recorded but just the key word range or number.
     
     84-10-29 Davids: In the enter_trans entry increased the length of
     the et_str and et_sj variables from 110 & 100 to 510 and 500.
     This was needed so that subjects longer than 100 characters don't
     get truncated.  et_str is 10 characters longer since it also
     contains the "Subject: " string.
  5) change(84-11-06,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed references to xforum_help_line to xforum_help_line_.
     
     84-11-15 Davids: Auditing changes: 1) Corrected all output
     messages to start with an upper case letter and end with some form
     of puncuation.  2) Replaced the "/" operator with the divide
     builtin.  Other changes: 1) Corrected error messages to say
     comment instead of transaction.  2) Replaced calls to
     hcs_$make_seg with calls to initiate_file_$create.
     
     84-11-19 Davids: Added quit handler to enter_trans entry point.
     This closes the window between the time the proc is entered and
     the time that the emacs quit handler is established.  If this
     window is open the screen gets all screwed up.
     
     84-12-12 Davids: Added a call to clear the bottom window before
     the call outputing the "Please wait for editor" message.  Added
     code to next_transaction, previous_transaction, next_reference,
     and previous_reference so that they check the error code returned
     from xforum_trans_ and if its forum_error_table_$invalid_trans_idx
     they print out an appropriate message instead of using the forum
     message which uses the term transaction.  It will also clear the
     bottom window before outputing the message.  Also added a call to
     clear the bottom window before the message "There are no more
     unread comments" in next_unread_transaction.
  6) change(85-01-16,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed QUERY_USAGE the help line text output for a query to have
     the same format as the rest of the help lines.
     
     85-01-21 Davids: Modified so that the help line output in the
     enter_transaction procedure uses "ESC" for the escape key instead
     of "E".  Also so that the remove_menu_while_editing state is
     checked if the user is entering a new transaction and the menu
     removed if the state is true.
     
     85-01-22 Davids: Modified so that the et_trans_seg structure
     contains space for an escape character appended onto the subject
     before the new-line.  Also modified so that the character looked
     for to determine the end of the subject is the escape character
     and not the new-line.  This allows subjects with embedded
     new-lines to be handled correctly.
     
     85-01-24 Davids: Added support for the listing and displaying of a
     set of comments (the xforum_meeting_info.flags.set switch).
  7) change(85-01-25,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed BREAK in QUERY_USAGE to be more meaningful and added
     QUERY_USAGE_COPY for the copy option.
     
     85-01-28 Davids: Added support for copying a set of comments.
     Forgot that on 85-01-24.
     
     85-01-30 Davids: Modified the display_trans, list_trans, and
     copy_comments entry points so that they use the new
     xforum_get_selected_trans module.  This way there is only 1 module
     that needs to understand how to get the list of selected
     transactions based on the flags in xforum_meeting_info.  It also
     simplifies the code.  Also modified the call to
     xforum_validate_trans_spec_ to include the xforum_meeting_info_ptr
     and spy_ptr.
     
     85-02-12 Davids: Moved the attend_meetings, attend_a_meeting,
     reinstate_mtg_status, and close_meeting procedures from
     xforum_main_options.  attend_meetings became the code for the main
     entry.  Did not try to clean the code up.  Made all the existing
     entries internal procedures.  Deleted the next_ref, pref_ref, and
     first_ref entry points.
  8) change(85-02-13,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed calling sequence of xforum_help_line_$change to include
     the new F3_message argument.
     
     85-02-14 Davids: After the call to xforum_help_$get_help added
     code to resize the menu window and redisplay the menu.  This will
     be needed if the help resulted in the general help topics menu
     being displayed.  It wont hurt anything if that was not the case.
     
     85-02-22 Davids: Modified copy_comments to use the new
     xforum_attend_mtg_utilities$copy_to_name entry point.
     
     85-02-25 Davids: Modified next_unread_trans tro use the new
     xforum_attend_mtg_utilities$next_unread_comment entry point.  Also
     modified it to record the set of the flags and the current comment
     number and to reset the flags and current number if no unread
     transaction is found.
     
     85-02-28 Davids: Extracted the internal proc update_status and
     placed it in the xforum_attend_mtg_utilities module.
  9) change(85-03-01,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Removed the internal proc reinstate_status and replace the calls
     to it with calls to xforum_attend_mtg_utilities$update_status.
     Did the same for close_meeting.
     
     85-03-04 Davids: Added code to reset the title line and redisplay
     the status information at the same time that the menu is reset if
     the current menu pointer has been changed.  This was needed
     because during the removeal of reinstate_status the call that was
     made every time though the "handle menu choice" loop was removed
     as not being needed.  It turns out that it is needed if the
     current menu pointer has been changed.  Also changed the call to
     xforum_format_$append so that it include the new flag, since
     append is never called to build a segment for emacs the flag is
     always 0.
     
     85-03-06 Davids: Replaced the internal procedure enter_trans with
     a call to to xforum_attend_mtg_utilities$enter_trans.
     
     85-03-19 Davids: Fixed the next_unread_trans procedure so that if
     no unread trans is found it will still update the status
     information.  This is needed so that deleted and expunged
     transactions found during the search for a new trans are removed
     from unread count displayed in the status line.  Also fixed a
     problem with referencing the last seen transaction when the user
     has just entered a meeting.  The user's current transaction is set
     to his last seen transaction.  If the last seen transaction was
     deleted the user's current transaction will be invalid.  Now if
     the last seen transaction cannot be read the current transaction
     is set to the first transaction (first undeleted/unreaped).  If an
     attempt to read the first transaction fails an error is reported
     and the procedured is exited.
 10) change(85-03-25,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added code to options 7 and 8 so that enter_trans is only called
     if the read_only flag for the meeting is off.  If its on an error
     message is output.  This saves the user from having to enter a
     comment only to find out that he cannot do anything with it.
     
     85-03-27 Davids: Replaced code in attend_a_meeting that now is in
     the set_up_meeting entry of xforum_attend_mtg_utilities with a
     call to that entry.  Also modified the code handling the help
     function to reset the title line of the status window and
     redisplay the status and help line windows.  This is needed if the
     user had the general topics menu display.
     
     85-04-11 Davids: Modified list_trans to calculate the maximum
     length of the users's default date and time strings and to output
     a list header line based on those lengths.  Also to construct a
     ioa_ control string to output the listing of a comment based on
     those lengths.  In addition it calcuates the maximum number of
     characters that can be output on the subject.  It passes the ioa_
     control string and the max subject length to xforum_format_$list
     along with a pointer to the forum transaction.  Note that the
     user's date and time formats must allow at least 7 characters of
     the subject to be printed or an error will be output.
 11) change(85-04-17,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Modified next_unread_trans so that it does not zero out the
     current comment and flags before calling next_unread_comment.
     This allows next_unread_comment to restore the current comment(s)
     incase of a quit.
     
     85-05-06 Davids: Added a test of aam_fidx after the call to
     set_up_meeting in attend_a_meeting.  If aam_fidx is 0 the meeting
     was not opened so a return is done.  Any error message was output
     by set_up_meeting.
     
     85-06-03 Davids: Commented all declarations, deleted unused
     declarations and moved some declarations from the main entry point
     to the procedure that actually used them.  Also replaced the
     output parameter from the call to xforum_multics_mode with an
     "unused" variable and use the static menu height variable in the
     following call to resynch the menu window size instead of the
     output from multics mode.  This was done so as not to need two
     variables that hold the menu window height.
     
     85-06-04 Davids: Removed references to the include files:
     access_mode_values, forum_dcls, and forum_flags.  Since they were
     not being referenced.
 12) change(85-06-05,Davids), approve(86-02-04,MCR7250),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     In the select_trans_spec procedure, moved the call to
     xforum_help_line_$push so that it occurs before the ioa call which
     outputs the prompt.  It was after the prompt which caused it to be
     executed after every invalid entry in which case the prompt was
     reissued.  This would cause the help_line stack to fill up.
     
     85-06-20 Davids: Changed calling sequence of xforum_format_$append
     so that the bit_count parameter which is input/output comes after
     all the input parameters (i.e.  the bit (1) switch).
 13) change(86-02-18,LJAdams), approve(86-02-18,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Setting xforum_meeting_info.current to 0 prior to closing meeting.
 14) change(87-04-13,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Changed to allow command_processor_ escapes.  Declared screen options
     as constants to eliminate use of magic numbers.
                                                   END HISTORY COMMENTS */

xforum_ent_attend_mtg_menu: proc (xam_midx, xam_match_bits, xam_spy_ptr);

/*
   BEGIN DESCRIPTION

   function:
      This module creates, displays and destroys the entry oriented attend
      meeting menu. It also processes the user choices from that menu.


   description of entry points:
      xforum_ent_attend_mtg_menu:
         input:   fixed bin           index in the xforum meeting list of meeting to be attended
                  bit (36) aligned    identifies the class of meeting to be attended
                  ptr                 pointer to spy structure
         This entry is a simple loop that calls the internal procedure
         attend_a_meeting and then gets the next meeting index and calls
         attend_a_meeting again. The loop is broken when the user exits a
         meeting and indicates that he does not want to go to another meeting
         (attend_a_meeting returns xam_more as false) or attend_a_meeting is
         given an invalid meeting index (which will happen if there is no next
         meeting, xam_more is again returned as false).

   description of internal procedures:
      attend_a_meeting: This procedure is used to attend a meeting. It first
      checks to be sure that the input meeting index is valid, if not it
      returns (the more flag is false). If it is a valid index it sets up
      condition handlers, calls xforum_attend_mtg_utilities$set_up_meeting
      to initialize the xforum_meeting_info structure and have forum open the
      meeting, creates the text for option 9 of the menu and creates the menu
      and finally enters a loop where the menu is displayed and the menu choice
      is used to call either internal procedures or xforum_attend_mtg_utilities
      entry points. The menu choices are recorded in the spy structure.,
      The quit condition handler is set up to clear the bottom window, reset
      the help line, redisplay the menu and go back to the menu display/input
      loop. The cleanup condition handler is set up to close the meeting and
      free the storage for the menu structure (done via the utilities call).
      a xforum_redisplay_menu condition handler is set up to redisplay the
      menu. It is setup after the menu is created so that it has something to
      display. The more flag is used to identify that the user does or does not
      want to exit the current meeting and attend another meeting. It is set to
      true when the user selects the next meeting option (option 9)

      display_trans: This procedure is used to display transaction. The bottom
      window is first cleared. A loop is entered which calls
      xforum_get_selected_trans to get a pointer to a selected transaction,
      the transaction number is used to update the status window and the
      transaction displayed via xforum_format_. The loop continues until
      a invalid_trans_idx error code is returned. Other error codes are
      ignored. The loop is initialized via a call to xforum_get_selected_trans.
      Xforum_get_selected_trans handles all the details of determining what
      transactions have been selected and how to get them in sequential order.

      next_trans: This procedure selects the next transaction as the current
      transaction and displays the transaction via a call to xforum_format_.
      The next transaction is found via a call to xforum_trans_. A subject
      chain will not be followed. The current transaction must be either a
      single transaction or a range of transaction, i.e. I:J for there to be
      a next transaction. xforum_trans_$next will skip deleted comments. If
      there is no next comment (user is at last comment in meeting) a non-zero
      error code is returned from xforum_trans_$next and this procedure will
      output the error message to the user. Note that xforum_trans_$next will
      not change the current comment setting in the event of an error.

      list_transaction: This procedure will cause a 1 line description to be
      output to the user_io window for all the current comments. The
      description contains the date and time the comment was entered. The
      display of the date and time uses the user's date format and the time
      format. The positions of the elements of the description are calculated
      based on the maximum length that the date and time fields could be. It
      requires that there be at least 7 characters left for the subject or an
      error message will be output. This assumes an 80 character window. A
      header line ioa_ control string is created and output. A control string
      for outputing each of the comment descriptions is also created and passed
      to xforum_format$list which actually outputs the description line.

      select_trans_spec: This procedure prompts the user for a transaction
      spec. Once the spec has been input a call is made to
      xforum_validate_trans_spec to check the spec and update the current
      comment in the xforum_meeting_info structure. The prompting is done via
      ioa_ instead of via command_query. Help processing is handling by
      actually checking to see if the input was a "?" character an calling
      xforum_help_$display if it was. The input spec must be less than 132
      characters. Spy data is collected but any range is just recored as RANGE
      and any single number is just recored as NUMBER. If the input spec is not
      valid the prompt is reissued. xforum_validate_trans_spec_ will have
      already output an error message. Note that if the user just presses the
      RETURN key the response in recorded as RETURN and the procedure exits. A
      quit handler is used to clear the prompt and any error messages and reset
      the help line.

      copy_comments: This procedure calls xforum_attend_mtg_utilities$copy_to_name
      to obtain the name of the file to copy the comments into. copy_to_name
      checks for help requests and invalid names. It returns the entry name
      of the segment, a pointer to the segment and the segments current bit
      count. A null pointer indicates that the copy should be aborted.
      A message is then output saying that the writting is taking place. The
      help line is updated to indicate a break will abort the copy process.
      The second part of this procedure looks exactly like the display
      procedure. The only difference is xforum_format_$append is called instead
      of $display and that the number of comments actually processed is
      counted. The last thing that this procedure does is clear the bottom
      window and output a message saying how many transactions were output
      and giving the file name. A quit handler is used to reset the help line
      and force the an exit to the loop doing the copying.

      next_unread_trans: This procedure calls xforum_attend_utilities$next_unread_comment
      to update the current comment in the xforum_meeting_info structure to the
      next unread comment. It then calls xforum_attend_utilities$update_status
      to update the status window to indicate the new current comment and 
      xforum_format_$display to display the new current comment below the 
      meeting menu. If there are no unread comments a message to that effect
      is output to the user and the current comment and flags fields which
      were modified by the call to next_unread_comment are restored to their
      original values.

      meeting_maintenance: This procedure will be used to generate the meeting
      maintenance menu and respond to selections made from that menu. Currently
      it just outputs a message saying that it is unimplemented.

      collect_spy_data: Similar to all the other collect_spy_data procedures.
      See the xforum module. Note that this procedure is duplicated so as to
      save the expense of an external call for a commonly executed, very short
      program, whose output is used only during development or special site
      exposure.

   known bugs:

   notes:
      84-09-26 Davids: The code in update_status which creates the status
      window text was copied from xforum_main_options. It should be made into a
      separate procedure, or better yet incorporated into the appropriate
      xforum_status_ entries.

      85-02-12 Davids: The menu should be created in the main entry not in the
      attend_a_meetings procedure. reinstate_mtg_status and update_status
      should be combined. close_meeting should be taken out of attend_a_meeting
      and made an internal procedure at the same level as attend_a_meeting.
   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     xam_midx		 fixed bin;	/* (input) index in the xforum meeting list */
						/*         of meeting to be attended */
	dcl     xam_match_bits	 bit (36) aligned;	/* (input) identifies the class of meeting to be attended */
	dcl     xam_spy_ptr		 ptr;		/* (input) pointer to spy structure */

/* EXTERNAL STATIC */

	dcl     forum_error_table_$invalid_trans_idx fixed bin (35) ext static;

/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     date_time_$format_max_length entry (char (*), char (*), char (*)) returns (fixed bin);
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     window_$bell	 entry (ptr, fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_attend_mtg_utilities$close_meeting entry (ptr, ptr, fixed bin, fixed bin, ptr);
	dcl     xforum_attend_mtg_utilities$copy_to_name entry (ptr, char (32), ptr, fixed bin (24));
	dcl     xforum_attend_mtg_utilities$enter_trans entry (ptr, fixed bin, ptr, bit (1) aligned, bit (1) aligned);
	dcl     xforum_attend_mtg_utilities$next_unread_comment entry (ptr, fixed bin, fixed bin, ptr);
	dcl     xforum_attend_mtg_utilities$set_up_meeting entry (ptr, ptr, fixed bin, bit (1) aligned, fixed bin, char (256), char (256));
	dcl     xforum_attend_mtg_utilities$update_status entry (ptr, fixed bin, char (*), fixed bin, fixed bin);
	dcl     xforum_create_menu_	 entry ((*) char (*) var, ptr, ptr, fixed bin (35));
	dcl     xforum_format_$append	 entry (ptr, ptr, bit (1) aligned, fixed bin (24), fixed bin (35));
	dcl     xforum_format_$display entry (ptr, bit (1) aligned, fixed bin (35));
	dcl     xforum_format_$list	 entry (ptr, char (*), fixed bin, fixed bin (35));
	dcl     xforum_get_selected_trans$first entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_selected_trans$next entry (ptr, ptr, fixed bin (35));
          dcl     xforum_get_str_ entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
	dcl     xforum_help_$get_help	 entry (ptr, char (*), (*) char (*) var, ptr, ptr);
	dcl     xforum_help_line_$change entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_help_line_$push entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_main_options$index_of_next_meeting entry (bit (36) aligned, ptr) returns (fixed bin);
	dcl     xforum_multics_mode	 entry (fixed bin);
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_status_$update_title entry (char (*));
	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     xforum_trans_$next_trans entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_user_profile$get_multics_mode entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$menu_display entry (ptr);
	dcl     xforum_window_mgr$menu_get_choice entry (ptr, bit (1) aligned, fixed bin);
	dcl     xforum_window_mgr$resynch_windows entry (fixed bin, bit (1));
	dcl     xforum_validate_trans_spec_ entry (ptr, ptr, char (*), fixed bin (35));

/* CONDITIONS */

	dcl     cleanup		 condition;
	dcl     exit_executive_forum	 condition;
	dcl     quit		 condition;
	dcl     xforum_redisplay_menu	 condition;

/* INTERNAL AUTOMATIC */

	dcl     xam_next_mtg_index	 fixed bin;	/* xforum_meeting_list index of the next meeting to attend */
	dcl     xam_more		 bit (1) aligned;	/* "1"b implies that the user wants to attend another meeting */

/* INTERNAL STATIC */


/* CONSTANTS */

	dcl
	        (
	        xam_FIRST		 bit (1) aligned init ("1"b), /* flag to indicate first comment being displayed */
	        xam_ME		 char (25) init ("xforum_attend_mtg_options") /* string identifing this module */
	        )			 internal static options (constant);

          dcl     MAX_LEN                fixed bin init (256) internal static options (constant);
		        

          dcl     (                      /* entry screen choices */
                  DISPLAY_COMMENT        fixed bin init (1),
	        COPY_COMMENT	 fixed bin init (2),
	        LIST_COMMENT	 fixed bin init (3),
	        GET_COMMENT		 fixed bin init (4),
	        NEXT_COMMENT	 fixed bin init (5),
	        NEXT_UNREAD_COMMENT	 fixed bin init (6),
	        REPLY		 fixed bin init (7),
	        TALK		 fixed bin init (8),
	        NEXT_MTG		 fixed bin init (9),
	        MTG_MAINTENANCE	 fixed bin init (10)
                  )                      internal static options (constant);
		        

          dcl     (                      /* mtg type */
                  GET_ATTENDED           fixed bin init (3),
	        GET_CHANGED		 fixed bin init (2),
	        GET_ELIGIBLE           fixed bin init (1)
                  )			 internal static options (constant);
		        

/* BUILTINS */

	dcl     addr		 builtin;
          dcl     char                   builtin;
	dcl     index		 builtin;
	dcl     length		 builtin;
	dcl     ltrim		 builtin;
	dcl     null		 builtin;
	dcl     rtrim		 builtin;
	dcl     string		 builtin;
	dcl     substr		 builtin;
	dcl     unspec		 builtin;
	dcl     verify		 builtin;

/* BASED */

/* INCLUDE FILES */

%include forum_user_trans;
%page;
%include menu_dcls;
%page;
%include xforum_error_info;
%page;
%include xforum_meeting_info;
%page;
%include xforum_meeting_list;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;
%page;
%include xforum_windows;
%page;
%include xforum_answers;



%include xforum_prompts;


%include xforum_help_infos;


	call attend_a_meeting (xam_midx, xam_match_bits, xam_spy_ptr, xam_more);
	do while (xam_more);
	     xam_next_mtg_index = xforum_main_options$index_of_next_meeting (xam_match_bits, xam_spy_ptr);
	     call attend_a_meeting (xam_next_mtg_index, xam_match_bits, xam_spy_ptr, xam_more);
	end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call window_$clear_window (xforum_windows.menu.iocb, (0));

	return;

attend_a_meeting: proc (aam_midx, aam_match_bits, aam_spy_ptr, aam_more);

/* PARAMETERS */

	dcl     aam_midx		 fixed bin;	/* (input) index in the xforum meeting list of */
						/*         meeting to be attended */
	dcl     aam_match_bits	 bit (36) aligned;	/* (input) identifies the class of meeting being attended */
	dcl     aam_spy_ptr		 ptr;		/* (input) pointer to spy structure */
	dcl     aam_more		 bit (1) aligned;	/* (output) "1" implies user wants to go to another meeting */
						/*          "0" implies user wants to return to main menu */

/* INTERNAL AUTOMATIC */

	dcl     aam_chairman_msg	 char (256);	/* chairman message for the meeting */
	dcl     aam_choice		 fixed bin;	/* user's choice from meeting menu */
	dcl     aam_code		 fixed bin (35);	/* standard error code */
	dcl     aam_current_menu_ptr	 ptr;		/* pointer to menu structure for menu currently displayed */
	dcl     aam_fkey		 bit (1) aligned;	/* "1"b implies user's choice is a function key */
	dcl     aam_fidx		 fixed bin;	/* index identifing meeting to forum */
	dcl     aam_headers		 (1) char (44) varying; /*space for first line of status window */
	dcl     aam_mtg_menu_ptr	 ptr;		/* pointer to the menu structure for the meeting menu */
	dcl     aam_multics_mode	 bit (1);		/* "1"b implies that the user can invoke multics mode */
	dcl     aam_type		 fixed bin;	/* type of current meeting, changed, participating, or eligible */
	dcl     aam_unused		 char (256);	/* unused output from subroutine call */
	dcl     aam_unused_fb	 fixed bin;	/* unused output from subroutine call */

	dcl     01 aam_mtg_requirements like menu_requirements;
						/* structure describing the requirments of the meeting menu */

/* INTERNAL STATIC */

	dcl     aam_choices		 (10) char (40) varying
				 init (
				 "Display Current Comment(s)",
				 "Copy Current Comment(s)",
				 "Select/List Any Comment(s)",
				 "Select/Display Any Comment(s)",
				 "Select/Display Next Comment",
				 "Select/Display Next Unread Comment",
				 "Reply To Current Comment",
				 "Start New Discussion",
				 "",
				 "Meeting Maintenance");
						/* options for meeting menu, option 9 will be filled in */
						/* when type of meeting is determined */

/* CONSTANTS */

	dcl     (
	        aam_ATTENDED	 bit (36) aligned init ("000100000000000000000000000000000000"b), /* meeting type */
	        aam_CHANGED		 bit (36) aligned init ("000000010000000000000000000000000000"b), /* meeting type */
	        aam_ELIGIBLE	 bit (36) aligned init ("111111110000000000000000000000000000"b), /* meeting type */
	        aam_FIRST_MENU	 fixed bin init (2),/* function keys for goto first menu */
	        aam_FIRST_MENU2	 fixed bin init (9),
	        aam_HELP		 fixed bin init (1),/* function key for help */
	        aam_MEETING_TYPE	 (3) char (9) varying init ("Eligible ", "Changed ", "Attended "),
						/* strings describing the type of meeting for */
						/* option 9 of the menu */
	        aam_MTG_MENU_HEIGHT	 fixed bin init (6),/* height of the meeting menu */
	        aam_MULTICS		 fixed bin init (8),/* function keys for multics mode */
	        aam_MULTICS2	 fixed bin init (15),
	        aam_PREV_MENU	 fixed bin init (3),/* function keys for previous menu */
	        aam_PREV_MENU2	 fixed bin init (10),
	        aam_QUIT		 fixed bin init (4),/* function keys for quiting xforum */
	        aam_QUIT2		 fixed bin init (11),
	        aam_READ_ONLY_MESSAGE	 char (150) init (
				 "You are not allowed to enter comments in this meeting." ||
				 "^/Send mail to ^a for an explanation and/or a change in status."),
						/* error message for trying to write to a meeting */
						/* without write access */
	        aam_REDISPLAY	 fixed bin init (5),/* function keys for redisplaying the screen */
	        aam_REDISPLAY2	 fixed bin init (12),
	        aam_REPLY		 bit (1) aligned init ("1"b), /* flag indicating reply mode */
	        aam_TALK		 bit (1) aligned init ("0"b) /* flag indicating talk mode */
	        )			 internal static options (constant);

	aam_more = "0"b;
	aam_mtg_menu_ptr = null ();

	if aam_midx < 1 | aam_midx > no_selected
	then return;

	spy_ptr = aam_spy_ptr;

	aam_multics_mode = xforum_user_profile$get_multics_mode ();

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$bell (xforum_windows.menu.iocb, (0));
		xforum_meeting_info.current = 0;
		call xforum_help_line_$change ("10110000"b, "Leave Meeting", "", "");
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_7, "QUIT");
		goto meeting_get_choice;
	     end;

	on cleanup
	     begin;
		if aam_fidx ^= -1
		then do;
		     xforum_meeting_info.current = 0;
		     call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
			xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);
		 end;
	     end;

	call xforum_attend_mtg_utilities$set_up_meeting (xforum_meeting_list_ptr, xforum_meeting_info_ptr, aam_midx, "0"b,
	     aam_fidx, aam_unused, aam_chairman_msg);
	if aam_fidx = 0
	then return;


	if aam_match_bits = aam_ELIGIBLE then
	     aam_type = GET_ELIGIBLE;
	else if aam_match_bits = aam_CHANGED then
	     aam_type = GET_CHANGED;
	else if aam_match_bits = aam_ATTENDED then
	     aam_type = GET_ATTENDED;

	aam_headers (1) = "Attending " || rtrim (xforum_meeting_info.name) || " meeting";
	call xforum_status_$update_title ((aam_headers (1)));

	aam_choices (9) = "Go To Next " || aam_MEETING_TYPE (aam_type) || "Meeting";

	call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr, 0, "", 0, aam_fidx);
	call xforum_window_mgr$resynch_windows (aam_MTG_MENU_HEIGHT, "1"b);

	aam_mtg_requirements.version = menu_requirements_version_1;

	call xforum_create_menu_ (aam_choices, addr (aam_mtg_requirements), aam_mtg_menu_ptr, aam_code);
	if aam_code ^= 0 then do;
	     call com_err_$suppress_name (aam_code, xam_ME, "Trying to create meeting menu.");
	     goto exit_attend_a_meeting;
	end;

	call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);

	on xforum_redisplay_menu
	     call xforum_window_mgr$menu_display (aam_mtg_menu_ptr); /* for redisplay function	      */

	if rtrim (aam_chairman_msg) ^= ""
	then call ioa_ ("^a", aam_chairman_msg);

	aam_current_menu_ptr = aam_mtg_menu_ptr;

/* get choice					*/

meeting_get_choice:
	do while ("1"b);
	     call xforum_window_mgr$menu_get_choice (aam_mtg_menu_ptr, aam_fkey, aam_choice);

	     if aam_fkey
	     then call collect_spy_data (SPY_AT_7, "F" || rtrim (ltrim (char (aam_choice))));
	     else call collect_spy_data (SPY_AT_7, rtrim (ltrim (char (aam_choice))));

	     if aam_fkey then
		if aam_choice = aam_HELP
		then do;
		     call xforum_help_$get_help (aam_mtg_menu_ptr, "Meeting", aam_choices,
			spy_ptr, xforum_system_area_ptr);
		     call xforum_status_$update_title ((aam_headers (1)));
		     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr, 0, "", 0, aam_fidx);
		     call xforum_status_$redisplay ((0));
		     call xforum_window_mgr$resynch_windows (aam_MTG_MENU_HEIGHT, "0"b);
		     call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);
		end;
		else if aam_choice = aam_FIRST_MENU | aam_choice = aam_FIRST_MENU2
		then goto exit_attend_a_meeting;
		else if aam_choice = aam_PREV_MENU | aam_choice = aam_PREV_MENU2
		then goto exit_attend_a_meeting;
		else if aam_choice = aam_QUIT | aam_choice = aam_QUIT2
		then do;
		     xforum_meeting_info.current = 0;
		     call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
			xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);
		     signal exit_executive_forum;
		end;
		else if aam_choice = aam_REDISPLAY | aam_choice = aam_REDISPLAY2
		then call xforum_redisplay_;
		else if (aam_choice = aam_MULTICS | aam_choice = aam_MULTICS2) & aam_multics_mode
		then do;
		     call xforum_multics_mode (aam_unused_fb);
		     call xforum_window_mgr$resynch_windows (aam_MTG_MENU_HEIGHT, "0"b);
		     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr, 0, "", 0, aam_fidx);
		     call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);
		     goto meeting_get_choice;
		end;
		else call window_$bell (xforum_windows.menu.iocb, (0));
	     else do;
		if aam_choice = DISPLAY_COMMENT
		then call display_trans (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = COPY_COMMENT
		then call copy_comments (spy_ptr, aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = LIST_COMMENT
		then do;
		     call select_trans_spec (spy_ptr);
		     call list_trans (aam_fidx);
		end;
		else
		     if aam_choice = GET_COMMENT
		then do;
		     call select_trans_spec (spy_ptr);
		     call display_trans (aam_fidx, forums (aam_midx).forum_version);
		end;
		else
		     if aam_choice = NEXT_COMMENT
		then call next_trans (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = NEXT_UNREAD_COMMENT
		then call next_unread_trans (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = REPLY
		then do;
		     if ^forums (aam_midx).flags.read_only
		     then do;
			call xforum_attend_mtg_utilities$enter_trans (xforum_meeting_info_ptr,
			     aam_fidx, spy_ptr, aam_REPLY, "0"b);
			aam_current_menu_ptr = null ();
		     end;
		     else do;
			call window_$clear_window (xforum_windows.bottom.iocb, (0));
			call ioa_ (aam_READ_ONLY_MESSAGE, forums (aam_midx).chairman);
		     end;
		end;
		else
		     if aam_choice = TALK
		then do;
		     if ^forums (aam_midx).flags.read_only
		     then do;
			call xforum_attend_mtg_utilities$enter_trans (xforum_meeting_info_ptr,
			     aam_fidx, spy_ptr, aam_TALK, "0"b);
			aam_current_menu_ptr = null ();
		     end;
		     else do;
			call window_$clear_window (xforum_windows.bottom.iocb, (0));
			call ioa_ (aam_READ_ONLY_MESSAGE, forums (aam_midx).chairman);
		     end;
		end;
		else
		     if aam_choice = NEXT_MTG
		then do;
		     xforum_meeting_info.current = 0;
		     call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
			xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);
		     aam_more = "1"b;
		     return;
		end;
		else
		     if aam_choice = MTG_MAINTENANCE
		then call meeting_maintenance;
	     end;

	     call iox_$control (xforum_windows.bottom.iocb, "reset_more",
		null, (0));			/* get back in step		      */

	     if aam_current_menu_ptr ^= aam_mtg_menu_ptr
	     then do;
		call xforum_window_mgr$resynch_windows (aam_MTG_MENU_HEIGHT, "1"b);
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call xforum_status_$update_title ((aam_headers (1)));
		call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr, 0, "", 0, aam_fidx);
		call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);
		aam_current_menu_ptr = aam_mtg_menu_ptr;
	     end;
	end;

exit_attend_a_meeting:
          xforum_meeting_info.current = 0;
	call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
	     xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);

     end attend_a_meeting;

display_trans: proc (dt_fidx, dt_version);

/* PARAMETERS */

	dcl     dt_fidx		 fixed bin;	/* (input) index identifing meeting to forum */
	dcl     dt_version		 fixed bin;	/* (input) version of the forum meeting */

/* INTERNAL AUTOMATIC */

	dcl     dt_code		 fixed bin (35);	/* standard error code */
	dcl     dt_is_first		 bit (1) aligned;	/* used to flag the first comment being displayed */
	dcl     dt_trans_no		 fixed bin;	/* forum index of comment about to be displayed */





	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	dt_code = 0;
	dt_is_first = "1"b;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, dt_code);
	do while (dt_code ^= forum_error_table_$invalid_trans_idx);
	     if dt_code = 0
	     then do;
		dt_trans_no = forum_user_trans.trans_no;
		call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
		     dt_trans_no, "", dt_version, dt_fidx);
		call xforum_format_$display (forum_user_trans_ptr, dt_is_first, dt_code);
		dt_is_first = "0"b;
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, dt_code);
	end;

	return;

     end display_trans;

next_trans: proc (nt_fidx, nt_version);

/* PARAMETERS */

	dcl     nt_fidx		 fixed bin;	/* (input) index identifing meeting to forum */
	dcl     nt_version		 fixed bin;	/* (input) version of the forum meeting */

/* INTERNAL AUTOMATIC */

	dcl     nt_code		 fixed bin (35);	/* standard error code */





	if xforum_meeting_info.current = 0 then
	     if ^xforum_meeting_info.range then do;
						/* range is ok  */
		call com_err_$suppress_name (0, "",
		     """Next"" incompatible with current comment specifier.");
		return;
	     end;

	if xforum_meeting_info.range
	then call xforum_trans_$next_trans (xforum_meeting_info.high, forum_user_trans_ptr, nt_code);
	else call xforum_trans_$next_trans (xforum_meeting_info.current, forum_user_trans_ptr, nt_code);
	if nt_code ^= 0
	then do;
	     call window_$clear_window (xforum_windows.bottom.iocb, (0));
	     if nt_code = forum_error_table_$invalid_trans_idx
	     then call com_err_$suppress_name (0, xam_ME, "There is no next comment.");
	     else call com_err_$suppress_name (nt_code, xam_ME);
	end;
	else do;
	     xforum_meeting_info.current = forum_user_trans.trans_no;
	     xforum_meeting_info.range = "0"b;
	     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
		forum_user_trans.trans_no, "", nt_version, nt_fidx);
	     call xforum_format_$display (forum_user_trans_ptr, xam_FIRST, nt_code);
	     if nt_code ^= 0
	     then call com_err_$suppress_name (nt_code, xam_ME, "Trying to print comment.");
	end;

	return;

     end next_trans;

list_trans: proc (lt_fidx);

/* PARAMETERS */

	dcl     lt_fidx		 fixed bin;	/* (input) index identifing meeting to forum */

/* INTERNAL AUTOMATIC */

	dcl     lt_code		 fixed bin (35);	/* standard error code */
	dcl     lt_date_len		 fixed bin;	/* max number of chars needed to display date */
	dcl     lt_time_len		 fixed bin;	/* max number of chars needed to display time */
	dcl     lt_time_position	 fixed bin;	/* starting column of time field */
	dcl     lt_author_position	 fixed bin;	/* starting column of author field */
	dcl     lt_subject_position	 fixed bin;	/* starting column of subject field */
	dcl     lt_subject_max_len	 fixed bin;	/* maximum number of chars of subject that can be displayed */
	dcl     lt_header_line	 char (100);	/* header line that will appear above the comment listings */
	dcl     lt_item_line	 char (100);	/* formated comment listing */
	dcl     lt_unused1		 fixed bin;	/* unused output from system calls */

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr, 0, "", 0, lt_fidx);

	lt_date_len = date_time_$format_max_length ("^<date>", "", "");
	lt_time_len = date_time_$format_max_length ("^<time>", "", "");
	lt_time_position = 17 + lt_date_len;
	lt_author_position = 19 + lt_date_len + lt_time_len;
	lt_subject_position = 24 + lt_author_position;
	lt_subject_max_len = MAX_LEN - lt_subject_position + 1;
	if lt_subject_max_len < 7
	then do;
	     call ioa_ ("Your date and time formats are so long that there is not enough room");
	     call ioa_ ("to list the comment's author and a significant part of its subject.");
	     goto exit_list_trans;
	end;

	call ioa_$rsnnl (
	     "Comment#^^7tLines^^16tDate^^^itTime^^^itAuthor^^^itSubject",
	     lt_header_line, lt_unused1, lt_time_position, lt_author_position, lt_subject_position);
	call ioa_$rsnnl (
	     "[^^i]^^[*^^]^^10t(^^d)^^16t^^a^^^it^^a^^^it^^a.^^a^^^it^^a",
	     lt_item_line, lt_unused1, lt_time_position, lt_author_position, lt_subject_position);

	call ioa_ (lt_header_line);

	lt_code = 0;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, lt_code);
	do while (lt_code ^= forum_error_table_$invalid_trans_idx);
	     if lt_code = 0
	     then call xforum_format_$list (forum_user_trans_ptr, lt_item_line, lt_subject_max_len, lt_code);
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, lt_code);
	end;

exit_list_trans:
	return;

     end list_trans;

select_trans_spec: proc (sts_spy_ptr);

/* PARAMETERS */

	dcl     sts_spy_ptr		 ptr;		/* (input) pointer to spy structure */

/* EXTERNAL ENTRY */

          dcl     error_table_$long_record	
                                         fixed bin(35) ext static;
/* INTERNAL AUTOMATIC */

          dcl     sts_code               fixed bin (35);
          dcl     reply		 char (132) varying;

/* CONSTANTS */

	dcl     sts_QUERY_USAGE	 char (69) init	/* help line for selection prompt */
				 ("Press  ? and RETURN:help   BREAK:To leave current comments unchanged") internal static options (constant);
          dcl     REPLY_LENGTH           fixed bin init (132) internal static options (constant);


	spy_ptr = sts_spy_ptr;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom
		     .iocb, (0));
		call xforum_help_line_$pop;
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_10, "QUIT");
		goto exit_select_trans_spec;
	     end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_help_line_$push ("0"b, "", "", sts_QUERY_USAGE);

select_trans_spec_prompt:
          answer_array.N = 0;				/* all answers acceptable			*/
	answer_array.max_length = REPLY_LENGTH;

          call xforum_get_str_ ((COMMENTS_PROMPT), addr(answer_array), PROMPT_HELP, "comment_spec", reply, sts_code);

          if sts_code = error_table_$long_record 
          then do;
	     call ioa_ ("^/Max length (^d) of comment specifier exceeded -please reenter^/  (or press BREAK to return to menu).", REPLY_LENGTH);
	     goto select_trans_spec_prompt;
	end;

	if length(reply) = 0
	then call collect_spy_data (SPY_AT_10, "RETURN");
	else do;
	     if reply = "?"
	     then call collect_spy_data (SPY_AT_10, "?");
	     else if index (reply, ":") ^= 0
	     then call collect_spy_data (SPY_AT_10, "range");
	     else if verify (reply, "0123456789") ^= 0
	     then call collect_spy_data (SPY_AT_10, "number");
	     else call collect_spy_data (SPY_AT_10, substr (reply,1));

	     call xforum_validate_trans_spec_ (xforum_meeting_info_ptr, spy_ptr, substr (reply, 1), sts_code);
	     if sts_code ^= 0 then
		goto select_trans_spec_prompt;
	end;

	call xforum_help_line_$pop;

exit_select_trans_spec:
	return;

     end select_trans_spec;

copy_comments: proc (cc_spy_ptr, cc_fidx, cc_version);

/* PARAMETERS */

	dcl     cc_spy_ptr		 ptr;		/* (input) points to the spy structure */
	dcl     cc_fidx		 fixed bin;	/* (input) index identifing meeting to forum */
	dcl     cc_version		 fixed bin;	/* (input) version of the forum meeting */

/* INTERNAL AUTOMATIC */

	dcl     cc_bc		 fixed bin (24);	/* bit count of segment comments are being copied to, set before */
						/* the first comment is copied and updated after each */
						/* comment is copied */
	dcl     cc_code		 fixed bin (35);	/* standard error code */
	dcl     cc_entry_name	 char (32);	/* entry name of identified segment */
	dcl     cc_number_of_comments	 fixed bin;	/* count of comments copied to segment */
	dcl     cc_seg_ptr		 ptr;		/* pointer to segment comments are being copied to */
	dcl     cc_trans_no		 fixed bin;	/* number of the comment about to be copied */

	call xforum_attend_mtg_utilities$copy_to_name (cc_spy_ptr, cc_entry_name, cc_seg_ptr, cc_bc);
	if cc_seg_ptr = null ()
	then goto exit_copy_comments;

	cc_number_of_comments = 0;
	call ioa_ ("^/^/   Comments are being copied to ^a.", cc_entry_name);
	call xforum_help_line_$push ("0"b, "", "Return to Meeting menu", "");

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call xforum_help_line_$pop;
		call collect_spy_data (SPY_AT_15, "QUIT");
		goto exit_copy_comments;
	     end;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, cc_code);
	do while (cc_code ^= forum_error_table_$invalid_trans_idx);
	     if cc_code = 0
	     then do;
		cc_number_of_comments = cc_number_of_comments + 1;
		cc_trans_no = forum_user_trans.trans_no;
		call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
		     cc_trans_no, "", cc_version, cc_fidx);
		call xforum_format_$append (forum_user_trans_ptr, cc_seg_ptr, "0"b, cc_bc, cc_code);
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, cc_code);
	end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call ioa_ ("^d comments copied to file ^a.", cc_number_of_comments, cc_entry_name);

exit_copy_comments:
	return;

     end copy_comments;

next_unread_trans: proc (nut_fidx, nut_version);

/* PARAMETERS */

	dcl     nut_fidx		 fixed bin;	/* (input) index identifing meeting to forum */
	dcl     nut_version		 fixed bin;	/* (input) version of forum meeting */

/* INTERNAL AUTOMATIC */

	dcl     nut_code		 fixed bin (35);	/* standard error code */
	dcl     nut_old_flags	 bit (6) unaligned; /* the flags identifing the current comments */
	dcl     nut_old_current	 fixed bin;	/* the index of the current comment if there is only one */


	nut_old_flags = string (xforum_meeting_info.flags);
	nut_old_current = xforum_meeting_info.current;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_attend_mtg_utilities$next_unread_comment (xforum_meeting_info_ptr,
	     nut_fidx, nut_version, forum_user_trans_ptr);

	if forum_user_trans_ptr = null ()
	then do;
	     call ioa_ ("There are no unread comments in this meeting.");
	     unspec (xforum_meeting_info.flags) = nut_old_flags;
	     xforum_meeting_info.current = nut_old_current;
	     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
		xforum_meeting_info.current, "", nut_version, nut_fidx);
	end;
	else do;
	     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
		forum_user_trans.trans_no, "", nut_version, nut_fidx);
	     call xforum_format_$display (forum_user_trans_ptr, xam_FIRST, nut_code);
	     if nut_code ^= 0
	     then call com_err_$suppress_name (nut_code, xam_ME, "Trying to print comment.");
	end;

	return;

     end next_unread_trans;

meeting_maintenance: proc;



	call ioa_ ("Meeting Maintenance has not yet been implemented.");
	call timer_manager_$sleep (4, "11"b);

	return;

     end meeting_maintenance;

collect_spy_data: proc (csd_where, csd_response);

	dcl     csd_where		 fixed bin;	/* (input) location response was collected */
	dcl     csd_response	 char (*);	/* (input) user's response */





	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

     end xforum_ent_attend_mtg_menu;




		    xforum_find_path_.pl1           02/16/88  1457.2r w 02/16/88  1411.9       67023



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



/****^  HISTORY COMMENTS:
  1) change(85-06-17,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Updated header comments.  Removed reference to unused sl_control_s
     include file.  CChanged order of parameters so that the output
     forum_dir comes after the input forum_version instead of the other
     way around.
  2) change(87-07-21,LJAdams), approve(87-07-21,MCR7684),
     audit(87-07-24,Blair), install(87-08-06,MR12.1-1065):
     Declared constant MIN_NAME_LEN to get rid of magic number 1.
                                                   END HISTORY COMMENTS */


xforum_find_path_: proc (forum_name, forum_version, forum_dir, forum_control_entry, code);

/*
   BEGIN DESCRIPTION

   function:
      This module is used to determine if a given name is the name of a
      forum meeting. The name does not include the forum or control suffix.
      The meeting list structure has already been searched and the name
      does not appear in the list. The current forum search rules are used
      to search for the name. The version of the meeting is input to this
      module, so first it is called with version 1 and if not meeting is
      found it is called again with version 2. If a meeting is located the
      The directory, and name of the forum meeting are returned. The output
      name includes either the .forum or .control suffix. If the name does
      not correspond to a meeting found by the search paths the error
      forum_error_$not_in_search_list is returned.

   description of entry points:
      xforum_find_path:
         input:   char (*)          name of meeting to find (suffix is NOT included)
                  fixed bin         version of meeting being looked for
         output:  char (*)          directory meeting is in or "" if not found
                  char (*)          primary name on the meeting, includes suffix
                  fixed bin (35)    standard error code
         Version specific information, i.e. meeting name suffix and maximum
         name lengths have been isolated in the variables MAX_NAME_LEN
         and NAME_SUFFIX. The module search_paths_$find_all will search
         the current forum search paths for any occurance of a branch
         with the input name concatinated with the appropriate suffix and
         return a list of those paths. For each path returned a call is made to
         forum_$get_forum_path to determine if the branch is really a forum
         meeting and to determine the real directory and entry name (it will
         follow links). The array of paths is allocated in the system free are
         so a cleanup handler is used to be sure that the space is freed up.

   description of internal procedures:

   known bugs:

   notes:

   history:
      83-??-?? Deryk Barker: written.

      84-03-27 Davids: added forum_version parameter and tests of forum_verson
      to see if the .control or .forum suffix is to be used.

      84-09-04 Davids: Added code = 0 as the first executable statement. 
      code was not being set to zero which was causing problems.

      84-11-06 Davids: Auditing changes: 1) improved functional description,
      2) isolated version specific constants into the MAX_NAME_LEN and
      NAME_SUFFIX arrays, 3) change the call to search_paths_$get to
      search_paths_$find_all, and 4) replaced references to status with
      references to code. Also deleted code at the end of the module which
      set the value of forum_name_len based on the name returned by 
      forum_$get_forum_path, why set an automatic variable right before
      exiting the module? And redid the declaration so that they are separated
      by type.
   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     forum_name		 char (*);	/* (input) name of meeting to find (suffix is NOT included) */
	dcl     forum_version	 fixed bin;	/* (input) version of meeting being looked for */
	dcl     forum_dir		 char (*);	/* (output) directory meeting is in or "" if not found */
	dcl     forum_control_entry	 char (*);	/* (output) primary name on the meeting, includes suffix */
	dcl     code		 fixed bin (35);	/* (output) standard error code */

/* EXTERNAL STATIC */

	dcl     error_table_$noentry	 fixed bin (35) ext static;
	dcl     forum_error_table_$long_forum_name fixed bin (35) ext static;
	dcl     forum_error_table_$blank_forum_name fixed bin (35) ext static;
	dcl     forum_error_table_$not_in_search_list fixed bin (35) ext static;

/* ENTRIES */
	dcl     forum_$get_forum_path	 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     get_system_free_area_	 entry () returns (ptr);
	dcl     search_paths_$find_all entry (char (*), ptr, char (*), char (*), ptr, fixed bin, ptr, fixed bin (35));



/* CONDITIONS */

	dcl     cleanup		 condition;

/* INTERNAL AUTOMATIC */

	dcl     forum_name_len	 fixed bin;	/* length of the input meeting name */
	dcl     idx		 fixed bin;	/* index into the search paths array */
	dcl     real_dir		 char (168);	/* directory meeting is in if found */
	dcl     real_entry		 char (32);	/* primary name of meeting if found */

/* INTERNAL STATIC */

/* CONSTANTS */

	dcl     (
                  MIN_NAME_LEN               fixed bin init (2),
	        MAX_NAME_LEN	 (2) fixed bin init (24, 26),
						/* max length of meeting name not including suffix */
						/* for version 1 and version 2 meeting names */
	        NAME_SUFFIX		 (2) char (8) varying init (".control", ".forum")
						/* meeting name suffixes for version 1 and version 2 names */
	        )			 internal static options (constant);

/* BUILTINS */

	dcl     (
	        length,
	        null,
	        rtrim
	        )			 builtin;

/* BASED */

/* INCLUDE FILES */

%include sl_info;

	code = 0;

	forum_name_len = length (rtrim (forum_name));

	if forum_name_len < MIN_NAME_LEN
	then do;
	     code = forum_error_table_$blank_forum_name;
	     return;
	end;

	if forum_name_len > MAX_NAME_LEN (forum_version)
	then do;
	     code = forum_error_table_$long_forum_name;
	     return;
	end;

	forum_control_entry = rtrim (forum_name) || NAME_SUFFIX (forum_version);

	sl_info_p = null ();
	on cleanup
	     begin;
		if sl_info_p ^= null ()
		then free sl_info;
	     end;

	call search_paths_$find_all ("forum", null (), forum_control_entry, "",
	     get_system_free_area_ (), sl_info_version_1, sl_info_p, code);
	if code ^= 0
	then return;

	forum_dir = "";
	code = 1;
	do idx = 1 to sl_info.num_paths while (code ^= 0);
	     if sl_info.paths (idx).code = 0
	     then call forum_$get_forum_path (sl_info.pathname (idx),
		     forum_control_entry, real_dir, real_entry, code);
	end;
	free sl_info;

	if code ^= 0
	then do;
	     if code = error_table_$noentry
	     then do;
		code = forum_error_table_$not_in_search_list;
		return;
	     end;
	     else return;
	end;

	forum_dir = real_dir;
	forum_control_entry = real_entry;

	return;

     end xforum_find_path_;




		    xforum_format_.pl1              04/25/86  0814.5rew 04/24/86  1513.4      228825



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



/****^  HISTORY COMMENTS:
  1) change(85-01-21,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Modified so that if the write_sw is true (write entry called) The
     subject is separated from the comment by the character <ESC>.
     This gives the emacs extension something to search for instead of
     assuming that there are no <NL>s embedded in the subject.  An
     assumption that does not have to be true.  <NL> characters
     embedded in the subject are translated into spaces when the
     comments are listed.
     
     85-03-04 Davids: Added the parameter P_for_emacs_sw to the append
     entry.  This will indicate that the output of this append is to be
     for emacs so special handling of the subject will be done.  Change
     the write entry to alwasy set the for_emacs_sw variable to ON.
     Modified the ioa control string for display so that if the clear
     switch is off a line feed will preceed the comment.  Modified the
     control string for write and append so that if the comment is not
     the first comment, i.e bit_count ^= 0 then either a form feed will
     preceed the comment (for the non emacs case) or a line feed will
     (for the emacs case.)
     
     85-04-10 Davids: Modified so that the output of a comment produced
     via the write_sw, append_sw, or display_sw uses the date_time
     string produced by the new date_time_$format routine which takes
     into account the user's default date_time format and language.
  2) change(85-04-11,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added the parameters P_line_item and P_subject_max_len to the
     parameter list for the list entry.  Also changed the list entry to
     use the P_item_line as the ioa control string for outputing the
     list and to use the string "..." as an indication that the subject
     has been truncated.  The P_subject_max_len is used as the maximum
     length that the subject can be.  Finally the subject is now
     truncated at a new line character instead of translating the
     character to a space.  This what all the other subject display
     routines do, i.e.  subject on status line and subjects in the
     subject menu.
     
     85-06-21 Davids: Extensive internal reorganization.  Gave each
     entry its own set of parameters.  Replaced the COMMON block of
     code with internal procedures.  Added variable declaration
     comments and updated header comments.
                                                   END HISTORY COMMENTS */


xforum_format_: proc ();

/*
   BEGIN DESCRIPTION

   function:
      This procedure is used to display transaction. Transactions may be
      displayed on the terminal as either the complete transaction or just a
      one line "list" entry. Transactions may also be written to a segment.
      Only 1 transaction can be displayed during the call. A pointer to the
      transaction structure is input.

      Note that once the transaction is displayed the storage associated with
      it is freed.

   description of entry points:
      xforum_format_:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error
         condition will be signaled with an "internal programming error" error
         message.

      display:
         input:   ptr                 pointer to forum_user_trans structure for
                                      transaction to be displayed
                  bit (1) aligned     if "1"b the user_io window will be
                                      cleared prior to the display
         output:  fixed bin (35))     standard error code
         This entry displays a transaction on the terminal. By not clearing the
         user_io window before the display you can display multiple
         transactions on the screen. The transaction header includes the
         date-time that the transaction was entered in the user's default
         date-time format. The forum_user_trans structure is freed after the
         display is completed.

      list: 
         input:   ptr                 pointer to forum_user_trans structure for
                                      transaction to be listed
                  char (*)            ioa_ control string to be used to output
                                      line of listing
                  fixed bin           max number of chars from subject to
                                      include in listing
         output:  fixed bin (35)      standard error code
         This entry is used to output a 1 line listing of a transaction. The
         listing includes the forum transaction number, the number of lines in
         the transaction, the date and time that it was entered, the person and
         project ids of the person who entered it and as much of the subject as
         is possible. The format for all this output is controled by the input
         ioa_ control string. This entry does not print out any header lines,
         it is assumed that the caller has done so. It also therefore never
         clears the user_io window. If the transaction subject is longer than
         the input max length the subject is truncated to max_len - 3 and ...
         appended to it. If the subject contains a new line character it is
         truncated at that point and ... appended to it. The date and time
         are output in tghe user's default date and time formats. NOTE that
         these can be different from the user's default date_time format.
         The forum_user_trans structure is freed after the listing line is
         output.

      write:
         input:   ptr                 pointer to forum_user_trans structure for
                                      transaction to be written
                  ptr                 pointer to segment that transaction is to
                                      be written to
         output:  fixed bin (35)      standard error code
         This entry writes the transaction to a segment. The transaction will
         begin at the beginning of the segment. The bit count of the segment
         will be set and the segment truncated to the transaction length.
         It will also be specially formated so that the emacs extension can
         use it. See the description of the internal proc write_to_seg for a
         description of the special emacs formating. The transaction will be
         written using the user's default date-time format and the
         forum_user_trans structure will be freed after it is written. The
         user_io is not touched by this entry.
 
      append:
         input:   ptr                 pointer to forum_user_trans structure for
                                      transaction to be appended
                  ptr                 pointer to segment that transaction is to
                                      be appended to
                  bit (1) aligned     "1"b indicates that segment will be
                                      handed to emacs for display
         input/output:
                  fixed bin (24)      original and updated bit count of segment
         output:  fixed bin (35)      standard error code
         This entry appends a transaction to the end of a segment.
         The bit count of the segment will be updated to reflect the new data.
         If the input for_emacs_sw is set to true the transaction will be
         specially formated so that the emacs extension can use it. See the
         description of the internal proc write_to_seg for a description of the
         special emacs formating. The transaction will be written using the
         user's default date-time format and the forum_user_trans structure
         will be freed after it is written. The user_io is not touched by
         this entry.



   description of internal procedures:
      write_to_seg: This procedure is called by both the write entry and the
      append entry. It writes the transaction to the segment positioning it
      to start after anything already in the segment (the write entry calls it
      with a starting bit count of 0). After its written the new bit count is
      calculated and set. The header line of the transaction includes the
      date-time that the transaction was entered. This date-time is written in
      the user's default date-time format. There are two formats that are used
      to output the transaction. The "normal" format will preceed each
      transaction with a form feed, unless the segment's starting bit count is
      0. In the "emacs" format the transactions are preceeded by a blank line,
      unless the segment's starting bit count is 0. In addition an ESCAPE
      character will be appended onto the subject of the transaction written
      when the segments starting bit count is 0. The ESCAPE is used to
      terminate the subject so that the emacs editor extension can identify
      the end og multi-line subjects. After the segment's bit count has been
      updated the forum_user_trans structure is freed.

      make_end_line: This internal procedure creates the last line displayed
      when the transaction is displayed or written to a segment. It determines 
      if the transaction being displayed or written is part of a comment chain.
      The end line string indicates that the end of the transaction has been
      reached and if there is a previous or next comment in the same comment
      chain. The end line string is returned to the main procedure and used as
      an argument in the calls to ioa_.

      count_lines: This internal proc counts the number of lines that make up
      the comment. It does this by searching the comment counting new line
      characters.

      error: Similar to all other error procedures. It records in an internal
      static structure the details of an error and then signals the
      xforum_fatal_error condition.

   known bugs:

   notes:

   history
      84-06-14 Davids: Modified so that fnumber (the transaction number) is
      declared fixed bin instead of pc "9999". This was needed because
      there are meetings with more than 9999 transactions. Fixed bin was used
      so that leading 0's are not output. Changed call ioa_ statements to refer
      to fnumber as ^i instead of ^a.

      84-08-08 Davids: Modified so that the loop that counts the number of
      lines (at the beginning of COMMON) can handle the case where the last
      line does not end in a NL character. This was causing an infinite loop.
      Also added the make_end_line routine to change the termination string
      to that defined in the MTB.

      84-09-26 Davids: Modified so that right before it returns it frees the
      structure associated with the transaction. This was put here instead of
      requiring that the all the callers did it. Also changed from using
      hcs_$set_bc to using terminate_file_.

      84-09-27 Davids: Added the append entry point and code in COMMON to
      implement it.

      84-10-24 Davids: Modified the make_end_line internal proc so that
      the forum_user_trans structures that are allocated in the calls
      to xforum_trans$next_ref and previous_ref are freed. they were not being
      freed and large numbers of selections were causing RQOs in the pdir -
      which results in a fatal process error.

      84-10-29 Davids: Added the approx_trans_length variable and made the
      lengths of seg and append_seg that long instead of the constant 1000000
      characters. This was needed because ioa_$rs was creating a segment of
      1000000 characters of 245 pages. If the user does not have the quota 
      it dies with a record quota overflow. The 500 character constant is used
      to take care of the header and trailer lines.

      84-11-14 Davids: Auditing changes: 1) Under the COMMON label, combined
      the the write and append code by extending the ioa_ string to include the
      form feed if the bit count is not zero. 2) Also combined the code for
      producing a listing so that only 1 call to ioa_ is made. a local copy
      of the subject is made which is either the entire subject or the first
      18 characters of the subject and the string <MORE>. 3) In make_end_line
      combined three separate calls to ioa_ which depended on the flags into 1
      call with a more complex ioa_ string and the flags input to ioa_.
      3) cleaned up the declarations.
   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     date_time_$format	 entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var);
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rs		 entry () options (variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     iox_$user_io	 ptr ext static;
	dcl     signal_		 entry () options (variable);
	dcl     terminate_file_	 entry (ptr, fixed bin (24), bit (*), fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_trans_$next_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$prev_ref entry (fixed bin, ptr, fixed bin (35));

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

	dcl     xf_end_line		 char (100) varying;/* contains the last line of the display */
						/* indicates the comment number and if its part of a subject chain */

/* INTERNAL STATIC */

	dcl     01 xf_xforum_error_info like xforum_error_info internal static;
						/* used to record error infor to be outpuyt to the user */

/* CONSTANTS */

	dcl     xf_NL		 char (1) init ("
") internal static options (constant);
						/* new line character */

/* BUILTINS */

	dcl     (
	        addbitno,
	        addr,
	        index,
	        length,
	        null,
	        rtrim,
	        substr
	        )			 builtin;

/* BASED */

/* INCLUDE FILES */

%include xforum_error_info;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_meeting_info;
%page;
%include forum_user_trans;
%page;
%include terminate_file;

	call error (0, "Internal programming error - xforum_format_$xforum_format called.");

display: entry (d_forum_user_trans_ptr, d_clear_sw, d_code);

/* PARAMETERS */

	dcl     d_forum_user_trans_ptr ptr;		/* (input) pointer to forum_user_trans */
						/*         structure for transaction to be displayed */
	dcl     d_clear_sw		 bit (1) aligned;	/* (input) if "1"b the user_io window */
						/*         will be cleared prior to the display */
	dcl     d_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     d_date_time		 char (256);	/* date and time comment was entered */
						/* formated according to the users date_time format */
	dcl     d_lines		 fixed bin;	/* number of lines in the comment */
	dcl     d_number		 fixed bin;	/* forum comment number */





	d_code = 0;

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

	forum_user_trans_ptr = d_forum_user_trans_ptr;
	d_number = forum_user_trans.trans_no;
	d_lines = count_lines ();
	call make_end_line (d_number);

	d_date_time = date_time_$format ("^<date_time>", forum_user_trans.time, "", "");
	call ioa_ (
	     "^[^/^][^i] (^d line^[s^]) ^a.^a ^a ^a^/Subject: ^a^/^a--------------^/^a",
	     ^d_clear_sw, d_number, d_lines, (d_lines ^= 1),
	     forum_user_trans.person_id, forum_user_trans.project_id,
	     d_date_time, xforum_meeting_info.name,
	     forum_user_trans.subject, forum_user_trans.text,
	     xf_end_line);

	free forum_user_trans;

	return;

list: entry (l_forum_user_trans_ptr, l_item_line, l_subject_max_len, l_code);

/* PARAMETERS */

	dcl     l_forum_user_trans_ptr ptr;		/* (input) pointer to forum_user_trans */
						/*         structure for transaction to be listed */
	dcl     l_item_line		 char (*);	/* (input) ioa_ control string to */
						/*         be used to output line of listing */
	dcl     l_subject_max_len	 fixed bin;	/* (input) max number of chars from */
						/*         subject to include in listing */
	dcl     l_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     l_date_string	 char (100);	/* date comment was entered */
						/* formated according to the users date format */
	dcl     l_lines		 fixed bin;	/* number of lines in the comment */
	dcl     l_local_subject	 char (25);	/* that part of the subject string that will be listed */
	dcl     l_nl_index		 fixed bin;	/* index in local_subject string of */
						/* the first new line char, if any */
	dcl     l_number		 fixed bin;	/* forum comment number */
	dcl     l_time_string	 char (100);	/* time comment was entered */
						/* formated according to the users time format */





	l_code = 0;

	forum_user_trans_ptr = l_forum_user_trans_ptr;
	l_number = forum_user_trans.trans_no;
	l_lines = count_lines ();

	l_date_string = date_time_$format ("^<date>", forum_user_trans.time, "", "");
	l_time_string = date_time_$format ("^<time>", forum_user_trans.time, "", "");

	if length (rtrim (forum_user_trans.subject)) <= l_subject_max_len
	then l_local_subject = forum_user_trans.subject;
	else l_local_subject = substr (forum_user_trans.subject, 1, l_subject_max_len - 3) || "...";

	l_nl_index = index (l_local_subject, xf_NL);
	if l_nl_index > 0
	then do;
	     if l_nl_index <= l_subject_max_len - 3
	     then l_local_subject = substr (forum_user_trans.subject, 1, l_nl_index - 1) || "...";
	     else l_local_subject = substr (forum_user_trans.subject, 1, l_subject_max_len - 3) || "...";
	end;

	call ioa_ (l_item_line, l_number, (l_number = xforum_meeting_info.current), l_lines,
	     l_date_string, l_time_string, forum_user_trans.person_id, forum_user_trans.project_id, l_local_subject);

	free forum_user_trans;

	return;

write: entry (w_forum_user_trans_ptr, w_seg_ptr, w_code);

/* PARAMETERS */

	dcl     w_forum_user_trans_ptr ptr;		/* (input) pointer to forum_user_trans */
						/*         structure for transaction to be written */
	dcl     w_seg_ptr		 ptr;		/* (input) pointer to segment that */
						/*         transaction is to be written to */
	dcl     w_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     w_for_emacs_sw	 bit (1) aligned;	/* indicates special handling because output */
						/* will be read by the emacs extension */
	dcl     w_starting_bc	 fixed bin (24);	/* bit count of segment before the comment has been written out */
	dcl     w_unused_fb24	 fixed bin (24) aligned; /* unused output parameter */





	w_code = 0;
	w_starting_bc = 0;
	w_for_emacs_sw = "1"b;

	call write_to_seg (w_forum_user_trans_ptr, w_seg_ptr, w_starting_bc, w_for_emacs_sw, w_unused_fb24, w_code);

	return;

append: entry (a_forum_user_trans_ptr, a_seg_ptr, a_for_emacs_sw, a_bc, a_code);

/* PARAMETERS */

	dcl     a_forum_user_trans_ptr ptr;		/* (input) pointer to forum_user_trans */
						/*         structure for transaction to be appended */
	dcl     a_seg_ptr		 ptr;		/* (input) pointer to segment that */
						/*         transaction is to be appended to */
	dcl     a_for_emacs_sw	 bit (1) aligned;	/* (input) "1"b indicates that segment will */
						/*         be handed to emacs for display */
	dcl     a_bc		 fixed bin (24);	/* (input/output) original and updated bit count of segment */
	dcl     a_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     a_final_bc		 fixed bin (24) aligned; /* bit count of segment after */
						/* the comment has been written out */





	a_code = 0;

	call write_to_seg (a_forum_user_trans_ptr, a_seg_ptr, a_bc, a_for_emacs_sw, a_final_bc, a_code);

	a_bc = a_final_bc;

	return;

write_to_seg: proc (wts_forum_user_trans_ptr, wts_seg_ptr, wts_starting_bc, wts_for_emacs_sw, wts_final_bc, wts_code);

/* PARAMETERS */

	dcl     wts_forum_user_trans_ptr ptr;		/* (input) pointer to the forum_user_trans */
						/*         structure for transaction to be written out */
	dcl     wts_seg_ptr		 ptr;		/* (input) pointer to segment where */
						/*         transaction is to be written */
	dcl     wts_starting_bc	 fixed bin (24);	/* (input) bit count of segment before write */
	dcl     wts_for_emacs_sw	 bit (1) aligned;	/* (input) "1"b indicates that segment will */
						/*         be handed to emacs for display */
	dcl     wts_final_bc	 fixed bin (24);	/* (output) bit count of segment after write */
	dcl     wts_code		 fixed bin (35);	/* (output) standard error code */

/* INTERNAL AUTOMATIC */

	dcl     wts_approx_trans_length fixed bin;	/* estimation of comment length for */
						/* basing the wts_seg based string */
	dcl     wts_date_time	 char (200);	/* date and time comment was entered */
						/* formatted according to the users date_time format */
	dcl     wts_first_char_ptr	 ptr;		/* pointer to where first character is to be written in wts_seg */
	dcl     wts_lines		 fixed bin;	/* number of lines in the comment */
	dcl     wts_no_chars	 fixed bin;	/* number of characters actually written to wts_seg */
	dcl     wts_number		 fixed bin;	/* forum comment number */

/* BASED */

	dcl     wts_seg		 char (wts_approx_trans_length) based (wts_first_char_ptr);





	wts_code = 0;

	forum_user_trans_ptr = wts_forum_user_trans_ptr;
	wts_number = forum_user_trans.trans_no;
	wts_lines = count_lines ();
	call make_end_line (wts_number);

	wts_date_time = date_time_$format ("^<date_time>", forum_user_trans.time, "", "");

	if wts_starting_bc ^= 0
	then wts_first_char_ptr = addbitno (wts_seg_ptr, wts_starting_bc + 1);
	else wts_first_char_ptr = wts_seg_ptr;

	wts_approx_trans_length = forum_user_trans.subject_length + forum_user_trans.text_length + 500;
	call ioa_$rs (
	     "^[^s^;^[^/^;^|^]^][^i] (^d line^[s^]) ^a.^a ^a ^a^/Subject: ^a^[^]^/^a--------------^/^a",
	     wts_seg, wts_no_chars, (wts_starting_bc = 0), wts_for_emacs_sw,
	     wts_number, wts_lines, (wts_lines ^= 1), forum_user_trans.person_id,
	     forum_user_trans.project_id, wts_date_time, xforum_meeting_info.name,
	     forum_user_trans.subject, ((wts_starting_bc = 0) & wts_for_emacs_sw),
	     forum_user_trans.text, xf_end_line);

	wts_final_bc = (wts_no_chars * 9) + wts_starting_bc;
	call terminate_file_ (wts_seg_ptr, wts_final_bc, TERM_FILE_TRUNC_BC, wts_code);

	free forum_user_trans;

	return;

     end write_to_seg;

make_end_line: proc (mel_number);

/*
   Note that the next_trans_ptr and prev_trans_ptr pointers in the
   forum_user_trans structure are not usable, they are set to null regardless
   of the next/prev status of the current transaction.
*/

/* PARAMETERS */

	dcl     mel_number		 fixed bin;	/* (input) number of current transaction */

/* AUTOMATIC */

	dcl     mel_code		 fixed bin (35);	/* standard error code */
	dcl     mel_forum_user_trans_ptr ptr;		/* pointer to next and previous transaction */
	dcl     mel_next_trans	 bit (1);		/* true if current transaction has a next reference */
	dcl     mel_prev_trans	 bit (1);		/* true if current transaction has a previous reference */
	dcl     mel_unused_fb21	 fixed bin (21);	/* unused output from ioa_ */





	mel_next_trans = "1"b;
	mel_prev_trans = "1"b;

	call xforum_trans_$next_ref (mel_number, mel_forum_user_trans_ptr, mel_code);
	if mel_code ^= 0
	then mel_next_trans = "0"b;
	else free mel_forum_user_trans_ptr -> forum_user_trans;

	call xforum_trans_$prev_ref (mel_number, mel_forum_user_trans_ptr, mel_code);
	if mel_code ^= 0
	then mel_prev_trans = "0"b;
	else free mel_forum_user_trans_ptr -> forum_user_trans;

	call ioa_$rsnnl ("End of comment number ^i^[.^;, (^[next^]^[ and ^]^[previous^] comment on subject available).^]",
	     xf_end_line, mel_unused_fb21, mel_number,
	     ^mel_next_trans & ^mel_prev_trans, mel_next_trans,
	     mel_next_trans & mel_prev_trans, mel_prev_trans);

	return;

     end make_end_line;

count_lines: proc () returns (fixed bin);

/* INTERNAL AUTOMATIC */

	dcl     cl_i		 fixed bin;	/* index of "last" new line character found */
	dcl     cl_j		 fixed bin;	/* index of "next" new line character found */
	dcl     cl_lines		 fixed bin;	/* could of new line characters found */





	cl_lines = 1;
	cl_i = index (forum_user_trans.text, xf_NL);
	do while (cl_i < forum_user_trans.text_length);
	     cl_lines = cl_lines + 1;
	     cl_j = index (substr (forum_user_trans.text, cl_i + 1), xf_NL);
	     if cl_j ^= 0
	     then cl_i = cl_i + cl_j;
	     else cl_i = forum_user_trans.text_length;
	end;

	return (cl_lines);

     end count_lines;

error: proc (e_code, e_message);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with the error */
	dcl     e_message		 char (*);	/* (input) message to be output to user */





	xf_xforum_error_info.name = "xforum_format_";
	xf_xforum_error_info.entry = "";
	xf_xforum_error_info.doing = "";
	xf_xforum_error_info.code = e_code;
	xf_xforum_error_info.reason = e_message;

	call signal_ ("xforum_fatal_error", null (), addr (xf_xforum_error_info), null ());

     end error;

     end xforum_format_;




		    xforum_get_selected_trans.pl1   04/25/86  0819.5rew 04/24/86  1513.5      101223



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


/****^  HISTORY COMMENTS:
  1) change(85-01-30,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Written.
     
     85-02-26 Davids: Added checks in the next entry so that the for
     the all, new, and allref cases the value of xgst_trans_no is only
     set if the code returned from forum_ is 0.  If the code returned
     is not 0 it is changed to forum_error_table_$invalid_trans_id.
     The other cases don't require the check and already translate
     non-zero error codes to invalid_trans_id.
     
     85-06-24 Davids: Updated comments to variable and parameter
     declarations and added some detail to the header comments.
  2) change(86-02-18,LJAdams), approve(86-02-18,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added the lastref option.
                                                   END HISTORY COMMENTS */

xforum_get_selected_trans: proc;

/*
   BEGIN DESCRIPTION

   function:		       
      This module returns the set of selected transactions based on the
      xforum_meeting_info.flags. 

   description of entry points:
      xforum_get_selected_trans:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error 
         condition will be signaled with an "internal propgramming error" error
         message.

      first:
         input:   ptr                 pointer to the xforum_meeting_info
                                      structure which contains the current
                                      comment spec
         output:  ptr                 pointer to the forum_user_trans structure
                                      for the first comment that meets the
                                      current comment specification
                  fixed bin (35)      standard error code
         This entry is used to return the first selected transaction. The
         first transaction is the transaction with the lowest transaction
         index. If an error occurs it will be reported to the user and the
         error code forum_error_table_$invalid_trans_idx will be returned to
         the caller. The transaction index is stored in an internal static
         variable so that a call to next knows where to start. If the comments
         are being selected from a set the set index is stored in an internal
         static variable.

      next:
         input:   ptr                 pointer to the xforum_meeting_info
                                      structure which contains the current
                                      comment spec
         output:  ptr                 pointer to the forum_user_trans structure
                                      for the next comment that meets the
                                      current comment specification
                  fixed bin (35)      standard error code
         This entry is used to get the "next" selected transaction. When the
         set of selected transactions is completed the error code
         forum_error_table_$invalid_trans_idx is returned to the caller.

   description of internal procs:
      error: Similar to all the other error procedures. It records in an
      internal static structure the details of an error and then signals the
      xforum_fatal_error condition.
   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

	dcl     forum_error_table_$invalid_trans_idx fixed bin (35) ext static;

/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     signal_		 entry () options (variable);
	dcl     xforum_trans_$first_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$first_trans entry (ptr, fixed bin (35));
	dcl     xforum_trans_$next_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$next_trans entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$read	 entry (fixed bin, ptr, fixed bin (35));

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

	dcl     xforum_meeting_info_ptr ptr;		/* default pointer to the xforum_meeting_info structure */
						/* not included in the xforum_meeting_info include file */

/* INTERNAL STATIC */

	dcl     (
	        xgst_trans_no	 fixed bin,	/* forum index of last comment selected */
	        xgst_set_index	 fixed bin,	/* index into set array of last comment selected from a set */
	        01 xgst_xforum_error_info like xforum_error_info /* used to record error info to be output to user */
	        )			 internal static;

/* CONSTANTS */

	dcl     xgst_ME		 char (25) init ("xforum_get_selected_trans") internal static options (constant);

/* BUILTINS */

	dcl     (
	        addr,
	        null
	        )			 builtin;

/* BASED */

/* INCLUDE FILES */

%include forum_user_trans;
%page;
%include xforum_error_info;
%page;
%include xforum_meeting_info;

	call error (0, "Internal programming error - xforum_get_selected_trans$xforum_get_selected_trans called.");

first: entry (f_xforum_meeting_info_ptr, f_forum_user_trans_ptr, f_code);

/* PARAMETERS */

	dcl     f_xforum_meeting_info_ptr ptr;		/* (input) pointer to the xforum_meeting_info structure */
						/*         which contains the current comment spec */
	dcl     f_forum_user_trans_ptr ptr;		/* (output) pointer to the forum_user_trans structure for the */
						/*          first comment that meets the current comment */
						/*          specification */
	dcl     f_code		 fixed bin (35);	/* (output) standard error code */




	xforum_meeting_info_ptr = f_xforum_meeting_info_ptr;

	if xforum_meeting_info.all
	then do;
	     call xforum_trans_$first_trans (f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Getting first comment.");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	     else xgst_trans_no = f_forum_user_trans_ptr -> forum_user_trans.trans_no;
	end;
	else if xforum_meeting_info.new
	then do;
	     call xforum_trans_$next_trans (xforum_meeting_info.last_seen, f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Getting first new comment.");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	     else xgst_trans_no = f_forum_user_trans_ptr -> forum_user_trans.trans_no;
	end;
	else if xforum_meeting_info.range
	then do;
	     call xforum_trans_$read (xforum_meeting_info.low, f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Getting first comment in range");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	     else xgst_trans_no = f_forum_user_trans_ptr -> forum_user_trans.trans_no;
	end;
	else if xforum_meeting_info.allref
	then do;
	     call xforum_trans_$first_ref (xforum_meeting_info.current_ref, f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Getting first comment in subject chain");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	     else xgst_trans_no = f_forum_user_trans_ptr -> forum_user_trans.trans_no;
	end;
	else if xforum_meeting_info.restref
	then do;
	     call xforum_trans_$next_ref (xforum_meeting_info.current_ref, f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Getting next reference in subject chain");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	     else xgst_trans_no = f_forum_user_trans_ptr -> forum_user_trans.trans_no;
	end;
	else if xforum_meeting_info.set
	then do;
	     call xforum_trans_$read (set_array.index (1), f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Getting first comment in set");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	     else xgst_set_index = 1;
	end;
	else do;
	     call xforum_trans_$read (xforum_meeting_info.current, f_forum_user_trans_ptr, f_code);
	     if f_code ^= 0
	     then do;
		call com_err_$suppress_name (f_code, xgst_ME, "Reading current comment.");
		f_code = forum_error_table_$invalid_trans_idx;
	     end;
	end;

	return;

next: entry (n_xforum_meeting_info_ptr, n_forum_user_trans_ptr, n_code);

/* PARAMETERS */

	dcl     n_xforum_meeting_info_ptr ptr;		/* (input) pointer to the xforum_meeting_info structure */
						/*         which contains the current comment spec */
	dcl     n_forum_user_trans_ptr ptr;		/* (output) pointer to the forum_user_trans structure for the */
						/*          next comment that meets the current comment */
						/*          specification */
	dcl     n_code		 fixed bin (35);	/* (output) standard error code */





	xforum_meeting_info_ptr = n_xforum_meeting_info_ptr;

	if xforum_meeting_info.all | xforum_meeting_info.new
	then do;
	     call xforum_trans_$next_trans (xgst_trans_no, n_forum_user_trans_ptr, n_code);
	     if n_code = 0
	     then xgst_trans_no = n_forum_user_trans_ptr -> forum_user_trans.trans_no;
	     else n_code = forum_error_table_$invalid_trans_idx;
	end;
	else if xforum_meeting_info.allref
	then do;
	     call xforum_trans_$next_ref (xgst_trans_no, n_forum_user_trans_ptr, n_code);
	     if n_code = 0
	     then xgst_trans_no = n_forum_user_trans_ptr -> forum_user_trans.trans_no;
	     else n_code = forum_error_table_$invalid_trans_idx;
	end;
	else if xforum_meeting_info.restref
	then do;
	     call xforum_trans_$next_ref (xgst_trans_no, n_forum_user_trans_ptr, n_code);
	     if n_code = 0
	     then xgst_trans_no = n_forum_user_trans_ptr -> forum_user_trans.trans_no;
	     else n_code = forum_error_table_$invalid_trans_idx;
	end;

	else if xforum_meeting_info.range
	then do;
	     xgst_trans_no = xgst_trans_no + 1;
	     if xgst_trans_no <= xforum_meeting_info.high
	     then call xforum_trans_$read (xgst_trans_no, n_forum_user_trans_ptr, n_code);
	     else n_code = forum_error_table_$invalid_trans_idx;
	end;
	else if xforum_meeting_info.set
	then do;
	     xgst_set_index = xgst_set_index + 1;
	     if xgst_set_index <= set_array.number
	     then call xforum_trans_$read (set_array.index (xgst_set_index), n_forum_user_trans_ptr, n_code);
	     else n_code = forum_error_table_$invalid_trans_idx;
	end;
	else n_code = forum_error_table_$invalid_trans_idx;

	return;

error: proc (e_code, e_message);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with the error */
	dcl     e_message		 char (*);	/* (input) message to be output to user */

	xgst_xforum_error_info.name = xgst_ME;
	xgst_xforum_error_info.entry = "";
	xgst_xforum_error_info.doing = "";
	xgst_xforum_error_info.code = e_code;
	xgst_xforum_error_info.reason = e_message;

	call signal_ ("xforum_fatal_error", null (), addr (xgst_xforum_error_info), null ());

     end error;

     end xforum_get_selected_trans;




		    xforum_get_str_.pl1             08/06/87  1026.9rew 08/06/87  1014.6       65142



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


/****^  HISTORY COMMENTS:
  1) change(87-04-10,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Created.
                                                   END HISTORY COMMENTS */

xforum_get_str_: proc (P_prompt, P_acceptable_answers, P_info, P_section, P_str, P_code);

/* Parameters */

	dcl     P_acceptable_answers	 ptr;
	dcl     P_info		 char (*) parameter;
	dcl     P_section		 char (*) parameter;
	dcl     P_prompt		 char (*) var parameter;
	dcl     P_str		 char (*) var parameter;
	dcl     P_yes_sw		 bit (1) aligned parameter;
          dcl     P_code		 fixed bin (35) parameter;
	       

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
/*								        */
/* This is the main entry of xforum_get_str_. It prompts the user for input using       */
/* P_prompt and accepts only answers from P_acceptable_answers. If a question	        */
/* mark is input, the section P_section of P_info is displayed for the user	        */
/* by a call to xforum_help_. The user response is given by P_str.     	        */
/*								        */
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/* Automatic */

	dcl     accept_anything	 bit (1) aligned;
	dcl     been_thru_this_before	 bit (1) aligned;
	dcl     i			 fixed bin;
	dcl     yes_or_no_string	 char (3) var;

          dcl  1  answers based (Panswers) like answer_array,
               Panswers                  ptr;
	       

/* Entries */

	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$nnl		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     command_query_	 entry () options (variable);
	dcl     xforum_help_$display	 entry (char(*), char(*));

/* External Static */

          dcl     error_table_$long_record
                                         fixed bin(35) ext static;
	dcl     iox_$user_output	 ptr ext static;

/* Internal Static */

	dcl     1 auto_query_info	 like query_info int static;

/* Based */


/* Constants */

	dcl     ENABLE_ESCAPE	 bit (2) aligned init ("11"b) int static options (constant);
	dcl     ONLY_YES_OR_NO	 bit (1) aligned init ("1"b) int static options (constant);
	dcl     NOT_ONLY_YES_OR_NO	 bit (1) aligned init ("0"b) int static options (constant);

/* Builtin */

	dcl     (addr, length, null) builtin;

%include query_info;
%page;
%include xforum_answers;


	call main (P_prompt, P_acceptable_answers, P_info, P_section, NOT_ONLY_YES_OR_NO, P_str, P_code);
	return;

init: entry ();

	auto_query_info.version = query_info_version_6;
	auto_query_info.switches.yes_or_no_sw = "0"b;
	auto_query_info.switches.suppress_name_sw = "1"b;
	auto_query_info.switches.cp_escape_control = ENABLE_ESCAPE;
	auto_query_info.switches.suppress_spacing = "1"b;
	auto_query_info.switches.literal_sw = "0"b;
	auto_query_info.switches.prompt_after_explanation = "0"b;
	auto_query_info.switches.padding = "0"b;
	auto_query_info.status_code = 0;
	auto_query_info.query_code = 0;
	auto_query_info.question_iocbp = null ();	/* default: user_i/o */
	auto_query_info.answer_iocbp = null ();		/* default: user_input */
	auto_query_info.repeat_time = 0;		/* don't repeat */
	auto_query_info.explanation_ptr = null ();
	auto_query_info.explanation_len = 0;

return;


nl:  entry (P_prompt, P_acceptable_answers, P_info, P_section, P_str, P_code);


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
/*								        */
/* This entry performs exactly like the above main entry except that it also	        */
/* puts out a new_line and does a reset more before prompting the user.	        */
/*								        */
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

	Panswers = P_acceptable_answers;

 	call iox_$control (iox_$user_output, "reset_more", null, (0));
	call ioa_$nnl ("^/");
	call main (P_prompt, P_acceptable_answers, P_info, P_section, NOT_ONLY_YES_OR_NO, P_str, P_code);
	return;

yes_no: entry (P_prompt, P_yes_sw, P_code);


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
/*								        */
/* This is a special simplified entry for callers who want to restrict the user to yes  */
/* or no answers.  It prompts the user with P_prompt and returns either true (yes) or   */
/* false (no) in P_yes_sw.  It accepts yes, no, y, or n.  Help files are not supplied   */
/* to the main procedure here because command_query takes care of the "?" response      */
/* itself and never passes it back.					        */
/*								        */
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

	call main (P_prompt, null, "", "", ONLY_YES_OR_NO, yes_or_no_string, P_code);
	if yes_or_no_string = "YES"  | yes_or_no_string = "Y" |
             yes_or_no_string = "yes" | yes_or_no_string = "yes" 
	then P_yes_sw = "1"b;
	else P_yes_sw = "0"b;
	return;

main: proc (I_prompt, I_acceptable_answers, I_info, I_section, I_yes_or_no_sw, O_str, O_code);

	dcl     I_prompt		 char (*) var parameter;
	dcl     I_acceptable_answers	 ptr;
	dcl     I_info		 char (*) parameter;
	dcl     I_section		 char (*) parameter;
	dcl     I_yes_or_no_sw	 bit (1) aligned parameter;
	dcl     O_str		 char (*) var parameter;
          dcl     O_code                 fixed bin (35);
      
	dcl     line		 char (300) var;
	dcl     outline		 char (256);

	O_str = "";				/* Initialize output parameters */
          O_code = 0;

          accept_anything = "0"b;

          Panswers = I_acceptable_answers;
          
	if answers.N = 0 
	then accept_anything = "1"b;

          auto_query_info.switches.yes_or_no_sw = I_yes_or_no_sw;

	been_thru_this_before = "0"b;
	do while ("1"b);
	     call iox_$control (iox_$user_output, "reset_more", null, (0)); /* ignore code */

	     call command_query_ (addr (auto_query_info), line, "", "^[^/^]^a^2x", been_thru_this_before, I_prompt);
	     been_thru_this_before = "1"b;

               if length (line) > answers.max_length
               then do;
                         P_code = error_table_$long_record;
		     return;
                    end;

	     if line = "?"
	     then do;
		     if I_info = ""
		     then call ioa_ ("^/There is no help available for this prompt.");
		     else do;
			     call ioa_$nnl ("^/");
			     call xforum_help_$display (I_info, I_section);
			end;
		end;
	     else do;
		     if accept_anything
		     then do;
			     O_str = line;
			     go to EXIT;
			end;
		     else do i = 1 to answers.N;
			     if line = answers.answer (i)
			     then do;
				     O_str = line;
				     go to EXIT;
				end;
			end;
		     outline = line;
		     call ioa_ ("^/""^a"" is not an acceptable response.^/Please reenter^[ or type ""?"" for help^].", outline, (I_info ^= ""));
		end;
	end;					/* do while */

EXIT:	return;
     end main;
     end xforum_get_str_;




		    xforum_help_.pl1                09/13/88  1325.8rew 09/13/88  1257.6      197982



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



/****^  HISTORY COMMENTS:
  1) change(85-01-08,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Removed the function_key_data_ptr and the
     handle_interactive_messages arguments from the calling sequence of
     the get_help entry.  The function_key_data_ptr is obtained from
     xforum_user_profile.  The value of handle_interactive_messages was
     just passed to other routines and goes away.  Changed calling
     sequence of xforum_window_mgr$menu_get_choice to remove the
     arguments function_key_data_ptr and handle_interactive_messages.
     Added calls to xforum_user_profile$set_function_key_data_ptr both
     before the call to menu_get_choice to set the special
     function_key_data_ptr and after to reset it.  Also changed calling
     sequence of xforum_dyn_menu_$get_choice to remove the
     function_key_data_ptr.
     
     85-01-10 Davids: Modified call to
     xforum_user_profile$set_function_key_data_ptr so that it returns a
     bit (1) value.  The value is not used since its defined to be "1"b
     but it is returned.
     
     85-02-13 Davids: Changed calling sequence of xforum_help_line_$change
     to include the new F3_message argument.
     
     85-02-14 Davids: Removed the general_help_menu internal proc and
     replaced it with a call to xforum_help_menus$general_help_topics.
     Modified the display entry so that if the menu name is "Topics"
     It will not ouput the line saying that ?? can be used to get a menu
     of general help topics and if ?? is typed it will beep. The code to
     created a new function_key_data structure was left intact so that
     the checks for input Fkey < highest would not have to be changed.
     
     85-06-25 Davids: Added declarations for all the variables and updated
     the header comments. Also removed the menu_dcls include file which was
     not being used.
  2) change(86-01-21,LJAdams), approve(86-01-21,MCR7327),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed Vhelp_args_1 to new version Vhelp_args_2.  Made hard coded help
     search directories a cds segment.  Added ssu_ (create/destroy) so
     subsystem calls to help_ work properly.
  3) change(86-05-09,LJAdams), approve(86-05-14,MCR7416),
     audit(86-05-19,Gilcrease), install(86-06-12,MR12.0-1074):
     Added err_$no_ssu entry point to avoid trying to destroy ssu invocation
     before it had actually been invoked.
  4) change(87-08-20,LJAdams), approve(87-09-03,MCR7766),
     audit(88-08-14,GDixon), install(88-09-13,MR12.2-1109):
     Changed Vhelp_args_2 to Vhelp_args_3.  Initialize xh_help_args_ptr to
     null and use it with help_$init rather then Phelp_args.  Removed the
     cleanup handler (xforum will handle cleanup).
                                                   END HISTORY COMMENTS */


xforum_help_: proc;

/*
   BEGIN DESCRIPTION

   function: 
      This routine contains the entry points used by xforum to display
      help to the user.

   description of entry points:
      xforum_help_:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error
         condition is signaled with an "internal programming error" error
         message.

      init:
         input:
         output:
         This entry is used to initialize the help_ system. The help_args
         structure is allocated by calling help_$init and the pointer saved in 
         internal static. The values in the help_args structure are also set.
         The xforum info directory and help file suffix are set in this entry.
         The flags in this structure also control when help_ will ask the user
         if he wants more help. The flag is set so that the user always gets
         all the help without being asked if he wanst more help. Hew can of
         course abort the help at the video system more prompt.

      get_help:
         input:   ptr                 pointer to menu structure for displayed
                                      menu
                  char (*)            name of the menu
                  (*) char (*) var    the choices that are on the menu in the
                                      same order as they appear on the menu
                  ptr                 pointer to the spy structure
                  ptr                 pointer to the xforum area for allocating
                                      stuff
         output:
         This entry prompts the user to enter the menu option or function key
         that he wants help with. The response is obtained via a call
         to xforum_window_mgr$menu_get_choice. The response is interpreted and
         a call to display_internal with the appropriate info file name and
         section within the info file is made. Help for all menu options is
         contained in the same info seg. The section names are obtained by
         taking the text of the menu option and changing all the spaces to
         underscore characters. Help for all the function keys is also in a
         single info seg. A function key response may have 2 different function
         key numbers. The first set 1-8 correspond to either function keys
         or the escape sequences ESCx where x is a lower case letter (or ?).
         The second set 9-15 correspond to ESCx where x is an upper case
         letter. Note that the second set is valid only if the user is using
         escape sequences. This means that a function key user cannot press F10
         and get a help message. There is no upper case equivalent for the
         first escape sequence ESC?. Before making the call to get the user's
         response this entry creates a special version of the function key data
         structure. This special version has an extra function key character
         sequence, i.e. ??. This is the highest function key sequence and is
         used so that the user can request the general help topics menu without
         having to do something special - like pressing the RETURN key. The
         space used to hold this special function key data is allocated in the
         xforum_system_free_area and is freed right before the entry returns.
         A cleanup handler is set up to be sure that the space is freed in case
         a cleanup is done. The user's response is recorded in the spyt
         structure. A quit handler is set up so that the user can exit this
         help mode by pressing QUIT. This fact will also be recorded in the spy
         structure. After the help is displayed the entry returns to the
         caller. The bottom window is not cleared so that the user can continue
         to read it.

      display:
         input:   char (*)            name of info seg
                  char (*)            section within info seg
         output:
         Given the name of an info segment and a section within that info
         segment this entry calls the internal proc display_internal to display
         the help associated with that info segment and section.

      term:
         input:
         output:
         This entry is used to terminate the help system. help_$term is
         called to free the help_args structure and do other internal things.
 
   description of internal procs:
      display_internal: Given the name of an info segment and the section
      within the info segment this will call help_ to display the associated
      information. The segment and section names are passed to help_ by loading
      the value and info_name elements of the help_args structure. A reset_more
      is done after the display.

      collect_spy_data: Similar to all the other collect_spy_data procedures.
      See the xforum module. Note that this procedure is duplicated so as to
      save the expense of an external call for a commonly executed, very short
      program, whose output is used only durning development or special site
      exposure.

      error: Similar to all the other error procedures. It records in an
      internal static structure the details of an error and then signals the
      xforum_fatal_error condition.

   known bugs:

   notes:

   history:
      84-01-?? Barker: written, based on xmail_display_help.

      84-08-16 Davids: converted to standard format. Replaced the get_choice
      entry, which required that the user enter the option he wants help with 
      in the form of a prompt response, with the get_help entry which takes a
      standard menu input (or ?? for general help). Also added the code for
      displaying the general help menu. This module now also controls the
      output of the help file. Before it just returned the users response to
      xforum.

      84-08-17 Davids: Added code to general_help_menu so that it queries the
      user after displaying help. The user can answer yes and get the general
      help menu again or answer no and return to the top menu.

      84-09-03 Davids: Removed reference to gh_code. It was never being set
      but was being tested - this obviously caused problems. It was not needed
      so it was deleted.

      84-09-17 Davids: Added code for processing upper case escapse sequences.

      84-09-28 Davids: Replaced call to xforum_status_$update_usage and
      redisplay_usage with a call to xforum_help_line$change.

      84-10-11 Davids: Changed display_internal to call com_err_$supress_name 
      instead of error if an error is returned by help_. A bad info file should
      not cause xforum to die.

      84-10-17 Davids: Added code to the get_help entry so that function
      key choices 9 through 15 are used only if the user is using escape
      sequences. "function keys" 9 - 15 are really upper case escape sequences.
      Also the prompt now indicates either function keys or escape sequences
      depending on what the user is using.

      84-10-18 Davids: Added code so that the title "General Help Topics"
      appears when the general help menu is displayed. The title is overwritten
      on the last line of the main menu so that it appears padded with dashes.

      84-11-06 Davids: Changed references to xforum_help_line to
      xforum_help_line_.

      84-11-13 Davids: Auditing changes: Removed unnecessary rtrims from the
      call to collect_spy_data in general_help_menu (the ltrims were left).
   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     ioa_		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     window_$bell	 entry (ptr, fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_help_menus$general_help_topics entry (ptr, ptr, char (*));
	dcl     xforum_user_profile$get_function_key_data_ptr entry () returns (ptr);
	dcl     xforum_user_profile$get_use_function_keys entry () returns (bit (1));
	dcl     xforum_user_profile$set_function_key_data_ptr entry (ptr) returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$menu_get_choice entry (ptr, bit (1) aligned, fixed bin);

/* CONDITIONS */

	dcl     (
	        cleanup,
	        quit
	        )			 condition;

/* INTERNAL STATIC */

	dcl     xh_help_args_ptr	 ptr internal static init(null);
						/* pointer to help_args structure created by call to help_$init */
	dcl     01 xh_xforum_error_info like xforum_error_info internal static;
						/* used to record error info to be output to user */

/* CONSTANTS */

	dcl     (
	        xh_SEARCH_LIST	 char (4) init ("info"), /* default search rules */
	        xh_HELP_SUFFIX	 char (10) init ("info"), /* segments must have a suffix of info */
	        xh_ME_CHAR		 char (12) init ("xforum_help_")
	        )			 int static options (constant);

/* BUILTINS */

	dcl     (
	        addr,
	        char,
	        dim,
	        ltrim,
	        null,
	        rtrim,
	        translate
	        )			 builtin;

/* BASED */

/* INCLUDES */
%page;
%include function_key_data;
%page;
%include help_args_;
%page;
%include xforum_error_info;
%page;
%include xforum_spy;
%page;
%include xforum_windows;

	call error (0, "Internal programming error - xforum_help_$xforum_help_ called.");

init: entry;

/* AUTOMATIC */

%include xforum_data_;

	dcl     i_code		 fixed bin (35);	/* standard error code			*/
	
          Phelp_args = null;
          xh_help_args_ptr = null;

	call help_$init (xh_ME_CHAR, xh_SEARCH_LIST, "", Vhelp_args_3, xh_help_args_ptr, i_code);
	if i_code ^= 0
	then call error_no_ssu (i_code, "Could not initiate help_");

          Phelp_args = xh_help_args_ptr;           
	help_args.Nsearch_dirs = dim(xforum_HELP_DIRS.path, 1);
	help_args.search_dirs = xforum_HELP_DIRS.path;
	help_args.Sctl.all = "1"b;			/* No questions asked */
	help_args.Npaths = 1;
	help_args.path (1).S.pn_ctl_arg = "0"b;
	help_args.path (1).S.info_name_not_starname = "0"b;

	return;

get_help: entry (gh_menu_ptr, gh_menu_name, gh_menu_choices, gh_spy_ptr, gh_xforum_system_area_ptr);

/* PARAMETERS */

	dcl     gh_menu_ptr		 ptr;		/* (input) pointer to menu structure for displayed menu */
	dcl     gh_menu_name	 char (*);	/* (input) name of the menu */
	dcl     gh_menu_choices	 (*) char (*) var;	/* (input) the choices that are on the menu - */
						/*         in the same order as they appear on the menu */
	dcl     gh_spy_ptr		 ptr;		/* (input) pointer to the spy structure */
	dcl     gh_xforum_system_area_ptr ptr;		/* (input) pointer to the xforum area for allocating stuff */

/* INTERNAL AUTOMATIC */

	dcl     gh_fkey_flag	 bit (1) aligned;	/* "1"b implies user wants help with a function key */
	dcl     gh_choice		 fixed bin;	/* indicates choice or fkey user wants help with */
	dcl     gh_highest		 fixed bin;	/* number of function keys in the */
						/* special function key data structure */
	dcl     gh_special_fkey_data_ptr ptr;		/* pointer to the special function key data structure */
	dcl     gh_special_fkey_data_sequence_seq_len fixed bin; /* total number of chars in */
						/* the special function key data structure */
	dcl     gh_special_fkey_seqs_ptr ptr;		/* pointer to the string containing */
						/* the special function key chars */
	dcl     gh_unusedb1		 bit (1);		/* unused output from procedure call */
	dcl     gh_using_esc_seq	 bit (1);		/* "1" imples that the user is using */
						/* escape sequences and not function keys */

/* BASED */

	dcl     gh_special_fkey_seqs	 char (gh_special_fkey_data_sequence_seq_len) based (gh_special_fkey_seqs_ptr);
						/* place to store the special function key characters */

	gh_special_fkey_data_ptr = null ();
	gh_special_fkey_seqs_ptr = null ();
	function_key_data_ptr = xforum_user_profile$get_function_key_data_ptr ();
	spy_ptr = gh_spy_ptr;

	on cleanup
	     begin;
		if gh_special_fkey_data_ptr ^= null ()
		then free gh_special_fkey_data_ptr -> function_key_data.sequence.seq_ptr -> gh_special_fkey_seqs;

		if gh_special_fkey_seqs_ptr ^= null ()
		then free gh_special_fkey_data_ptr -> function_key_data;
	     end;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call collect_spy_data (SPY_AT_2, "QUIT");
		gh_unusedb1 = xforum_user_profile$set_function_key_data_ptr (function_key_data_ptr);
		goto exit_get_help;
	     end;

	gh_using_esc_seq = ^xforum_user_profile$get_use_function_keys ();

	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	if gh_using_esc_seq
	then call ioa_ ("Press the option or type the escape sequence for which you want help");
	else call ioa_ ("Press the option or function key for which you want help");
	if gh_menu_name ^= "Topics"
	then call ioa_ ("   (or type ?? for a menu of general help topics):");

	function_key_data_highest = function_key_data_ptr -> function_key_data.highest + 1;
	gh_highest = function_key_data_highest;
	allocate function_key_data set (gh_special_fkey_data_ptr);
	gh_special_fkey_data_ptr -> function_key_data.highest = gh_highest - 1;
	gh_special_fkey_data_ptr -> function_key_data = function_key_data_ptr -> function_key_data;
	gh_special_fkey_data_ptr -> function_key_data.highest = gh_highest;

	gh_special_fkey_data_ptr -> function_key_data.sequence.seq_len = gh_special_fkey_data_ptr -> function_key_data.sequence.seq_len + 2;
	gh_special_fkey_data_sequence_seq_len = gh_special_fkey_data_ptr -> function_key_data.sequence.seq_len;
	allocate gh_special_fkey_seqs;

	gh_special_fkey_seqs = function_key_seqs || "??";
	gh_special_fkey_data_ptr -> function_key_data.function_keys (gh_highest, KEY_PLAIN).sequence_index = gh_special_fkey_data_sequence_seq_len - 1;
	gh_special_fkey_data_ptr -> function_key_data.function_keys.sequence_length = 2;
	gh_special_fkey_data_ptr -> function_key_data.sequence.seq_ptr = gh_special_fkey_seqs_ptr;

	gh_unusedb1 = xforum_user_profile$set_function_key_data_ptr (gh_special_fkey_data_ptr);
	call xforum_window_mgr$menu_get_choice (gh_menu_ptr, gh_fkey_flag, gh_choice);
	gh_unusedb1 = xforum_user_profile$set_function_key_data_ptr (function_key_data_ptr);

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	if gh_fkey_flag
	then do;
	     if gh_choice < gh_highest
	     then call collect_spy_data (SPY_AT_2, "F" || rtrim (ltrim (char (gh_choice))));
	     else
		if gh_menu_name ^= "Topics"
	     then call collect_spy_data (SPY_AT_2, "general help");
	end;
	else call collect_spy_data (SPY_AT_2, rtrim (ltrim (char (gh_choice))));

	if gh_fkey_flag
	then do;
	     if gh_choice = gh_highest
	     then do;
		if gh_menu_name ^= "Topics"
		then call xforum_help_menus$general_help_topics (spy_ptr, gh_xforum_system_area_ptr, gh_menu_name);
		else call window_$bell (xforum_windows.bottom.iocb, (0));
	     end;
	     else
		if gh_choice = 1
	     then call display_internal ("xforum_function_keys", "F1");
	     else
		if gh_choice = 2 | (gh_choice = 9 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F2");
	     else
		if gh_choice = 3 | (gh_choice = 10 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F3");
	     else
		if gh_choice = 4 | (gh_choice = 11 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F4");
	     else
		if gh_choice = 5 | (gh_choice = 12 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F5");
	     else
		if gh_choice = 6 | (gh_choice = 13 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F6");
	     else
		if gh_choice = 7 | (gh_choice = 14 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F7");
	     else
		if gh_choice = 8 | (gh_choice = 15 & gh_using_esc_seq)
	     then call display_internal ("xforum_function_keys", "F8");
	     else call ioa_ ("Function key F^d has no function within Executive Forum", gh_choice);
	end;
	else call display_internal ("xforum_menu_option", translate (gh_menu_choices (gh_choice), "_", " "));

exit_get_help:

	if gh_special_fkey_data_ptr ^= null ()
	then free gh_special_fkey_data_ptr -> function_key_data.sequence.seq_ptr -> gh_special_fkey_seqs;

	if gh_special_fkey_seqs_ptr ^= null ()
	then free gh_special_fkey_data_ptr -> function_key_data;

	return;

display: entry (d_seg_name, d_info_name);

/* PARAMETERS */

	dcl     d_seg_name		 char (*);	/* (input) name of info seg */
	dcl     d_info_name		 char (*);	/* (input) section within info seg */





	call display_internal (d_seg_name, d_info_name);

	return;

term: entry;

          call help_$term ("xforum", xh_help_args_ptr, (0));

	return;

display_internal: proc (di_seg_name, di_info_name);

/* PARAMETERS */

	dcl     di_seg_name		 char (*);	/* (input) name of info seg */
	dcl     di_info_name	 char (*);	/* (input) section within info seg */

/* AUTOMATIC */

	dcl     di_code		 fixed bin (35);	/* (standard error code */





	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	Phelp_args = xh_help_args_ptr;		/* recover it */

	help_args.path (1).value = di_seg_name;
	help_args.path (1).info_name = di_info_name;

	call help_ (xh_ME_CHAR, Phelp_args, xh_HELP_SUFFIX, (0), di_code);
	if di_code ^= 0
	then call com_err_$suppress_name (di_code, "Could not display the help text");

	call iox_$control (xforum_windows.bottom.iocb, "reset_more", null, (0));

	return;

     end display_internal;

collect_spy_data: proc (csd_where, csd_response);

	dcl     csd_where		 fixed bin;	/* (input) location response was collected */
	dcl     csd_response	 char (*);	/* (input) user's response */





	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

error: proc (e_code, e_reason);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with the error */
	dcl     e_reason		 char (*);	/* (input) message to be output to user */


          call help_$term ("xforum", Phelp_args, (0));

error_no_ssu: entry (e_code, e_reason);
	
	xh_xforum_error_info.name = xh_ME_CHAR;
	xh_xforum_error_info.entry = "";
	xh_xforum_error_info.doing = "";
	xh_xforum_error_info.code = e_code;
	xh_xforum_error_info.reason = e_reason;

	call signal_ ("xforum_fatal_error", null (), addr (xh_xforum_error_info), null ());

     end error;

     end xforum_help_;




		    xforum_help_line_.pl1           04/25/86  0814.5rew 04/24/86  1513.4      156780



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


/****^  HISTORY COMMENTS:
  1) change(85-01-10,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed the text for F2/Ef from "Top Menu" to "Return to Executive
     Forum menu"
     
     85-01-21 Davids: Modified so that the help line uses "ESC" for the
     escape key instead of "E".
     
     85-02-13 Davids: Modified so that the change and push entries take
     a F3_message argument, i.e.  the message associated with the F3 or
     ESCp key.  This allows specialized messages for that key.  Also
     changed the stack size used to store "pushed" help lines from 1 to
     10.
     
     85-02-14 Davids: Added the init entry to reset the index in the stack.
     
     85-02-19 Davids: Changed the declaration of flags from bit (8)
     unaligned to bit (8) aligned, except for ci_flags_ovly which must
     remain unaligned since its an array of bit (1)s.  Also added an
     rtrim around ci_F3_message so trailing spaces are not part of the
     help line.
     
     85-06-25 Davids: Changed the push_general_message_only entry to
     change_general_message_only.  This entry is called only by the
     emacs extension.  The pushs were not being poped and because of
     the structure of the extension it would be very difficult to add
     the pops.  In addition the code calling the extension just changes
     the current help line after the extension returns so the last push
     shouldn't be poped anyway.  It seemed like the simplest thing to
     do was to only do changes within the extension.
     
     85-06-26 Davids: Commented all variables and added header comments.
                                                   END HISTORY COMMENTS */


xforum_help_line_: proc;

/*
   BEGIN DESCRIPTION

   function
      This module manages the help line. There are entries for changing the
      help line and for redisplaying it. There is also a stack for maintaining
      the data that is used to create the help line and entries for pushing and
      poping the stack elements. A help line is made up of:
           o  A bit (8) string, 1 bit for each function key which indicates
              if an explaination of the function key should be displayed on
              the help line.
           o  A string containing the explaination for function key 3 since
              the meaning of function key 3 varies from menu to menu
           o  A string containing the explaination of the BREAK key
           o  A string containing a general information message
      The currently displayed help line is NOT on the stack. Whenever a help
      line is created the user's profile is queried to determine if he is
      using function keys or escape sequences. The appropriate labels are
      output on the help line. Since the user can change from function keys to
      escape sequences or escape sequences to function keys it is not possible
      to simply store the text string that makes up the help line in the stack
      and then redisplay that string. Ecah time the help line is displayed it
      must be built from scratch to allow for changes in the users
      function key/escape sequence usage.

   description of entry points:
      xforum_help_line_:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error
         condition will be signaled with an "internal programming error" error
         message.

      init:
         input:
         output:
         This entry sets the counter for the current top of the help line
         stack to 0.

      change:
         input:   bit (8) aligned     flags indicating what function keys
                                      meanings are to be displayed "1"b implies
                                      that the key will be displayed
                  char (*)            special text for the third function key
                  char (*)            special text for the BREAK key
                  char (*)            special general message not associated
                                      with any key
         output:
         This entry changes the current help line based on the input
         parameters. The old help line is not saved on the stack. The new help
         line is output via change_i.

      push:
         input:   bit (8) aligned     flags indicating what function keys
                                      meanings are to be displayed "1"b implies
                                      that the key will be displayed
                  char (*)            special text for the third function key
                  char (*)            special text for the BREAK key
                  char (*)            special general message not associated
                                      with any key
         output:
         This entry pushes the old set of flags, F3, BREAK and general messages
         onto the help line stack and creates a new help line from the input
         parameters. The new help line is output via change_i. An internal
         programming error is generated if the push overflows the stack.

      change_general_message-only:
         input:   char (*)            special general message not associated
                                      with any key
         output:
         This entry changes the general message displayed on the help line.
         The general message is not saved on the stack and the BREAK message
         and flags are not changed. The help line is redisplayed via a call
         to change_i.

      pop:
         input:
         output:
         This entry changes the help line to the last help line saved via a
         push. It also removes that help line from the help line stack. The
         help line is redisplayed via a call to change_i. If there are no help
         lines on the stack and internal programming error is generated.

      redisplay:
         input:
         output:
         This entry causes the help line to be redisplayed. It does this by
         calling the internal procedure change_i with the current values of the
         flags, F3_message, BREAK_message, and general_message. Note that
         beacuse the help line is actually rebuilt it will reflect the users
         current use of function keys or escape sequences.

   description of internal procedures:
      change_i: This procedure builds and displays the help line. The help line
      is initially set to "Press  ". The function key text associated with each
      function key that has its flag set is then concatinated onto the end of
      the help line. After all the function key text has been appended the
      BREAK message is appended. If after the BREAK message is appended the
      help line still only contains "Press  " it means that no function key or
      BREAK messages are to be on the help line. If that is the case the help
      line is set to "" and then the general message is appended. Once the help
      line is built it is output via window_display_. window_display_ is an
      undocumented entry point that takes a character array which is an exact
      overlay of the window and then makes the window match the overlay. A
      window_sync_ is done after the window_display_ so that the display takes
      place immediately instead of being buffered.

      error: Similar to all the other error procedures. It records in an
      internal static structure the details of an error and then signals the
      xforum_fatal_error condition.

   known bugs:

   notes:

   history:
      84-09-28 Davids: written

      84-10-01 Davids: Added the push_general_message_only entry. This is so
      that the emacs extension can push help line messages.

      84-11-06 Davids: Since this is an externally known subroutine it must
      end with a "_" so its name was changed.
   END DESCRIPTION
*/

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     signal_		 entry () options (variable);
	dcl     xforum_user_profile$get_use_function_keys entry () returns (bit (1));
	dcl     window_display_	 entry (ptr, (*) char (*), fixed bin (35));
	dcl     window_$sync	 entry (ptr, fixed bin (35));

/* CONDITIONS */

/* INTERNAL STATIC */

	dcl     (xhl_current_F3_message char (80) init (""),
						/* currently displayed special text for the third function key */
	        xhl_current_break_message char (80) init (""),
						/* currently displayed special text for the BREAK key */
	        xhl_current_general_message char (80) init (""),
						/* currently displayed special general */
						/* message not associated with any key */
	        xhl_current_flags	 bit (8) aligned init ("00000000"b),
						/* current set of flags controlling */
						/* what function keys are displayed */
						/* "1"b implies that the key will be displayed */
	        xhl_old_F3_message	 (10) char (80) init ("", "", "", "", "", "", "", "", "", ""),
						/* acts as stack for holding previous special text */
	        xhl_old_break_message	 (10) char (80) init ("", "", "", "", "", "", "", "", "", ""),
						/* acts as stack for holding previous special text */
	        xhl_old_general_message (10) char (80) init ("", "", "", "", "", "", "", "", "", ""),
						/* acts as stack for holding previous special text */
	        xhl_old_flags	 (10) bit (8) aligned init ("0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b,
				 "0"b, "0"b, "0"b),
						/* acts as stack for holding previous flags */
	        xhl_old_index	 fixed bin init (0)
						/* index in array of the top stack element */
	        )			 internal static;
	dcl     01 xhl_xforum_error_info like xforum_error_info internal static;
						/* used to record error infor to be output to the user */

/* CONSTANTS */

	dcl     xhl_MAX_INDEX	 fixed bin init (10) internal static options (constant);
						/* max size of the array for storing previous help line data */

/* BUILTINS */

	dcl     (
	        addr,
	        null,
	        rtrim
	        )			 builtin;

/* BASED */

/* INCLUDE FILES */
%page;
%include xforum_error_info;
%page;
%include xforum_windows;

	call error (0, "Internal programming error - xforum_help_line_$xforum_help_line_ called.");

init: entry;

	xhl_old_index = 0;

	return;

change: entry (c_flags, c_F3_message, c_break_message, c_general_message);

/* PARAMETERS */

	dcl     c_flags		 bit (8) aligned;	/* (input) flags indicating what function keys */
						/*         meanings are to be displayed */
						/*         "1"b implies that the key will be displayed */
	dcl     c_F3_message	 char (*);	/* (input) special text for the third function key */
	dcl     c_break_message	 char (*);	/* (input) special text for the BREAK key */
	dcl     c_general_message	 char (*);	/* (input) special general message not associated with any key */





	xhl_current_flags = c_flags;
	xhl_current_F3_message = c_F3_message;
	xhl_current_break_message = c_break_message;
	xhl_current_general_message = c_general_message;

	call change_i (xhl_current_flags, xhl_current_F3_message,
	     xhl_current_break_message, xhl_current_general_message);

	return;

push: entry (pu_flags, pu_F3_message, pu_break_message, pu_general_message);

/* PARAMETERS */

	dcl     pu_flags		 bit (8) aligned;	/* (input) flags indicating what function keys */
						/*         meanings are to be displayed */
						/*         "1"b implies that the key will be displayed */
	dcl     pu_F3_message	 char (*);	/* (input) special text for the third function key */
	dcl     pu_break_message	 char (*);	/* (input) special text for the BREAK key */
	dcl     pu_general_message	 char (*);	/* (input) special general message not associated with any key */





	xhl_old_index = xhl_old_index + 1;
	if xhl_old_index > xhl_MAX_INDEX
	then call error (0, "Internal programming error - help line stack overflow.");

	xhl_old_flags (xhl_old_index) = xhl_current_flags;
	xhl_old_F3_message (xhl_old_index) = xhl_current_F3_message;
	xhl_old_break_message (xhl_old_index) = xhl_current_break_message;
	xhl_old_general_message (xhl_old_index) = xhl_current_general_message;

	xhl_current_flags = pu_flags;
	xhl_current_F3_message = pu_F3_message;
	xhl_current_break_message = pu_break_message;
	xhl_current_general_message = pu_general_message;

	call change_i (xhl_current_flags, xhl_current_F3_message,
	     xhl_current_break_message, xhl_current_general_message);

	return;

change_general_message_only: entry (cgmo_general_message);

/* PARAMETERS */

	dcl     cgmo_general_message	 char (*);	/* (input) special general message not associated with any key */





	xhl_current_general_message = cgmo_general_message;

	call change_i (xhl_current_flags, xhl_current_F3_message,
	     xhl_current_break_message, xhl_current_general_message);

	return;

pop: entry;

	if xhl_old_index = 0
	then call error (0, "Internal programming error - help line stack underflow.");

	xhl_current_flags = xhl_old_flags (xhl_old_index);
	xhl_current_F3_message = xhl_old_F3_message (xhl_old_index);
	xhl_current_break_message = xhl_old_break_message (xhl_old_index);
	xhl_current_general_message = xhl_old_general_message (xhl_old_index);

	xhl_old_index = xhl_old_index - 1;

	call change_i (xhl_current_flags, xhl_current_F3_message,
	     xhl_current_break_message, xhl_current_general_message);

	return;

redisplay: entry;

	call change_i (xhl_current_flags, xhl_current_F3_message,
	     xhl_current_break_message, xhl_current_general_message);

	return;

change_i: proc (ci_flags, ci_F3_message, ci_break_message, ci_general_message);

/* PARAMETERS */

	dcl     ci_flags		 bit (8) aligned;	/* (input) flags indicating what function keys */
						/*         meanings are to be displayed */
						/*          "1"b implies that the key will be displayed */
	dcl     ci_F3_message	 char (*);	/* (input) special text for the third function key */
	dcl     ci_break_message	 char (*);	/* (input) special text for the BREAK key */
	dcl     ci_general_message	 char (*);	/* (input) special general message not associated with any key */

/* INTERNAL AUTOMATIC */

	dcl     ci_code		 fixed bin (35);	/* standard error code */
	dcl     ci_flags_ovly_ptr	 ptr;		/* pointer to ci_flags bit string */
	dcl     ci_i		 fixed bin;	/* loop index for checking each flag */
	dcl     ci_index		 fixed bin;	/* index into string array for the function key labels */
						/* 1 implies function keys with labels of Fn */
						/* 2 implies escape sequences with labels of ESCx */
						/* based on users current profile settings */
	dcl     ci_help_line	 char (80) varying; /* string containing the text of the help line */
	dcl     ci_window_image	 (1) char (xforum_windows.help_line.extent.width);
						/* text of the help line in format useable by window_display_ */

/* CONSTANTS */

	dcl     ci_TEXT		 (2, 8) char (37) varying init (
				 "F1:Help", "F2:Return to Executive Forum menu", "F3:", "F4:Exit Executive Forum",
				 "F5:Redisplay Screen", "F6:Previous Menu", "F7:Next Menu", "",
				 "ESC?:Help", "ESCf:Return to Executive Forum menu", "ESCp:",
				 "ESCq:Exit Executive Forum", "ESCr:Redisplay Screen", "ESCl:Previous Menu",
				 "ESCh:Next Menu", "")
				 internal static options (constant);
						/* strings for labeling the function keys and escape sequences */

/* BASED */

	dcl     ci_flags_ovly	 (8) bit (1) unaligned based (ci_flags_ovly_ptr);
						/* same as ci_flags but as an array */
						/* for easy reference to each bit */

	ci_flags_ovly_ptr = addr (ci_flags);

	if xforum_user_profile$get_use_function_keys ()
	then ci_index = 1;
	else ci_index = 2;

	ci_help_line = "Press";

	do ci_i = 1 to 8;
	     if ci_i ^= 3 & ci_flags_ovly (ci_i)
	     then ci_help_line = ci_help_line || "  " || ci_TEXT (ci_index, ci_i);
	     else
		if ci_i = 3 & ci_F3_message ^= ""
	     then ci_help_line = ci_help_line || "  " || ci_TEXT (ci_index, 3) || rtrim (ci_F3_message);
	end;

	if ci_break_message ^= ""
	then ci_help_line = ci_help_line || "  BREAK:" || ci_break_message;

	if rtrim (ci_help_line) = "Press"
	then ci_help_line = "";

	if ci_general_message ^= ""
	then ci_help_line = ci_help_line || ci_general_message;


	ci_window_image (1) = ci_help_line;
	call window_display_ (xforum_windows.help_line.iocb, ci_window_image, ci_code);
	if ci_code ^= 0
	then call error (ci_code, "Cannot update the help line");
	call window_$sync (xforum_windows.help_line.iocb, ci_code);
	if ci_code ^= 0
	then call error (ci_code, "Cannot update the help line");

	return;

     end change_i;

error: proc (e_code, e_message);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with the error */
	dcl     e_message		 char (*);	/* (input) message to be output to user */





	xhl_xforum_error_info.name = "xforum_help_line_";
	xhl_xforum_error_info.entry = "";
	xhl_xforum_error_info.doing = "";
	xhl_xforum_error_info.code = e_code;
	xhl_xforum_error_info.reason = e_message;

	call signal_ ("xforum_fatal_error", null (), addr (xhl_xforum_error_info), null ());

     end error;

     end xforum_help_line_;




		    xforum_help_menus.pl1           04/25/86  0819.5rew 04/24/86  1513.5      146484



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


/****^  HISTORY COMMENTS:
  1) change(85-02-06,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Extracted from the xforum_main_options module.
     
     85-02-13 Davids: Changed name to xforum_getting_started_menu
     
     85-02-13 Davids: Changed calling sequence of
     xforum_help_line_$push to include the new F3_message argument.
     
     85-02-14 Davids: Rearranged the code to add the
     general_help_topics and getting_started entry points and the do_it
     internal proc.  The do_it proc is basically the original code with
     changes to handle both menus.  Added ability to use F2 and F3 to
     exit the menu.
     
     85-02-26 Davids: Replaced the calls to ioa_ to output the getting
     started introduction with a call to xforum_help_$display.  The
     introductory text has been added to the xforum_getting_started
     info file.
     
     85-04-17 Davids: Added the text " g:Return to XXX menu" to the
     help line where XXX is the name of the previous menu.  Its the
     same text as the menu option.
     
     85-06-27 Davids: Commented declarations and updated header comments.
                                                   END HISTORY COMMENTS */

xforum_help_menus: proc;

/*
   BEGIN DESCRIPTION

   function:
      This module manages the getting_started and general_help_topics menus.
      It displays them, processes user choices, and destroys them when done.

   description of entry points:
      xforum_help_menus:
         input:
         output:
         It is an error to call the main entry point. The xforum_fatal_error
         condition will be signaled with an "internal programming error" error
         message.

      getting_started:
         input:   ptr                  pointer to spy structure
                  ptr                  pointer to area xforum uses to allocate
                                       things in
         output:
         This entry fills in the choice array with the getting_started menu
         choices and then calls the internal proc do_it. The prameters of
         do_it define the rest of the info to define the getting_started menu.
         There is only one possible menu that can be used to get to the
         getting_started menu so there is no need to pass this entry the
         name of the previous menu.

      general_help_topics:
         input:   ptr                 pointer to spy structure
                  ptr                 pointer to area xforum uses to allocate
                                      things in
                  char (*)            name of menu that is currently displayed
         output:
         This entry fills in the choice array with the general_help_topics menu
         choices and then calls the internal proc do_it. The prameters of
         do_it define the rest of the info to define the general_help_topics
         menu.

   description of internal procedures:
      do_it: This procedure creates the menu, updates the contents of the
      status window with the menu title, displays the menu and pushes a new
      help line. If the menu being displayed is the getting started menu
      is also displays the Xforum introduction below the menu.  It then
      gets user choices, displays the appropriate help text, and destroys the
      menu and pops the help line before returning. The user can exit via the
      last menu option or via the first or third function keys. The help
      function is available as are quit, redisplay and multics mode (if the
      user's profile allows it). A quit condition handler is set up to trap
      quits and redisplay the menu. An xforum_redisplay_menu condition is
      set up to actually redisplay the menu. The user's responses are recorded
      in the spy structure (including quits).

      collect_spy_data: Similar to all the other collect_spy_data procedures.
      See the xforum module. Note that this procedure is duplicated so as to
      save the expense of an external call for a commonly executed, very short
      program, whose output is used only during development or special site
      exposure.

      error: Similar to all other error procedures. It records in an internal
      static structure the details of an error and then signals the
      xforum_fatal_error condition.
END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     signal_		 entry () options (variable);
	dcl     window_$bell	 entry (ptr, fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_create_menu_	 entry ((*) char (*) var, ptr, ptr, fixed bin (35));
	dcl     xforum_help_$display	 entry (char (*), char (*));
	dcl     xforum_help_$get_help	 entry (ptr, char (*), (*) char (*) var, ptr, ptr);
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_help_line_$push entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_multics_mode	 entry (fixed bin);
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     xforum_status_$update_banner entry (char (*));
	dcl     xforum_status_$update_title entry (char (*));
	dcl     xforum_user_profile$get_multics_mode entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$menu_display entry (ptr);
	dcl     xforum_window_mgr$menu_get_choice entry (ptr, bit (1) aligned, fixed bin);
	dcl     xforum_window_mgr$resynch_windows entry (fixed bin, bit (1));

/* CONDITIONS */

	dcl     exit_executive_forum	 condition;
	dcl     quit		 condition;
	dcl     xforum_redisplay_menu	 condition;

/* INTERNAL AUTOMATIC */

	dcl     xhm_choices		 (16) char (40) varying;
						/* array to contain the text of the */
						/* menu options. Both menus have 16 options */

/* INTERNAL STATIC */

	dcl     01 xhm_xforum_error_info like xforum_error_info;
						/* used to record error info to be output to the user */

/* CONSTANTS */

	dcl     xhm_MENU_HEIGHT	 fixed bin init (9) internal static options (constant);
						/* number of lines required for the display of both menus */
						/* eight for options, 1 for line of dashes at bottom */

/* BUILTINS */

	dcl     addr		 builtin;
	dcl     char		 builtin;
	dcl     ltrim		 builtin;
	dcl     null		 builtin;
	dcl     rtrim		 builtin;
	dcl     translate		 builtin;

/* INCLUDE FILES */

%include menu_dcls;
%page;
%include xforum_error_info;
%page;
%include xforum_spy;
%page;
%include xforum_windows;

	call error (0, "Internal programming error - xforum_help_menus$xforum_help_menus called.");

getting_started: entry (gs_spy_ptr, gs_xforum_system_area_ptr);

/* PARAMETERS */

	dcl     gs_spy_ptr		 ptr;		/* (input) pointer to spy structure */
	dcl     gs_xforum_system_area_ptr ptr;		/* (input) pointer to area xforum uses to allocate things in */





	xhm_choices (1) = "Getting To Know Your Terminal";
	xhm_choices (2) = "How To Exit Executive Forum";
	xhm_choices (3) = "How To Get Help";
	xhm_choices (4) = "Responding To Prompts";
	xhm_choices (5) = "How To Correct Typos";
	xhm_choices (6) = "Getting Around The Menus";
	xhm_choices (7) = "The 2 Attending Menus";
	xhm_choices (8) = "What Are Eligible Meetings";
	xhm_choices (9) = "What Are Attended Meetings";
	xhm_choices (10) = "What Are Changed Meetings";
	xhm_choices (11) = "What Is The Current Comment";
	xhm_choices (12) = "Selecting The Current Comment";
	xhm_choices (13) = "Entering Comments";
	xhm_choices (14) = "Personalizing The System";
	xhm_choices (15) = "Multics Command Level Mode";
	xhm_choices (16) = "Go To Executive Forum Menu";


	call do_it (gs_spy_ptr, gs_xforum_system_area_ptr, SPY_AT_12, xhm_MENU_HEIGHT,
	     "Executive Forum", "Getting Started", "10010000"b, "Executive Forum");

	return;

general_help_topics: entry (ght_spy_ptr, ght_xforum_system_area_ptr, ght_prev_menu_name);

/* PARAMETERS */

	dcl     ght_spy_ptr		 ptr;		/* (input) pointer to spy structure */
	dcl     ght_xforum_system_area_ptr ptr;		/* (input) pointer to area xforum uses to allocate things in */
	dcl     ght_prev_menu_name	 char (*);	/* (input) name of menu that is currently displayed */





	xhm_choices (1) = "How To Exit Executive Forum";
	xhm_choices (2) = "How To Get Help";
	xhm_choices (3) = "Responding To Prompts";
	xhm_choices (4) = "How To Correct Typos";
	xhm_choices (5) = "Getting Around The Menus";
	xhm_choices (6) = "The 2 Attending Menus";
	xhm_choices (7) = "What Are Eligible Meetings";
	xhm_choices (8) = "What Are Attended Meetings";
	xhm_choices (9) = "What Are Changed Meetings";
	xhm_choices (10) = "What Is The Current Comment";
	xhm_choices (11) = "Selecting The Current Comment";
	xhm_choices (12) = "Entering Comments";
	xhm_choices (13) = "Personalizing The System";
	xhm_choices (14) = "Multics Command Level Mode";
	xhm_choices (15) = "Changes Between Version 1 And 2";
	xhm_choices (16) = "Return To " || ght_prev_menu_name || " Menu";



	call do_it (ght_spy_ptr, ght_xforum_system_area_ptr, SPY_AT_3, xhm_MENU_HEIGHT,
	     "General Help", "Topics", "10010000"b, ght_prev_menu_name);

	return;

do_it: proc (di_spy_ptr, di_xforum_system_area_ptr, di_spy_location, di_menu_height,
	di_title, di_banner, di_help_line_flags, di_return_to);

/* PARAMETERS */

	dcl     di_spy_ptr		 ptr;		/* (input) pointer to spy structure */
	dcl     di_xforum_system_area_ptr ptr;		/* (input) pointer to area xforum uses to allocate things in */
	dcl     di_spy_location	 fixed bin;	/* (input) identifies the menu about */
						/*         to be displayed for the spy record */
	dcl     di_menu_height	 fixed bin;	/* (input) number of lines in the menu about to be displayed */
	dcl     di_title		 char (*);	/* (input) first line of status window, giving first */
						/*         line of title of menu about to be displayed */
	dcl     di_banner		 char (*);	/* (input) second line of status window giving second */
						/*         line of title of menu about to be displayed */
	dcl     di_help_line_flags	 bit (8);		/* (input) flags used to control which function keys */
						/*         will be displayed on the help line */
	dcl     di_return_to	 char (*);	/* (input) name of menu currently displayed */

/* AUTOMATIC */

	dcl     di_choice		 fixed bin;	/* user's choice from the help menu */
	dcl     di_code		 fixed bin (35);	/* (standard error code */
	dcl     di_fkey		 bit (1) aligned;	/* ("1"b implies that users choice refers to a function key */
	dcl     di_menu_ptr		 ptr;		/* pointer to help menu menu structure */
	dcl     di_multics_mode	 bit (1);		/* "1"b implies that the user can go into multics mode */
	dcl     di_unused_fb	 fixed bin;	/* unused output argument */

	dcl     01 di_menu_requirements like menu_requirements;
						/* structure describing the rerquirements of the help menu */
						/* output by menu_$create but not used */

/* CONSTANTS */

	dcl     (
	        di_FIRST_MENU	 fixed bin init (2),/* function keys for goto first menu */
	        di_FIRST_MENU2	 fixed bin init (9),
	        di_FOREVER		 bit (1) init ("1"b), /* makes while loop loop forever */
	        di_HELP		 fixed bin init (1),/* function key for help */
	        di_HELP_FILE	 char (22) init ("xforum_getting_started"),
						/* name of the help file that contains */
						/* the help messages for these menus */
	        di_MULTICS		 fixed bin init (8),/* function keys for multics mode */
	        di_MULTICS2		 fixed bin init (15),
	        di_PREV_MENU	 fixed bin init (3),/* function keys for goto previous menu */
	        di_PREV_MENU2	 fixed bin init (10),
	        di_QUIT		 fixed bin init (4),/* function keys for quiting xforum */
	        di_QUIT2		 fixed bin init (11),
	        di_REDISPLAY	 fixed bin init (5),/* function keys for redisplaying the screen */
	        di_REDISPLAY2	 fixed bin init (12)
	        )			 internal static options (constant);

	di_multics_mode = xforum_user_profile$get_multics_mode ();
	spy_ptr = di_spy_ptr;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$bell (xforum_windows.menu.iocb, (0));
		call xforum_status_$redisplay ((0));
		call collect_spy_data (di_spy_location, "QUIT");
		goto getting_started_get_choice;
	     end;

	di_menu_requirements.version = menu_requirements_version_1;
	call xforum_create_menu_ (xhm_choices, addr (di_menu_requirements), di_menu_ptr, di_code);

	call xforum_window_mgr$resynch_windows (di_menu_height, "1"b);

	call xforum_status_$update_title (di_title);
	call xforum_status_$update_banner (di_banner);
	call xforum_help_line_$push (di_help_line_flags, "", "", "  g:Return to " || di_return_to || " menu");
	call xforum_status_$redisplay ((0));

	call xforum_window_mgr$menu_display (di_menu_ptr);

	on xforum_redisplay_menu call xforum_window_mgr$menu_display (di_menu_ptr);

	if di_title = "Executive Forum"
	then call xforum_help_$display (di_HELP_FILE, "Introduction");

getting_started_get_choice:
	do while (di_FOREVER);
	     call xforum_window_mgr$menu_get_choice (di_menu_ptr, di_fkey, di_choice);
	     call window_$clear_window (xforum_windows.bottom.iocb, (0));

	     if di_fkey
	     then call collect_spy_data (di_spy_location, "F" || rtrim (ltrim (char (di_choice))));
	     else call collect_spy_data (di_spy_location, rtrim (ltrim (char (di_choice))));

	     if di_fkey
	     then do;
		if di_choice = di_HELP
		then do;
		     call xforum_help_$get_help (di_menu_ptr, di_banner, xhm_choices,
			spy_ptr, di_xforum_system_area_ptr);
		     call xforum_status_$update_title (di_title);
		     call xforum_status_$update_banner (di_banner);
		     call xforum_status_$redisplay ((0));
		     call xforum_window_mgr$menu_display (di_menu_ptr);
		end;
		else
		     if di_choice = di_FIRST_MENU | di_choice = di_FIRST_MENU2
		then goto exit_do_it;
		else
		     if di_choice = di_PREV_MENU | di_choice = di_PREV_MENU2
		then goto exit_do_it;
		else
		     if di_choice = di_QUIT | di_choice = di_QUIT2
		then signal exit_executive_forum;
		else if di_choice = di_REDISPLAY | di_choice = di_REDISPLAY2
		then call xforum_redisplay_;
		else if (di_choice = di_MULTICS | di_choice = di_MULTICS2) & di_multics_mode
		then do;
		     call xforum_help_line_$push (di_help_line_flags, "", "", "");
		     call xforum_multics_mode (di_unused_fb);
		     call xforum_window_mgr$resynch_windows (di_menu_height, "0"b);
		     call xforum_help_line_$pop;
		     call xforum_status_$redisplay ((0));
		     call xforum_window_mgr$menu_display (di_menu_ptr);
		     goto getting_started_get_choice;
		end;
		else call window_$bell (xforum_windows.menu.iocb, (0));
	     end;
	     else do;
		if di_choice < 16
		then call xforum_help_$display (di_HELP_FILE, translate (xhm_choices (di_choice), "_", " "));
		else goto exit_do_it;
	     end;
	end;

exit_do_it:
	call menu_$destroy (di_menu_ptr, (0));

	call window_$clear_window (xforum_windows.menu.iocb, (0));

	call xforum_help_line_$pop;

	return;

     end do_it;

collect_spy_data: proc (csd_where, csd_response);

/* PARAMETERS */

	dcl     csd_where		 fixed bin;	/* (input) location response was collected */
	dcl     csd_response	 char (*);	/* (input) user's response */





	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

error: proc (e_code, e_reason);


/* PARAMETERS */

	dcl     e_code		 fixed bin (35);	/* (input) error code associated with error */
	dcl     e_reason		 char (512);	/* (input) message to be output to user */





	xhm_xforum_error_info.name = "xforum_help_menus";
	xhm_xforum_error_info.entry = "";
	xhm_xforum_error_info.doing = "";
	xhm_xforum_error_info.code = e_code;
	xhm_xforum_error_info.reason = e_reason;

	call signal_ ("xforum_fatal_error", null (), addr (xhm_xforum_error_info), null ());

     end error;

     end xforum_help_menus;




		    xforum_im_mgr.pl1               08/06/87  1025.1rew 08/06/87  1014.4      133155



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


/****^  HISTORY COMMENTS:
  1) change(85-01-14,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Written.
     
     85-01-23 Davids: Changed the calls to
     message_facility_$print_message and set_seen_switch to pass the
     message_id instead of the msg_array index.  This was a change to
     the message_facility_ to fix a bug.
     
     85-04-22 Davids: Added the ro_clean_up_flag to the
     restore_original entry.  This flag will suppress the printing of
     unseen messages if it is true.  This is needed so that in the
     event that the entry is called because of a cleanup condition
     being signaled no terminal output is done.
  2) change(86-05-06,LJAdams), approve(86-05-27,MCR7425),
     audit(86-05-28,Gilcrease), install(86-06-30,MR12.0-1080):
     Created dummy wakeup handler to take advantage of changes made to the
     message facility.
  3) change(87-04-09,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-24,Blair), install(87-08-06,MR12.1-1065):
     Added entrypoint get_wakeup_state to return wakeup state value to
     xforum_personalize_menu (this value can be unset, accept or defer).
                                                   END HISTORY COMMENTS */
                                                                       
xforum_im_mgr: proc;

/*
   BEGIN DESCRIPTION

   function:
      This module manages interactive message handling for the Executive Forum
      subsystems.

   description of entry points:
      xforum_im_mgr: This entry point should never be called.

      init: This entry obtains a pointer to the msg_facility_mailbox structure
      to the users default mailbox (>udd>PROJECT_ID>PERSON_ID>PERSON_ID.mbx.
      It also records the message handling state of that mailbox and sets the 
      message handling states for the xforum message handling accept and
      defer states. This entry must be called before any other entry in this
      module. Note that if the origianl_wakeup_flags = "0"b it means that
      messages have never been accepted. There is a ring 1 restriction
      that prevents the wakeup_state_flags from being reset to "0"b once they
      have been set to something else. Because of this the original
      wakeup_state_flags will be changed to "72"b3 (defer messages) if they
      are "0"b

      accept_messages: This entry changes the message handling state of the
      users default mailbox to the Executive Forum accept messages state.
      This state looks like the system standard accept message state except
      that all messages are held. It will also print out all unseen messages
      by calling the print_unseen_messages procedure.

      defer_messages: This entry changes the message handling state to the
      Executive Forum defer messages state. This state looks like the system
      standard defer message state.

      restore_original: This entry will print all unseen messages by calling
      the print_unseen_messages facility and then change the message handling
      state to the state it was in before the call to the init entry.

   description of internal procedures:
      set_message_facility_data: Given a structure that defines a message
      handling state this procedure calls the appropriate message_facility
      entry points to set that state.

      print_unseen_messages: This procedure causes all unseen messages to be
      printed over user_io. It then markes those messages as printed. In the
      event of an error while printing a message an error message is output and
      printing of other unseen messages is aborted.

      print_error: This procedure will print an error message explaining that
      an error occured while printing messages and that the messages may be
      read after Xforum is exited. A timer puts the process to sleep for 4
      seconds so that the message may be read.
      
      error: This procedure will signal the xforum_fatal_error condition.
      it will be called if an error is returned from one of the
      message_facility_ calls. It will also be called if the main entry point
      xforum_im_mgr$xforum_im_mgr is called.

   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

	dcl     iox_$user_io	 ptr ext static;

/* ENTRIES */

	dcl     ioa_		 entry () options (variable);
	dcl     message_facility_$get_alarm_handler entry (ptr, entry, ptr, fixed bin (71), fixed bin (35));
	dcl     message_facility_$get_message_format entry (ptr, bit (1) aligned, fixed bin (35));
	dcl     message_facility_$get_msg_array_ptr entry (ptr, ptr, ptr, fixed bin, fixed bin (35));
	dcl     message_facility_$get_msgf_mbx_ptr entry (char (*), char (*), ptr, fixed bin (35));
	dcl     message_facility_$get_prefix entry (ptr, char (32) var, bit (1) aligned, fixed bin (35));
	dcl     message_facility_$get_wakeup_handler entry (ptr, entry, ptr, fixed bin (35));
	dcl     message_facility_$get_wakeup_state entry (ptr, bit (*), fixed bin (35));
	dcl     message_facility_$print_message entry (ptr, ptr, bit (72) aligned, ptr, fixed bin (35));
	dcl     message_facility_$set_alarm_handler entry (ptr, entry, ptr, fixed bin (71), fixed bin (35));
	dcl     message_facility_$set_message_format entry (ptr, bit (1) aligned, fixed bin (35));
	dcl     message_facility_$set_prefix entry (ptr, char (32) var, bit (1) aligned, fixed bin (35));
	dcl     message_facility_$set_seen_switch entry (ptr, bit (72) aligned, bit (*), fixed bin (35));
	dcl     message_facility_$set_wakeup_handler entry (ptr, entry, ptr, fixed bin (35));
	dcl     message_facility_$set_wakeup_state entry (ptr, bit (*), fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     user_info_		 entry (char (*), char (*), char (*));
	dcl     xforum_im_mgr$dummy_wakeup_handler entry () options (variable);

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

/* INTERNAL STATIC */

	dcl     (
	        xim_msg_facility_mbx_ptr ptr,
	        01 xim_accept_messages like message_facility_data,
	        01 xim_original	 like message_facility_data,
	        01 xim_xforum_error_info like xforum_error_info
	        )			 internal static;

          dcl     wakeup_state           fixed bin (2) internal static;

/* CONSTANTS */

	dcl     xim_512_SPACES	 char (512) init (" ") internal static options (constant);
	dcl     UNSET                  fixed bin (2) int static options (constant) init (0);
          dcl     ACCEPT                 fixed bin (2) int static options (constant) init (1);
	dcl     DEFER                  fixed bin (2) int static options (constant) init (2);
         

/* BUILTINS */

          dcl     addr                   builtin;
	dcl     empty		 builtin;
          dcl     null                   builtin;
	dcl     rtrim		 builtin;

/* BASED */

	dcl     01 message_facility_data based,
		02 wakeup_state_flags bit (36),
		02 prefix_string	 char (32) varying,
		02 short_prefix	 bit (1) aligned,
		02 short_format	 bit (1) aligned,
		02 alarm_entry	 entry,
		02 alarm_info_ptr	 ptr,
		02 alarm_time	 fixed bin (71),
		02 wakeup_entry	 entry,
		02 wakeup_info_ptr	 ptr;

/* INCLUDE FILES */

%include msg_array;
%page;
%include msg_print_flags;
%page;
%include xforum_error_info;

	call error (0, "Program logic error, main entry point in xforum_im_mgr called.");

init: entry ();

/* AUTOMATIC */

	dcl     i_code		 fixed bin (35);
	dcl     i_dir		 char (168) varying;
	dcl     i_entry		 char (32);
	dcl     i_user_name		 char (32);
	dcl     i_user_project	 char (32);
	dcl     i_unused_c32	 char (32);

	call user_info_ (i_user_name, i_user_project, i_unused_c32);
	i_dir = ">udd>" || rtrim (i_user_project);
	i_dir = i_dir || ">";
	i_dir = i_dir || rtrim (i_user_name);
	i_entry = rtrim (i_user_name) || ".mbx";

	call message_facility_$get_msgf_mbx_ptr ((i_dir), i_entry, xim_msg_facility_mbx_ptr, i_code);
	if i_code ^= 0
	then call error (i_code, "Could not get msg facility mbx ptr.");

	call message_facility_$get_wakeup_state (xim_msg_facility_mbx_ptr, xim_original.wakeup_state_flags, i_code);
	if i_code ^= 0
	then call error (i_code, "Could not get original wakeup state.");

	if xim_original.wakeup_state_flags = "0"b
          then wakeup_state = UNSET;
	else if xim_original.wakeup_state_flags = "72"b3
          then wakeup_state = DEFER;
	else if xim_original.wakeup_state_flags = "74"b3
          then wakeup_state = ACCEPT;

	call message_facility_$get_prefix (xim_msg_facility_mbx_ptr,
	     xim_original.prefix_string, xim_original.short_prefix, i_code);
	if i_code ^= 0
	then call error (i_code, "Could not get original msg prefix information.");

	call message_facility_$get_message_format (xim_msg_facility_mbx_ptr, xim_original.short_format, i_code);
	if i_code ^= 0
	then call error (i_code, "Could not get original short format flag.");

	call message_facility_$get_alarm_handler (xim_msg_facility_mbx_ptr,
	     xim_original.alarm_entry, xim_original.alarm_info_ptr, xim_original.alarm_time, i_code);
	if i_code ^= 0
	then call error (i_code, "Could not get original alarm handler information.");

	call message_facility_$get_wakeup_handler (xim_msg_facility_mbx_ptr,
	     xim_original.wakeup_entry, xim_original.wakeup_info_ptr, i_code);
	if i_code ^= 0
	then call error (i_code, "Could not get original wakeup handler information.");

	if xim_original.wakeup_state_flags = "0"b
	then xim_original.wakeup_state_flags = "72"b3;

	xim_accept_messages.wakeup_state_flags = "74"b3;
	xim_accept_messages.prefix_string = "";
	xim_accept_messages.short_prefix = "0"b;
	xim_accept_messages.short_format = "0"b;
	xim_accept_messages.alarm_entry = xforum_im_mgr$dummy_wakeup_handler;
	xim_accept_messages.alarm_info_ptr = null ();
	xim_accept_messages.alarm_time = 0;
	xim_accept_messages.wakeup_entry = xforum_im_mgr$dummy_wakeup_handler;
	xim_accept_messages.wakeup_info_ptr = addr (xim_512_SPACES);

	return;

accept_messages: entry ();

	call set_message_facility_data (xim_accept_messages);
	call print_unseen_messages;
          wakeup_state = ACCEPT;

	return;

defer_messages: entry ();

	call set_message_facility_data (xim_accept_messages);
          wakeup_state = DEFER;

	return;

dummy_wakeup_handler: entry ();
	return;

get_wakeup_state: entry () returns (fixed bin(2));
	        
          return (wakeup_state);
	

restore_original: entry (ro_clean_up_flag);

/* PARAMETERS */

	dcl     ro_clean_up_flag	 bit (1) aligned;






	if ^ro_clean_up_flag
	then call print_unseen_messages;
	call set_message_facility_data (xim_original);

	return;

set_message_facility_data: proc (smfd_message_facility_data);

/* PARAMETERS */

	dcl     01 smfd_message_facility_data like message_facility_data;

/* AUTOMATIC */

	dcl     smfd_code		 fixed bin (35);

	call message_facility_$set_wakeup_state (xim_msg_facility_mbx_ptr,
	     smfd_message_facility_data.wakeup_state_flags, smfd_code);
	if smfd_code ^= 0
	then call error (smfd_code, "Could not set xforum accept wakeup state.");

	call message_facility_$set_prefix (xim_msg_facility_mbx_ptr,
	     smfd_message_facility_data.prefix_string, smfd_message_facility_data.short_prefix, smfd_code);
	if smfd_code ^= 0
	then call error (smfd_code, "Could not set xforum accept msg prefix information.");

	call message_facility_$set_message_format (xim_msg_facility_mbx_ptr,
	     smfd_message_facility_data.short_format, smfd_code);
	if smfd_code ^= 0
	then call error (smfd_code, "Could not set xforum accept short format flag.");

	call message_facility_$set_alarm_handler (xim_msg_facility_mbx_ptr,
	     smfd_message_facility_data.alarm_entry, smfd_message_facility_data.alarm_info_ptr,
	     smfd_message_facility_data.alarm_time, smfd_code);
	if smfd_code ^= 0
	then call error (smfd_code, "Could not set xforum accept alarm handler information.");

	call message_facility_$set_wakeup_handler (xim_msg_facility_mbx_ptr,
	     smfd_message_facility_data.wakeup_entry, smfd_message_facility_data.wakeup_info_ptr, smfd_code);
	if smfd_code ^= 0
	then call error (smfd_code, "Could not set xforum accept wakeup handler information.");

	return;

     end set_message_facility_data;

print_unseen_messages: proc;

/* AUTOMATIC */

	dcl     pum_code		 fixed bin (35);
	dcl     pum_i		 fixed bin;
	dcl     pum_work_area	 area (500);
	dcl     01 pum_msg_print_flags like msg_print_flags;





	call message_facility_$get_msg_array_ptr (xim_msg_facility_mbx_ptr,
	     addr (pum_work_area), msg_array_ptr, n_messages, pum_code);
	if pum_code ^= 0
	then do;
	     call print_error;
	     goto exit_print_unseen_messages;
	end;

	pum_msg_print_flags.print_prefix = "1"b;
	pum_msg_print_flags.print_ename = "0"b;
	pum_msg_print_flags.print_sender = "1"b;
	pum_msg_print_flags.print_date_and_time = "1"b;
	pum_msg_print_flags.print_time = "0"b;
	pum_msg_print_flags.print_last_message = "0"b;
	pum_msg_print_flags.mbz = "0"b;

	do pum_i = 1 to n_messages;
	     if ^msg_array (pum_i).printed
	     then do;
		call message_facility_$print_message (xim_msg_facility_mbx_ptr, iox_$user_io,
		     msg_array (pum_i).message_id, addr (pum_msg_print_flags), pum_code);
		if pum_code ^= 0
		then do;
		     call print_error;
		     goto exit_print_unseen_messages;
		end;
		call message_facility_$set_seen_switch (xim_msg_facility_mbx_ptr,
		     msg_array (pum_i).message_id, DELETE_UNHELD, pum_code);
		if pum_code ^= 0
		then do;
		     call print_error;
		     goto exit_print_unseen_messages;
		end;
	     end;
	end;

exit_print_unseen_messages:
	return;

     end print_unseen_messages;

print_error: proc;

	call ioa_ ("An error has occured while trying to print newly arrived messages." ||
	     "^/You may print these messages after exiting Executive Forum with^/the ""print_messages -new"" command.");
	call timer_manager_$sleep (4, "11"b);

	return;

     end print_error;

error: proc (e_code, e_message);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);
	dcl     e_message		 char (*);

	xim_xforum_error_info.name = "xforum_im_mgr";
	xim_xforum_error_info.entry = "";
	xim_xforum_error_info.doing = "";
	xim_xforum_error_info.code = e_code;
	xim_xforum_error_info.reason = e_message;

	call signal_ ("xforum_fatal_error", null (), addr (xim_xforum_error_info), null ());

     end error;

     end xforum_im_mgr;




		    xforum_list_meetings_.pl1       02/16/88  1457.2r w 02/16/88  1411.9      272979



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


/****^  HISTORY COMMENTS:
  1) change(85-01-10,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed the argument processing to call the appropriate
     xforum_user_profile$set entry with the correct argument.  Also for
     all arguments except force (fc) and no_force (nfc) to output a
     warning indicating that the argument is now obsolete.  The new
     internal procedure arg_warning does this.  Also removed the
     pointer to the args structure from the calling sequence of the
     xforum_process_args_ entry and replaced it with just a pointer to
     the xforum command arg_list.  Also removed the xforum_args include
     file.
     
     85-01-18 Davids: Corrected English in arg_warning message.
  2) change(87-04-03,LJAdams), approve(87-04-22,MCR7684),
     audit(87-04-27,Blair), install(87-08-06,MR12.1-1065):
     Changed meeting list rebuild msg.
                                                   END HISTORY COMMENTS */


xforum_list_meetings_: procedure () options (variable);

/*
   BEGIN DESCRIPTION

   function:
      This routine checks the arguments that xforum was called with and builds
      the xforum_meeting_list structure.

      xforum_list_meetings_: This entry should never be called.

      xforum_process_args_: The segment that the xforum_meeting_list structure
      is based on a temp segment created via a call to get_temp_segment_.
      The name of the "caller" used in the call is xforum_meeting_list so that
      the segment which holds the meeting list can be identified in the
      listing produced by the list_temp_segments command. The internal static
      pointer static_xforum_meeting_list_ptr is used to hold a pointer to the
      segment from one xforum invocation to another. force_mode is set by
      the user via the force or no_force control args. force indicates that
      the user wants to rebuild the meeting list even though one already
      exists. If the user indicates that he wants to reuse an existing meeting
      list the meeting_list_ok procedure is called to be sure that the
      meeting list is still valid. There are two things that can go wrong
      with a meeting list. First the users forum search rules can change. This
      is what meeting_list_ok checks for. The second is that a new meeting can
      be added to an existing directory, and existing meeting could be deleted
      or an acl can change. This is NOT checked for. There does not appear to
      be any way to do that without recording the contents of each directory.
      If the meeting list is to be built each directory in the forum search
      paths (the list of directories is obtained via a call to
      search_paths_$get) is scaned via the internal proc scan_dir. Once all the
      directories have been scaned and the list is completed it is sorted via
      the internal proc sort_output. The spy segment is built in the same
      manner as the meeting_list segment. Once built it is  loaded with some
      header info, i.e. name, date-time, arguments xforum was called with,
      number of eligible, attended, and changed meetings. The spy segment
      must be built before the meeting list segment since it is necessary to
      record the users answer if the meeting list needs to be rebuilt.

   description:
      process_args: This routine loops though the arguments that xforum was
      called with. It also accumulates a string with all the arguments in
      it for easy output into the spy structure. If an argument is found that
      is not supported a message to that effect is output and the process put
      to sleep for 4 seconds so that the user has time to read it. An invalid
      argument will not abort the xforum invocation - this is made clear in the
      message.

      scan_dir: This routine gets a list of all the branches matching the
      star names **.*.control and **.*.forum for a given directory.
      For each branch found check_forum is called to determine if it is a
      forum meeting.

      check_forum: The first thing done is a call to match_select_name to be
      sure that the meeting name does not yet appear in the meeting list. If it
      does the process stops right there for the given meeting. Next
      forum_$forum_info is called to determine if the given name is a forum
      meeting. If a non-zero error code is returned it is assumed that it is
      not a forum meeting. If a zero error code is returned it is assumed that
      it is a meeting. The uid of the meeting is compared with the uid's of
      all the meetings already in the meeting list. If the uid does not yet
      appear in the meeting list then the meeting name and the info returned by
      the call are added to the xforum_meeting_list.

      match_select_name: This procedure makes sure that each meeting in the
      meeting list has a unique name.

      sort_output: This does a simple shell sort over long name on the meeting
      list. This is done so that the meetings when listed in a dynamic menu
      come out sorted.

      meeting_list_ok: This compares the current number of forum search paths
      with the number when the meeting list was created. If they are different
      it warns the user via command_query_$yes_no and asks the user if he
      wants to rebuild the meeting list. Provided the number of paths are the
      same it will then check each path. If the current search paths are the
      same but in a different order this routine will assume that they are
      different and again a query will be asked. The question asked in both
      cases is the same. If the user indicates that he wants the meeting list
      rebuilt a message to that effect will be output. 
      If the user indicates that he does not want the meeting list rebuilt
      then the return value is the same as if no differences in the search
      paths were found. The answer given by the user is recorded in the spy
      structure. Each query has its own unique identification in the spy str.

      collect_spy_data: This is the same as every other spy_data. See
      xforum_main_options.

      clean_up: releases allocated temp segns and frees up allocated storage.

   known bugs:

   notes:

   history:
      83-??-?? Deryk Barker: Written.

      84-03-27 Davids: Modified scan_dir procedure so that after looking for
      all version 1 forums (suffix = control) it will look for version 2
      forums (suffix = forum). Also modifed check_forum procedure to take
      as an argument the suffix of the forum, i.e. control or forum. Also
      modified check_forum to set the new element forum_version in the
      xforum_meeting_list structure.

      84-03-28 Davids: Modified to set the forums (i).changed flag and
      to increment the changed count only if the meeting has been changed
      and the user is a participant (used to not check participation).

      84-05-03 Davids: Changed the length of my_long_name and my_short_name 
      from 24 characters to 32 characters. Version 2 forum names can be 26 
      characters long (forum suffix) - and a little extra incase version 3 uses
      a shorter suffix yet.

      84-05-23 Davids: Changed sort of meetings in the xforum_meeting_list
      structure to be by long_name instead of short_name, since menus are
      displayed by long name.

      84-06-04 Davids: Added code to create a spy segment in the pdir and to
      record the user_name, date_time, arguments that xforum was invoked with
      and the number of eligible, attending, and changed meetings.

      84-06-07 Davids: Modified the get_select_name internal proc to take an 
      argument which is the suffix of the meeting, i.e. control or forum,
      instead of just assuming control. Modified the call to get_select_name
      to call with the argument of control and then to call again with the
      argument of forum. This allows the user to specify either version 1 or 
      version 2 forum meeting in the xforum command line.

      84-06-13 Davids: Modified so that the spy segment is created and inited
      with 0's and blanks before process arguments is called. The actual 
      initialization of the user name, date, and number of meetings will take
      place in the xforum module after the call to xforum_process_args_.
      spy.args is set at the EGRESS label. This was changed from doing
      everything right before the EGRESS label because there are conditions
      where the initialization code was being skiped.

      84-06-13 Davids: Moved the spy setting stuff to after the EGRESS label to
      be sure that it is always set up correctly. It was right before the label
      and was not being set up correctly in some cases.

      84-06-14 Davids: Modified the star name to look for version 2 forum
      meetings in the scan_dir procedure from **.forum to **.*.forum. The old
      star name was matching on the name "forum" which is not correct.

      84-07-26 Davids: Modified so that the meeting list segement is created in
      the pdir with a name of xforum_meeting_list instead of just being a temp
      segment. Xforum termination will not delete this segment so it will be
      reused the next time the user invokes xforum. Meetings will not be
      checked for changes if the segment already exists. Also removed all the
      control arguments except multics_mode (mm) and menus. Added the control
      arg force which will cause the code to re-initialize the meeting list.
      This is needed because the user may have added a new search path or
      meeting to an existing search path. Removed the now unused internal
      procs: get_select_name, get_user_name, and get_mlist.

      84-08-13 Davids: Added a short name of fc to force. Added the nim control
      arg.

      84-09-18 Davids: Removed code which allowed this to be used as a command.
      The command allowed the user to build a meeting list before invoking
      xforum proper. However it is no longer documented and not intended to be
      part of xforum. Also removed a lot of unnecessary variable declarations
      and assignments to variables that were never used - slopy previous
      modifications where code was removed but initialization of variables
      used in that removed code were not removed.

      84-09-25 Davids: Modified so that the segments which hold the 
      xforum_meeting_list and spy structures use temporary segments instead
      of a segment in the pdir with a known name. These temp segments are not
      released when xforum exits. Pointers to these segments are kept in
      internal static so that they can be referenced in succeediing invocations.
      Also added the control arguments no_menus, no_multics_mode, nmm,
      no_force, nfc, and im. Added the internal proc meeting_list_ok which is
      called if the force_mode is not in effect, i.e. an existing meeting_list
      is to be used. Moved the creation of the spy segment up to right before
      the creation of the meeting_list segment. Added the collect_spy_data
      internal proc to record what the user answered to the meeting list update
      query.
      
      84-10-02 Davids: Added the -escape_sequences, -esc, -no_escape_sequences,
      -no_escape_sequences control arguments. Also added the output parameter
      P_spy_ptr to the process_args_ entry point. This is needed because the
      shift from a fixed name spy segment to a temp segment means that a
      pointer to the segment has to be returned to xforum.

      84-10-17 Davids: Moved the code that set the eligible, attending,
      and changed elements of the spy structure to after the spot where
      those values are determined. When the rest of the spy code was moved
      this code was moved too, and it should have stayed put.

      84-11-06 Davids: Auditing Changes 1) add a trailing underscore to the 
      module name; 2) Replace the term extension with the term suffix;
      3) Clean up some misspelling and bad wording in the header comments;
      4) Increased the length of the arg_list variable from 100 to 256 chars.
      5) replaced references to PUNT_FORUM with exit_check_forum. Also replaced
      other multiple returns in check_forum procedure with goto
      exit_check_forum. Other changes: 1) removed the xflsm name from the
      module. This was a hold over from when the module could be used as a
      command. 2) Cleaned up declarations.
   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     P_arg_list_ptr	 ptr;
	dcl     P_caller		 char (*);
	dcl     P_spy_ptr		 ptr;
	dcl     P_code		 fixed bin (35);

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     com_err_		 entry () options (variable);
	dcl     command_query_$yes_no	 entry () options (variable);
	dcl     cu_$arg_count_rel	 entry (fixed bin, ptr, fixed bin (35));
	dcl     cu_$arg_ptr_rel	 entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
	dcl     date_time_		 entry (fixed bin (71), char (*));
	dcl     forum_$forum_info	 entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35));
	dcl     get_system_free_area_	 entry () returns (ptr);
	dcl     get_temp_segment_	 entry (char (*), ptr, fixed bin (35));
	dcl     hcs_$star_dir_list_	 entry (char (*), char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     match_star_name_	 entry (char (*), char (*), fixed bin (35));
	dcl     release_temp_segment_	 entry (char (*), ptr, fixed bin (35));
	dcl     search_paths_$get	 entry (char (*), bit (36), char (*), ptr, ptr, fixed bin, ptr, fixed bin (35));
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     user_info_$whoami	 entry (char (*), char (*), char (*));
	dcl     xforum_user_profile$set_menu_always entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$set_multics_mode entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$set_handle_interactive_messages entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$set_use_function_keys entry (bit (1)) returns (bit (1));

/* CONDITIONS */

	dcl     cleanup		 condition;

/* INTERNAL AUTOMATIC */

	dcl     ME		 char (32);
	dcl     access_name		 char (32);
	dcl     access_time		 fixed bin (71);
	dcl     arg_count		 fixed bin;
	dcl     arg_idx		 fixed bin;
	dcl     arg_list		 char (256) varying;
	dcl     arg_list_ptr	 ptr;
	dcl     arg_lth		 fixed bin (21);
	dcl     arg_ptr		 ptr;
	dcl     code		 fixed bin (35);
	dcl     dir_idx		 fixed bin;
	dcl     explicit		 bit (1) aligned;
	dcl     force_mode		 bit (1);
	dcl     forum_directory	 char (168);
	dcl     obj_name_count	 fixed bin;
	dcl     obj_name_idx	 fixed bin;
	dcl     select_names_ptr	 ptr;
	dcl     system_area_ptr	 ptr;
	dcl     unusedb1		 bit (1);
	dcl     1 fi		 aligned like forum_info;

/* INTERNAL STATIC */

	dcl     static_xforum_meeting_list_ptr ptr internal static init (null ());
	dcl     static_spy_ptr	 ptr internal static init (null ());

/* CONSTANTS */

/* BUILTINS */

          dcl     addr                   builtin;
	dcl     binary		 builtin;
	dcl     clock		 builtin;
	dcl     divide		 builtin;
	dcl     length		 builtin;
	dcl     null		 builtin;
          dcl     rtrim		 builtin;
	dcl     substr		 builtin;
          dcl     unspec                 builtin;

/* BASED */

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

/* INCLUDE FILES */

%include access_mode_values;
%page;
%include forum_info;
%page;
%include sl_control_s;
%page;
%include sl_info;
%page;
%include star_structures;
%page;
%include xforum_meeting_list;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;

xforum_process_args_: entry (P_arg_list_ptr, P_caller, P_spy_ptr, P_code);

	P_code = 0;
	arg_list_ptr = P_arg_list_ptr;
	ME = P_caller;

COMMON:
	explicit, force_mode = "0"b;

	select_names_ptr, sl_info_p, star_list_branch_ptr,
	     star_list_names_ptr = null ();

	on cleanup call clean_up ();

	call get_temp_segment_ (ME, select_names_ptr, code);

	if code ^= 0
	then do;
	     P_code = code;
	     return;
	end;

	select_names.no_names = 0;

	call process_args;				/* won't return if error	      */

	access_name = "";
	access_time = clock ();

	system_area_ptr = get_system_free_area_ ();

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

	if code ^= 0
	then do;
	     P_code = code;
	     call com_err_ (code, ME, "Getting ""forum"" search list.");
	     return;
	end;

	if static_spy_ptr = null ()
	then call get_temp_segment_ ("xforum_spy", static_spy_ptr, code);
	if code ^= 0
	then do;
	     call com_err_ (code, "xforum", "Could not make spy segment");
	     P_code = code;
	     goto EGRESS;
	end;
	spy_ptr = static_spy_ptr;
	P_spy_ptr = static_spy_ptr;

	spy.version = SPY_VERSION_1;
	call user_info_$whoami (spy.user_name, "", "");
	call date_time_ (clock (), spy.date_time);
	spy.args = arg_list;
	spy.count = 0;

	if static_xforum_meeting_list_ptr = null ()
	then do;
	     call get_temp_segment_ ("xforum_meeting_list", static_xforum_meeting_list_ptr, code);
	     force_mode = "1"b;			/* no need to check meeting list - we just created it */
	end;
	if code ^= 0
	then do;
	     P_code = code;
	     call com_err_ (code, ME, "creating xforum meeting list segment");
	     goto EGRESS;
	end;
	xforum_meeting_list_ptr = static_xforum_meeting_list_ptr;

	if ^force_mode
	then do;
	     if meeting_list_ok (xforum_meeting_list_ptr, sl_info_p)
	     then goto EGRESS;
	end;

	no_selected, no_participant, no_changed, current_selected,
	     current_participant, current_changed = 0;
						/* start with a clean slate	      */

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

	     if sl_info.paths (dir_idx).code = 0 then do;
		forum_directory = sl_info.paths (dir_idx).pathname;
		call scan_dir ();
	     end;
	end;

	spy.eligible = no_selected;
	spy.attending = no_participant;
	spy.changed = no_changed;

	call sort_output ();

	xforum_meeting_list.npaths = sl_info_p -> sl_info.num_paths;
	do dir_idx = 1 to sl_info_p -> sl_info.num_paths;
	     xforum_meeting_list.paths (dir_idx) = sl_info.paths (dir_idx).pathname;
	end;

	xforum_meeting_list.date_time = clock ();

EGRESS:
	call clean_up ();

	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
/*					      */
/* This procedure check the arguments and their         */
/* consistency				      */
/*					      */
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

process_args:
     proc;

	call cu_$arg_count_rel (arg_count, arg_list_ptr, code);
	if code ^= 0
	then do;
	     P_code = code;
	     call com_err_ (code, ME);
	     goto EGRESS;
	end;

	arg_list = "";
	do arg_idx = 1 to arg_count;

	     call cu_$arg_ptr_rel (arg_idx, arg_ptr, arg_lth, (0),
		arg_list_ptr);

	     arg_list = arg_list || arg || " ";

	     if arg = "-menus"
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_menu_always ("1"b);
	     end;
	     else
		if arg = "-no_menus"
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_menu_always ("0"b);
	     end;
	     else
		if (arg = "-multics_mode" | arg = "-mm")
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_multics_mode ("1"b);
	     end;
	     else
		if (arg = "-no_multics_mode" | arg = "-nmm")
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_multics_mode ("0"b);
	     end;
	     else
		if (arg = "-nim" | arg = "-no_interactive_messages")
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_handle_interactive_messages ("0"b);
	     end;
	     else
		if (arg = "-im" | arg = "-interactive_messages")
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_handle_interactive_messages ("1"b);
	     end;
	     else
		if (arg = "-esc" | arg = "-escape_sequences")
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_use_function_keys ("0"b);
	     end;
	     else
		if (arg = "-nesc" | arg = "-no_escape_sequences")
	     then do;
		call arg_warning (arg);
		unusedb1 = xforum_user_profile$set_use_function_keys ("1"b);
	     end;
	     else if (arg = "-force" | arg = "-fc")
	     then force_mode = "1"b;
	     else if (arg = "-no_force" | arg = "-nfc")
	     then force_mode = "0"b;
	     else do;
		call com_err_ (0, ME, "^a is not a supported argument, continuing setup.", arg);
		call timer_manager_$sleep (4, "11"b);
	     end;
	end;

     end process_args;

arg_warning: proc (aw_arg);

/* PARAMETERS */

	dcl     aw_arg		 char (*);


	call ioa_ ("The control argument ""^a"" is now obsolete.", aw_arg);
	call ioa_ ("  It will continue to be supported in the MR12 release.");
	call ioa_ ("  The Personalize Executive Forum menu can be used to set this option.");
	call ioa_ ("Continuing setup.^/");

	call timer_manager_$sleep (4, "11"b);

	return;

     end arg_warning;

scan_dir: procedure ();

	declare object_idx		 fixed bin;

	star_select_sw = star_ALL_ENTRIES;

	call hcs_$star_dir_list_ (forum_directory, "**.*.control",
	     star_select_sw, system_area_ptr, star_branch_count,
	     star_link_count, star_list_branch_ptr, star_list_names_ptr,
	     code);
	if code = 0 then
	     do object_idx = 1 to star_branch_count + star_link_count;
		obj_name_idx = star_dir_list_branch.nindex (object_idx);
		obj_name_count = star_dir_list_branch.nnames (object_idx);
		call check_forum (".control");
	     end;

/* Version 2 forums are directories with names of <meeting_name>.forum */

	call hcs_$star_dir_list_ (forum_directory, "**.*.forum",
	     star_select_sw, system_area_ptr, star_branch_count,
	     star_link_count, star_list_branch_ptr, star_list_names_ptr,
	     code);
	if code = 0 then
	     do object_idx = 1 to star_branch_count + star_link_count;
		obj_name_idx = star_dir_list_branch.nindex (object_idx);
		obj_name_count = star_dir_list_branch.nnames (object_idx);
		call check_forum (".forum");
	     end;

	return;

     end scan_dir;

check_forum: procedure (ck_suffix);

	dcl     ck_suffix		 char (*);

	declare my_long_name	 char (32) varying,
	        my_short_name	 char (32) varying,
	        forum_idx		 fixed bin;

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

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

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

	fi.version = forum_info_version_1;
	call forum_$forum_info (forum_directory,
	     star_list_names (obj_name_idx), access_name, access_time,
	     addr (fi), code);
	if code ^= 0
	then goto exit_check_forum;

	do forum_idx = 1 to no_selected;
	     if fi.forum_uid = forums (forum_idx).uid then
		goto exit_check_forum;
	end;

ADD_FORUM:
	no_selected = no_selected + 1;

	forums (no_selected).long_name = my_long_name;
	forums (no_selected).directory = forum_directory;
	if ck_suffix = ".forum"
	then forums (no_selected).forum_version = 2;
	else forums (no_selected).forum_version = 1;
	forums (no_selected).uid = fi.forum_uid;
	unspec (forums (no_selected).flags) = ""b;
						/* all flags off */
	forums (no_selected).eligible = fi.eligible;
	forums (no_selected).removed = fi.removed;
	forums (no_selected).notify = fi.notify;
	forums (no_selected).read_only = fi.read_only;
	forums (no_selected).attended = (fi.last_time_attended ^= 0);
	forums (no_selected).participant =
	     forums (no_selected).attended & ^fi.removed;
	if forums (no_selected).participant then
	     no_participant = no_participant + 1;

	if my_short_name = "" then do;
	     forums (no_selected).short_name = my_long_name;
	     forums (no_selected).two_names = "0"b;
	end;
	else do;
	     forums (no_selected).short_name = my_short_name;
	     forums (no_selected).two_names = "1"b;
	end;

	forums (no_selected).chairman =
	     rtrim (fi.chairman.username) || "." || fi.chairman.project;


	if (fi.changes_count > 0) & forums (no_selected).participant
	then do;
	     no_changed = no_changed + 1;
	     forums (no_selected).changed = "1"b;
	end;


exit_check_forum:
	return;

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

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

	accepting = exclude (1);

	do name_idx = 1 to select_names.no_names;

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

		     if star_name (name_idx) then do;
			call match_star_name_ (
			     star_list_names (star_idx),
			     forum_names (name_idx), code);
			if code = 0 then
			     match = "1"b;
		     end;
		     else if forum_names (name_idx)
			= star_list_names (star_idx) then
			explicit, match = "1"b;
		     matched (name_idx) = matched (name_idx) | match;
		end;

		if match then
		     accepting = ^exclude (name_idx);
	     end;
	end;

	return (accepting);

     end match_select_name;

/* The following routine is a simple shell sort by long_name.  */

sort_output:
     procedure ();

	dcl     (i, k, l)		 fixed bin;
	dcl     1 t		 like xforum_meeting_list.forums;

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

	return;

     end sort_output;

meeting_list_ok: proc (mlo_xforum_meeting_list_ptr, mlo_sl_info_p) returns (bit (1));

/* PARAMETERS */

	dcl     mlo_xforum_meeting_list_ptr ptr;
	dcl     mlo_sl_info_p	 ptr;

/* AUTOMATIC */

	dcl     mlo_ans_yes		 bit (1);
	dcl     mlo_i		 fixed bin;
	dcl     mlo_meeting_list_ok	 bit (1);
	dcl     mlo_same		 bit (1);
	dcl     mlo_search_paths_str_ptr ptr;

/* BASED */

	dcl     01 mlo_search_paths_str based (mlo_search_paths_str_ptr),
		02 npaths		 fixed bin,
		02 paths		 (npaths) char (168) varying;

	mlo_meeting_list_ok = "1"b;

	xforum_meeting_list_ptr = mlo_xforum_meeting_list_ptr;
	sl_info_p = mlo_sl_info_p;

	mlo_search_paths_str_ptr = addr (xforum_meeting_list.npaths);
	if mlo_search_paths_str.npaths ^= sl_info.num_paths
	then do;
	     call command_query_$yes_no (mlo_ans_yes, 0, "",
		"Your  Forum search paths are the list of directories which are seached for^/" ||
		"forum  meetings.   The  forum  meetings found are saved in a meeting list.^/" ||
		"This  list  of  directories  has  been  changed since the meeting list was^/" ||
		"created.   If  you  do  not  update  your meeting list it is possible that^/" ||
		"meetings which you could attend will not be listed.^/^/" ||
		"Your forum search paths have changed.^/" ||
		"   Do you want to update your meeting list to reflect those changes? ",
		"Your forum search paths have changed.^/" ||
		"   Do you want to update your meeting list to reflect those changes? ");
	     if mlo_ans_yes
	     then do;
		mlo_meeting_list_ok = "0"b;
		call collect_spy_data (SPY_AT_13, "yes");
	     end;
	     else call collect_spy_data (SPY_AT_13, "no");
	     goto exit_meeting_list_ok;
	end;

	mlo_same = "1"b;
	do mlo_i = 1 to mlo_search_paths_str.npaths while (mlo_same);
	     if mlo_search_paths_str.paths (mlo_i) ^= sl_info.paths (mlo_i).pathname
	     then mlo_same = "0"b;
	end;

	if ^mlo_same
	then do;
	     call command_query_$yes_no (mlo_ans_yes, 0, "",
		"Your  Forum search paths are the list of directories which are seached for^/" ||
		"forum  meetings.   The  forum  meetings found are saved in a meeting list.^/" ||
		"This  list  of  directories  has  been  changed since the meeting list was^/" ||
		"created.   If  you  do  not  update  your meeting list it is possible that^/" ||
		"meetings which you could attend will not be listed.^/^/" ||
		"Your forum search paths have changed.^/" ||
		"   Do you want to update your meeting list to reflect those changes? ",
		"Your forum search paths have changed.^/" ||
		"   Do you want to update your meeting list to reflect those changes? ");
	     if mlo_ans_yes
	     then do;
		mlo_meeting_list_ok = "0"b;
		call collect_spy_data (SPY_AT_14, "yes");
	     end;
	     else call collect_spy_data (SPY_AT_14, "no");
	     goto exit_meeting_list_ok;
	end;

exit_meeting_list_ok:

	if ^mlo_meeting_list_ok
	then call ioa_ ("^/Your meeting list is being rebuilt.  Please wait for menu to be displayed.^/");

	return (mlo_meeting_list_ok);

     end meeting_list_ok;

collect_spy_data: proc (csd_where, csd_response);

/* PARAMETERS */

	dcl     csd_where		 fixed bin;	/* (input) */
	dcl     csd_response	 char (*);	/* (input) */

	spy.count = spy.count + 1;
	spy.choices (spy.count).at = csd_where;
	spy.choices (spy.count).choice = csd_response;

	return;

     end collect_spy_data;

clean_up:
     procedure ();

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

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

	if sl_info_p ^= null () then
	     free sl_info;

	return;

     end clean_up;

     end xforum_list_meetings_;




		    xforum_main_options.pl1         08/06/87  1025.1rew 08/06/87  1008.9      376407



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


/****^  HISTORY COMMENTS:
  1) change(85-02-26,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Deleted the internal proc prompt_help which was outputting a
     canned messaged in response to a ?  from the meeting name prompt.
     Replaced it with a call to xforum_help_$display to output the help
     message in the info file.  Also added the gm_help_name variable to
     hold the name of the help section (i.e., changed, attended, or
     eligible).  Bob Kress found this error while he was going over the
     documentation.
     
     85-03-01 Davids: Corrected next_meeting so it uses its own nm_*
     variables to call the attend_mtg_menu modules instead of the gm_*
     variables.  I obviously copied the code and didn't change the
     variables and didn't test it until now.
     
     85-03-07 Davids: Corrected the get_choice_from_menu procedure so
     that it pops the help_line when a choice has been made and the
     routine is about to exit.  It was just doing a
     xforum_help_line_$redisplay.  When enough of the meeting list
     menus were displayed a help_line stack overflow would occur.  Also
     had to reorange the way that get_curr_meeting handled the
     help_line.  A new help line was being pushed for every prompt and
     no pops were being done.
  2) change(85-04-02,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Removed code from the get_choice_from_menu procedure that dealt
     with constructing the array of names to be used in the dynamic
     menus and the creation of the menus and the handling of the
     function keys.  Replaced it all with a call to
     xforum_dyn_menu_$display_and_get_choice.
     
     85-04-03 Davids: Removed code from the get_curr_meeting procedure
     that dealt with prompting the user for a meeting name and
     processing the response, i.e.  too long or blank input, or ?.
     Replaced it with a call to
     xforum_dyn_menu_$prompt_instead_of_menu.
     
     85-04-22 Davids: Added code to the find_meeting procedure to copy
     the search paths to the end of the extended meeting list before
     the meeting info is moved.  This keeps the search paths from
     getting zaped when the meeting info is extened and prevents the
     "Warning your search paths have changed" message from appearing
     when you add a new meeting to your meeting list by searching for
     it after the meeting list proper has been created.  This is error
     list entry number 4.
     
     85-05-01 Davids: Changed the loop in next_meeting_internal that
     goes from 1 to nmi_curr_mtg looking for a meeting that meets the
     criteria so that it goes to nmi_curr_mtg - 1.  This is needed so
     that you do not get a subscript range error when nmi_curr_mtg is
     set to the max meeting index.  It will be so set after you have
     cycled through all the meetings.
     
     85-06-17 Davids: Modified call to xforum_find_path_ so that the
     fm_dir output paramater comes after all the input paramaters.
  3) change(87-07-21,LJAdams), approve(87-07-21,MCR7684),
     audit(87-07-24,Blair), install(87-08-06,MR12.1-1065):
     Declared constants for menu choices to get rid of magic numbers.
                                                   END HISTORY COMMENTS */


xforum_main_options: proc;

/*
   BEGIN DESCRIPTION

   function:
      This module implements all the functions related to the options
      in the xforum main menu.

   description of entry points:
      goto_meeting: this entry is used to "goto" a meeting. An input value
      determines if the meeting type is a changed, attended, or eligible one.
      If the indicated type is changed and there are no more changed meetings
      the handle_no_changed_mtgs procedure is called. If there are no meetings
      of the indicated type (after the call to handle...) a message to that
      effect is output. If there is only 1 meeting of the given type it is
      automatically selected. If there is more than 1 meeting a call is made
      to the internal procedure get_curr_meeting to let the user select the
      meeting he wishes to goto. Once the meeting is selected a call is made
      to the internal proc attend_meetings.

      next_meeting: This entry is used to "goto" the next meeting. An
      input value determines if the meeting type is a changed, attended, or
      eligible one. The work of selecting the next meeting is done by calling
      next_meeting_internal. Once a meeting is selected a call is made to the
      internal proc attend_meetings.

      index_of_next_meeting: This entry is used to determine the index of the
      next meeting of the given type. The work of selecting the next meeting
      is done by next_meeting_internal.

      modify_meeting_list: This entry will be used to modify the contents
      meeting list, i.e. add new meetings and resign from currently attended
      meetings. Currently the only thing implemented is a call to ioa_ which
      outputs a message saying that the function has not yet been implemented.

   description of internal procedures:
      get_curr_meeting: This procedure queries the user for the name of the
      meeting he wants to go to. If the menu_always flag is set to true (input
      from the caller of goto_meeting entry) a dynamic menu of all the meetings
      of the given type is displayed in the bottom window (via a call to 
      get_choice_from_menu). If the meeting index returned by
      get_choice_from_menu is -1 it means that the user selected the "ENTER
      NAME" meeting which indicates that the user wants to be prompted for the
      meeting name. The users response is checked in the find_meeting
      procedure to be sure that it is on the meeting list. The meeting is also
      checked to be sure that it is the right type. If the meeting is not on
      the list or the types do not match an error message is output and no
      meeting is selected. The user aborts the query (or dynamic menu) by
      signaling quit. The quit handler in xforum will trap the quit, reset
      all the windows, and unwind the stack back to xforum by doing a non-local
      goto to the menu display and get_choice loop.

      get_choice_from_menu: this manages a dynanic menu of the meeting names
      for the given type of meeting. The xforum_dyn_menu routines are utilized
      to create and display the menu and get the users choice. the function
      keys REDISPLAY, SCROLL_UP, and SCROLL_DOWN are active. The user can abort
      the menu by signalling quit (see discussion in get_curr_meeting).
      The dynamic menu contains the list of meetings plus the special meeting
      "ENTER NAME" as the last item on the last menu. This special meeting
      has a meeting list index of -1 which get_curr_meeting recognizes as
      a request for a prompt. A title line that describes the type of meetings
      being selected is written over the trailer line of the top menu. This was
      done so that you did not end up with 2 lines of dashes. The title is
      positioned over the trailer line via position_cursor and then
      ovewrite_text.

      find_meeting: locates the requested meeting in the xforum meeting list.
      If the meeting is not in the meeting list it calls xforum_find_path_
      to use the forum search rules to locate the meeting. forum_info is 
      called to get info about the meeting and the meeting is then
      added to the xforum meeting list. The name used in the xforum meeting
      list is the name the user used, not the name of the actual meeting.

      next_meeting_internal: finds the next meeting in the meeting list.
      The meeting may be constrained to have been changed or attended.
      If the meeting is a changed meeting and there are no changed meeting in 
      the list then handle_no_changed_meetings is called. If no meetings of
      the requested type can be found a message is output and the process put
      to sleep for 4 seconds to allow time to read the message.

      prompt_help: outputs a help message about the "Enter name of meeting"
      prompt issued in the get_curr_meeting procedure. This procedure is called
      if the user answers the prompt with a "?". The text of the help message
      varies slightly depending on the type of meeting, i.e. changed, attended
      or eligible.

      handle_no_changed_meetings: will prompt the user to see if he wants the
      meetings in his meeting list checked for changes. ONLY the meetings
      in the meeting list that the user participats in are checked.
      command_query is used to query the user and the help text printed in
      response to a "?" is part of the command_query call. If the user answers
      yes, a message indicating that the meeting are being checked and that it
      will take a while is output. A call is made to forum_$forum_info for
      each meeting the user participats in. If the meeting is changed the
      meeting is marked as changed and the changed count is incremented.
      Before the module exits the banner containing the counts of eligible,
      atteneded, and changed meetings is updated - but it is only printed if
      the number of changed meetings and attended meetings are both non-zero.
      This prevents the banner for being updated while the "No changed
      meetings" message is output.

      collect_spy_data: this procedure is called from all locations that take 
      user input. Its input is the user's input and a location ID. It writes
      that information in a special spy structure based on a pointer that
      was passed in to the orginal entry. Note that collect_spy_data is the
      same in all xforum modules. It is not a separate module because it
      consists on only 3 assignment statements.

      error: this is called when a fatal error has been detected by xforum.
      A fatal error happens when an unexpected error code is returned from
      a system routine, i.e. a non-zero code returned from forum_limits, or
      an inconsistency in the input parameters is found. It signals the
      xforum_fatal_error condition. There is a condition handler for this
      in the xforum module.

   known bugs:
      84-07-31 Davids: help messages need to set up for escape sequence mode.

   notes:

   history:
      84-07-09 Davids: created by extracting the relavent internal procedures
      from the xforum module.

      84-07-18 Davids: Added the handle_no_changed_mtgs procedure

      84-07-27 Davids: Added a confirmation message in the
      handle_no_changed_mtgs procedure so that if the user answered with a
      yes he knows that the answer was accepted and that the meetings are
      being checked. If he answered no there is no need for a confirmation
      message since the menu is updated very quickly.

      84-07-31 Davids: Modified the handle_no_changed_meetings so that:
      1) it had a quit handler, 2) there are calls to collect_spy_data
      and 3) it updates the banner before it leaves. Also cleaned things
      up so that the code looks better and removed unneeded dcls. Finally
      added a call to the error procedure if the main entry point is called.
      Modified the usage message in get_choice_from_menu to conform with MTB.
      Created an internal procedure called next_meeting_internal. This
      procedure is called by the next_meeting entry point (its the only thing
      the entry does) and the goto_meeting entry point if there is only 1
      meeting that can be gone to. A message telling the user that the meeting
      was automatically selected is also output.

      84-08-13 Davids: Changed Attended, Changed and Meetings to attended,
      changed and meetings in error messages. Changed Meetings in the banner
      to Eligible. Changed the error message reported in find_meeting if
      xforum_find_path_ fails to find the meeting to reflect the MTB.

      84-08-15 Davids: Modified so that all entry points used the
      xforum_info_ptr as their only parameter. Added entry points
      modify_meeting_list, personlize, and getting_started. These entry points
      just report that the code has not yet been implemented. Deleted entry
      points resign_from_meeting, and list_meetings since these are no longer
      main menu options.

      84-08-29 Davids: Added the internal routines attend_meetings and
      attend_a_meeting. These additions need to be cleaned up but they are
      now in place.

      84-08-31 Davids: Added sleep statements after the You have no * meetings
      messages in the next_meeting_internal proc. This was needed to keep the
      messages on the screen so that the user can read them. Also the status
      window is not updated if there are no changes. This prevents the status
      window from changing to that of the main menu while the menu remains that
      of the attending meeting and the You have... message is displayed.

      84-09-04 Davids: Added code to find_mmeting. The name_entered is now
      compared against the long_names in the meeting list instead of the short
      names since the rest of the list is sorted by long_name. no_selected is
      incremented before the loop that shifts the list to make room for the
      new name - this prevents a subscript range condition.

      84-09-05 Davids: Added the variable fm_meeting_version to find_meeting.
      also added code to set the xforum_meeting_list.forums (i).forum_version
      element. This was preventing version 1 meetings from being found after
      they are added to the meeting list (since the version was not 1 it was
      assumed to be 2).

      84-09-06 Davids: Changed the Select options in the attend meeting menu to
      Select/Display. Changed option 4 in the menu from just selecting comments
      to both selecting and displaying comments.

      84-09-17 Davids: Added processing for uppercase escape sequences. This
      was done by declaring XXX2 constants for the uppercase escape sequences
      and inserting them in the if statements along with the XXX constants.
      The constants declared were REDISPLAY2, QUIT2, PREV_MENU2, SCROLL_UP2,
      SCROLL_DOWN2. For the main entry and aam and gs.

      84-09-24 Davids: Modified get_choice_from_menu so that it adds to the
      list of meetings the choice ENTER NAME. This "meeting" has a meeting
      list index of -1. Modified get_curr_meeting so that if the meeting
      selected has an index of -1 if will goto the display_prompt label
      instead of assuming that a meeting has been selected.

      84-09-25 Davids: Removed references to xforum_trans_array. The array is
      being deleted because it enforces an upper limit on the number of
      transaction that xforum can handle.

      84-09-27 Davids: Modified the get_choice_from_menu option so that a
      title of "T Meetings Selection" is output over the trailer line of the
      main menu. It is centered by determining where on the screen it should
      start, positioning the cursor there, and overwritting the text. This has
      the effect of a title line which is padded with dashes but does not
      produce two lines with dashes, i.e. the main trailer line and the new
      dynamic menu header line. The T stands for Eligible, Attended, or Changed
      depending on the type of meetings requested. Also modified the call to
      copy_comments so that it reflected the new calling sequence.

      84-09-28 Davids: Modified to use the xforum_help_line module instead of 
      the xforum_status_ entries that manipulated the help line.

      84-10-03 Davids: Added code in attend_a_meeting to get the seen
      transaction bit map and the xforum_meeting_info next_unread and
      unread_count elements. Added code in reinstate_mtg_status to update
      the bit map and unread values if there were transactions entered since
      the last time the bit map was updated. Changed the label in the new field
      to Unread:

      84-10-11 Davids: Changed the Current transaction string for the
      attend meeting menu to Current comment.

      84-10-16 Davids: Changed Select/Display Comments to
      Select/Display Any Comment(s)

      84-10-26 Davids: Changed List Current Comment(s) to Select/List Any
      Comment(s). Also swaped the menu position of Copy Comments with
      Select/List so that all the Select options are in a group.

      84-10-29 Davids: Added a test for the input of a null meeting name in
      the get_curr_meeting procedure. A appropriate message is now output
      instead of letting the null name pass and giving the user: The "" meeting
      could not be found.

      84-11-06 Davids: Changed references to xforum_help_line to
      xforum_help_line_.

      84-11-15 Davids: Auding changes: 1) Fixed output messages to begin with
      an upper case letter and end with a period.

      84-12-13 Davids: added code in handle_no_changed_meetings so that if a
      call to forum to get meeting info fails a message is output saying that
      the meeting has been deleted or renamed and tells how to update the
      meeting list. This is nicer then just aborting xforum. It also sets the
      participant flag for the meeting to false. The same messages are
      output in the attend_a_meeting procedure if the call to open a meeting
      fails the participant and changed flags for the meeting are 0'ed and the
      no_participant and no_changed counts are decremented if need be.

     85-01-08 Davids: Changed calling sequence of xforum_multics_mode to remove
     the handle_interactive_messages_flag. Also changed the calling sequence of
     xforum_help_$get_help to remove the handle_interactive_messages_flag and
     the function_key_data_ptr. Changed calling sequence of
     xforum_window_mgr$menu_get_choice to remove the arguments
     function_key_data_ptr and handle_interactive_messages. Also change the
     assignment of gs_multics_mode and aam_multics_mode to be from a call to
     xforum_user_profile instead of from the xforum_info structure
     Changed calling sequence of xforum_dyn_menu_$get_choice to remove the
     function_key_data_ptr argument.

     85-01-10 Davids: Modified the internal proc get_curr_meeting to call
     xforum_user_profile$get_menu_always instead of relying on a static
     value passed into xforum_main_options.

     85-01-16 Davids: Changed QUERY_USAGE the help line text output for a
     meeting name query to have the same format as the rest of the help lines.

     85-01-24 Davids: Added handling of the xforum_meeting_info.flags.set
     switch to the reinstate_mtg_status internal proc.

     85-01-25 Davids: Modified the internal proc get_choice_from_menu so that
     the list of menu options includes a "ENTER MEETING NAME" as every Nth
     option, where N is set to be the last option on each menu.

     85-01-28 Davids: Modified the internal proc find_meeting so that the
     fields, changed, been_to, and mbz are set correctly. NONE of these
     fields were been set! Also changed how no_participant was being
     incremented to be based on the participant field instead of the attended
     field. Also corrected the if statement that positions a new meeting in
     the meeting list so that it looks for the meeting with a name that occurs
     after it and stops instead of a name that occurs before it and stops.
     Its old behavior usually made it the first meeting in the list.

     85-02-05 Davids: Removed the getting_started entry. Also removed the
     personalization entry which has not been used for some time.

     85-02-11 Davids: Removed the internal procs attend_meetings,
     attend_a_meeting, reinstate_mtg_status, and close_meeting. Added the entry
     index_of_next_meeting. Changed all calls to attend_meetings to calls to
     xforum_ent_attend_mtg_menu. Removed quite a few now unused declarations.

     85-02-13 Davids: Changed calling sequence of xforum_help_line_$push
     to include the new F3_message argument.

     85-02-19 Davids: Added calls to xforum_sub_attend_mtg_menu.
   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */


/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     command_query_$yes_no	 entry () options (variable);
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     signal_		 entry () options (variable);
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_dyn_menu_$display_and_get_choice entry ((*) char (*), fixed bin, char (*), char (*), char (*),
				 fixed bin, ptr, fixed bin);
	dcl     xforum_dyn_menu_$prompt_instead_of_menu entry (char (*), char (*), char (*), char (*), char (*), fixed bin,
				 ptr, char (*) var);
	dcl     xforum_ent_attend_mtg_menu entry (fixed bin, bit (36) aligned, ptr);
	dcl     xforum_find_path_ entry (char(*), fixed bin, char(*), char(*), fixed bin(35));
	dcl     xforum_help_line_$push entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     xforum_status_$update_banner entry (char (*));
	dcl     xforum_sub_attend_mtg_menu entry (fixed bin, bit (36) aligned, ptr);
	dcl     xforum_user_profile$get_menu_always entry () returns (bit (1));
	dcl     xforum_user_profile$get_read_comments_by_subject entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);

/* CONDITIONS */

	dcl     quit		 condition;

/* INTERNAL STATIC */

	dcl     01 xmo_xforum_error_info like xforum_error_info internal static;

/* CONSTANTS */

	dcl     (
	        ALL		 bit (36) aligned init ("111111110000000000000000000000000000"b),
	        CHANGED		 bit (36) aligned init ("000000010000000000000000000000000000"b),
	        FALSE		 bit (1) aligned init ("0"b),
	        GET_ATTENDED	 fixed bin init (2),
	        GET_CHANGED            fixed bin init (3),
                  GET_ELIGIBLE           fixed bin init (1),
	        ME		 char (19) init ("xforum_main_options"),
	        PARTICIPANT		 bit (36) aligned init ("000100000000000000000000000000000000"b),
	        QUERY_USAGE		 char (67) init ("Press  ? and RETURN:help   BREAK:Return to Executive Forum menu"),
	        REDISPLAY		 fixed bin init (5),
	        REDISPLAY2		 fixed bin init (12),
	        TRUE		 bit (1) aligned init ("1"b)
	        )			 internal static options (constant);

/* BUILTINS */

	dcl     (
	        addr,
	        clock,
	        null,
	        rtrim,
	        unspec
	        )			 builtin;

/* BASED */

/* INCLUDE FILES */
%page;
%include forum_dcls;
%page;
%include forum_flags;
%page;
%include forum_info;
%page;
%include forum_user_trans;
%page;
%include menu_dcls;
%page;
%include xforum_error_info;
%page;
%include xforum_info;
%page;
%include xforum_meeting_info;
%page;
%include xforum_meeting_list;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;
%page;
%include xforum_windows;

	call error (0, "Internal programming error - xforum_main_options$xforum_main_options called.");

goto_meeting: entry (gm_xforum_info_ptr);


/* PARAMETERS */

	dcl     gm_xforum_info_ptr	 ptr;		/* (input) */

/* AUTOMATIC */

	dcl     gm_count_ptr	 ptr;
	dcl     gm_curr_meeting	 fixed bin;
	dcl     gm_help_name	 char (17);
	dcl     gm_match_bits	 bit (36) aligned;
	dcl     gm_type		 fixed bin;

/* BASED */

	dcl     gm_count		 fixed bin based (gm_count_ptr);

	xforum_info_ptr = gm_xforum_info_ptr;
	spy_ptr = xforum_info.main_options.spy_ptr;
	gm_curr_meeting = 0;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call xforum_help_line_$pop;
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_4, "QUIT");
		gm_curr_meeting = 0;
		goto exit_goto_meeting;
	     end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	if xforum_info.main_options.choice = ELIGIBLE_MTG
	then do;
	     gm_type = GET_ELIGIBLE;
	     gm_help_name = "eligible_mtg_name";
	     gm_count_ptr = addr (no_selected);
	     gm_match_bits = ALL;
	end;
	else if xforum_info.main_options.choice = ATTENDED_MTG
	then do;
	     gm_type = GET_ATTENDED;
	     gm_help_name = "attended_mtg_name";
	     gm_count_ptr = addr (no_participant);
	     gm_match_bits = PARTICIPANT;
	end;
	else if xforum_info.main_options.choice = CHANGED_MTG
	then do;
	     gm_type = GET_CHANGED;
	     gm_help_name = "changed_mtg_name";
	     gm_count_ptr = addr (no_changed);
	     gm_match_bits = CHANGED;
	end;
	else call error (0, "Internal error in next_meeting proc.");

	if gm_count = 0 & gm_type = GET_CHANGED
	then call handle_no_changed_mtgs;		/* gm_count is set globally */

	if gm_count = 0 then do;
	     call ioa_ ("You have no ^[^;attended^;changed^] meetings.", gm_type);
	     return;
	end;

	if gm_count = 1
	then do;
	     call next_meeting_internal (gm_match_bits,
		gm_curr_meeting,
		xforum_info.main_options.spy_ptr);
	     call ioa_ ("^a meeting automatically selected,^/   it is your only ^[^;attended^;changed^] meeting.",
		forums (gm_curr_meeting).long_name, gm_type);
	     call timer_manager_$sleep (4, "11"b);
	end;
	else call get_curr_meeting (gm_match_bits, SPY_AT_4, gm_help_name, gm_curr_meeting);

	if gm_curr_meeting ^= 0
	then do;
	     if xforum_user_profile$get_read_comments_by_subject ()
	     then call xforum_sub_attend_mtg_menu (gm_curr_meeting, gm_match_bits, spy_ptr);
	     else call xforum_ent_attend_mtg_menu (gm_curr_meeting, gm_match_bits, spy_ptr);
	end;

exit_goto_meeting:
	return;

next_meeting: entry (nm_xforum_info_ptr);


/* PARAMETERS */

	dcl     nm_xforum_info_ptr	 ptr;

/* AUTOMATIC */

	dcl     nm_match_bits	 bit (36) aligned;
	dcl     nm_next_mtg_index	 fixed bin;




	xforum_info_ptr = nm_xforum_info_ptr;
	spy_ptr = xforum_info.spy_ptr;

/* Note that choices 1 through 3 (CHANGED_MTG, ATTENDED_MTD, and ELIGIBLE_MTG)
   are checked because those are the choices that will be set if the user
   does a next meetings from within in the attend meeting menu.
*/

	if xforum_info.main_options.choice = NEXT_MTG | 
             xforum_info.main_options.choice = CHANGED_MTG
	then nm_match_bits = CHANGED;
	else
	     if xforum_info.main_options.choice = MULTICS_MODE |
                  xforum_info.main_options.choice = ATTENDED_MTG
	then nm_match_bits = PARTICIPANT;
	else
	     if xforum_info.main_options.choice = XFORUM_MENU |
                  xforum_info.main_options.choice = ELIGIBLE_MTG
	then nm_match_bits = ALL;

	call next_meeting_internal (nm_match_bits, nm_next_mtg_index, spy_ptr);

	xforum_info.main_options.curr_meeting_index = nm_next_mtg_index;

	if nm_next_mtg_index < no_selected + 1
	then do;
	     if xforum_user_profile$get_read_comments_by_subject ()
	     then call xforum_sub_attend_mtg_menu (nm_next_mtg_index, nm_match_bits, spy_ptr);
	     else call xforum_ent_attend_mtg_menu (nm_next_mtg_index, nm_match_bits, spy_ptr);
	end;

	return;

index_of_next_meeting: entry (ionm_match_bits, ionm_spy_ptr) returns (fixed bin);

/* PARAMETERS */

	dcl     ionm_match_bits	 bit (36) aligned;
	dcl     ionm_spy_ptr	 ptr;

/* AUTOMATIC */

	dcl     ionm_meeting_index	 fixed bin;



	call next_meeting_internal (ionm_match_bits, ionm_meeting_index, ionm_spy_ptr);

	return (ionm_meeting_index);

modify_meeting_list: entry (mml_xforum_info_ptr);


/* PARAMETERS */

	dcl     mml_xforum_info_ptr	 ptr;


	call ioa_ ("Modify Meeting List has not yet been implemented.");

	return;

get_curr_meeting: proc (gcm_match_bits, gcm_spy_id, gcm_help_name, gcm_curr_meeting);


/* PARAMETERS */

	dcl     gcm_match_bits			/* (input) */
				 bit (36) aligned;
	dcl     gcm_spy_id				/* (input) */
				 fixed bin;
	dcl     gcm_help_name			/* (input) */
				 char (17);
	dcl     gcm_curr_meeting			/* (output) */
				 fixed bin;

/* AUTOMATIC */

	dcl     gcm_name_entered	 char (32) varying;


	gcm_curr_meeting = 0;

	if xforum_user_profile$get_menu_always ()
	then do;
display_menu:
	     call get_choice_from_menu (gcm_match_bits, gcm_curr_meeting, gcm_name_entered);
	     if gcm_curr_meeting = -1
	     then goto display_help;
	end;
	else do;
display_help:
	     call xforum_dyn_menu_$prompt_instead_of_menu ("Return to Executive Forum menu", "Enter name of meeting",
		"Meeting names", "meeting name", gcm_help_name, gcm_spy_id, spy_ptr, gcm_name_entered);
	     if gcm_name_entered = "??"
	     then goto display_menu;

	     if gcm_name_entered = ""
	     then gcm_curr_meeting = 0;
	     else call find_meeting (gcm_name_entered, gcm_curr_meeting);

	     if gcm_curr_meeting ^= 0
	     then do;
		if ((unspec (forums (gcm_curr_meeting).flags) & gcm_match_bits) = FALSE)
		then do;				/* ^right type   */
		     if gcm_match_bits = PARTICIPANT
		     then call com_err_$suppress_name (0, ME,
			     "You are not a participant of the ""^a"" meeting.", gcm_name_entered);
		     else call com_err_$suppress_name (0, ME,
			     "The ""^a"" meeting has not changed.", gcm_name_entered);
		     gcm_curr_meeting = 0;
		end;
	     end;
	end;

	return;

     end get_curr_meeting;

get_choice_from_menu: proc (gcfm_match_bits, gcfm_curr_meeting, gcfm_name_entered);


/* PARAMETERS */

	dcl     gcfm_match_bits			/* (input) */
				 bit (36) aligned;
	dcl     gcfm_curr_meeting			/* (output) */
				 fixed bin;
	dcl     gcfm_name_entered			/* (output) */
				 char (32) varying;

/* AUTOMATIC */

	dcl     gcfm_count		 fixed bin;
	dcl     gcfm_option_index	 fixed bin;
	dcl     gcfm_title		 char (50) varying;


	if gcfm_match_bits = ALL
	then do;
	     gcfm_count = no_selected;
	     gcfm_title = " Eligible Meetings Selection ";
	end;
	else if gcfm_match_bits = PARTICIPANT
	then do;
	     gcfm_count = no_participant;
	     gcfm_title = " Attended Meetings Selection ";
	end;
	else if gcfm_match_bits = CHANGED
	then do;
	     gcfm_count = no_changed;
	     gcfm_title = " Changed Meeting Selection ";
	end;

	begin;
	     dcl	   (gcfm_i, gcfm_j)	      fixed bin;
	     dcl	   gcfm_names	      (gcfm_count) char (32) aligned;
	     dcl	   gcfm_nindex	      (gcfm_count) fixed bin;

	     gcfm_i = 0;

	     do gcfm_j = 1 to no_selected;
		if (unspec (forums (gcfm_j).flags) & gcfm_match_bits)
		then do;
		     gcfm_i = gcfm_i + 1;
		     gcfm_names (gcfm_i) = forums (gcfm_j).long_name;
		     gcfm_nindex (gcfm_i) = gcfm_j;
		end;
	     end;

	     call xforum_dyn_menu_$display_and_get_choice ((gcfm_names), gcfm_i, (gcfm_title), "ENTER MEETING NAME",
		"Return to Executive Forum menu", SPY_AT_5, spy_ptr, gcfm_option_index);

	     if gcfm_option_index > 0
	     then do;
		gcfm_curr_meeting = gcfm_nindex (gcfm_option_index);
		gcfm_name_entered = gcfm_names (gcfm_option_index);
	     end;
	     else do;
		gcfm_curr_meeting = gcfm_option_index;
		gcfm_name_entered = "";
	     end;
	end;

     end get_choice_from_menu;

find_meeting: proc (fm_name_entered, fm_midx);


/* PARAMETERS */

	dcl     fm_name_entered			/* (input) */
				 char (32) varying;
	dcl     fm_midx				/* (output) */
				 fixed bin;

/* AUTOMATIC */

	dcl     fm_code		 fixed bin (35);
	dcl     fm_dir		 char (168);
	dcl     fm_fname		 char (32);
	dcl     fm_i		 fixed bin;
	dcl     fm_j		 fixed bin;
	dcl     fm_meeting_version	 fixed bin;
	dcl     fm_new_paths_ptr	 ptr;
	dcl     fm_old_paths_ptr	 ptr;
	dcl     1 fm_fi		 like forum_info;

/* BASED */

	dcl     01 fm_paths_ovly	 based,
		02 npaths		 fixed bin,
		02 paths		 (200) char (168) varying; /* a large constant is need because */
						/* the new npaths will probbaly overlap one of the search */
						/* directories and there fore cannot be set until all the */
						/* serach directories have been moved */




	fm_midx = 0;

	do fm_i = 1 to no_selected;			/* look for it		      */
	     if fm_name_entered = forums (fm_i).long_name
		| fm_name_entered = forums (fm_i).short_name then do;
		fm_midx = fm_i;
		return;
	     end;
	end;					/* not in list - oh dear	      */

	fm_meeting_version = 1;			/* assume its a version 1 meeting */
	call xforum_find_path_ ((fm_name_entered), 1, fm_dir, fm_fname, fm_code);
	if fm_code ^= 0				/* Its not a version 1 meeting */
	then do;
	     fm_meeting_version = 2;			/* now assume its a version 2 meeting */
	     call xforum_find_path_ ((fm_name_entered), 2, fm_dir, fm_fname, fm_code);
	     if fm_code ^= 0
	     then do;
		call ioa_ ("The ""^a"" meeting cannot be found.", fm_name_entered);
		call timer_manager_$sleep (4, "11"b);
		return;
	     end;
	end;

	fm_fi.version = forum_info_version_1;

	call forum_$forum_info (fm_dir, fm_fname, "", clock (), addr (fm_fi), fm_code);
	if fm_code ^= 0 then do;
	     call com_err_$suppress_name (fm_code, ME, fm_name_entered);
	     return;
	end;					/* now find where to put it in list */
	do fm_i = 1 to no_selected;
	     if fm_name_entered < forums (fm_i).long_name then do;
		goto found_in_list;
	     end;
	end;
found_in_list:
	if current_participant ^< fm_i then
	     current_participant = current_participant + 1;

	if current_changed ^< fm_i then
	     current_changed = current_changed + 1;

	fm_old_paths_ptr = addr (xforum_meeting_list.npaths);

	no_selected = no_selected + 1;

	fm_new_paths_ptr = addr (xforum_meeting_list.npaths); /* move the search paths down */
	do fm_j = fm_old_paths_ptr -> fm_paths_ovly.npaths to 1 by -1;
	     fm_new_paths_ptr -> fm_paths_ovly.paths (fm_j) = fm_old_paths_ptr -> fm_paths_ovly.paths (fm_j);
	end;
	fm_new_paths_ptr -> fm_paths_ovly.npaths = fm_old_paths_ptr -> fm_paths_ovly.npaths;


	if fm_i < (no_selected - 1) then		/* ripple rest of list up	      */
	     do fm_j = (no_selected - 1) to fm_i by -1;
		forums (fm_j + 1) = forums (fm_j);
	     end;

	forums (fm_i).long_name = fm_name_entered;
	forums (fm_i).short_name = fm_name_entered;
	forums (fm_i).directory = fm_dir;
	forums (fm_i).forum_version = fm_meeting_version;
	forums (fm_i).two_names = FALSE;
	forums (fm_i).uid = fm_fi.forum_uid;
	forums (fm_i).eligible = fm_fi.eligible;
	forums (fm_i).removed = fm_fi.removed;
	forums (fm_i).notify = fm_fi.notify;
	forums (fm_i).read_only = fm_fi.read_only;
	forums (fm_i).attended = (fm_fi.last_time_attended ^= 0);
	forums (fm_i).participant = forums (fm_i).attended & ^fm_fi.removed;
	if forums (fm_i).participant then
	     no_participant = no_participant + 1;
	if fm_fi.changes_count ^= 0 & forums (fm_i).participant
	then do;
	     no_changed = no_changed + 1;
	     forums (fm_i).changed = "1"b;
	end;
	else forums (fm_i).changed = "0"b;
	forums (fm_i).been_to = "0"b;
	forums (fm_i).mbz = "0"b;
	forums (fm_i).chairman =
	     rtrim (fm_fi.chairman.username) || "." || (fm_fi.chairman.project);

	fm_midx = fm_i;

	return;
     end find_meeting;

next_meeting_internal: proc (nmi_match_bits, nmi_next_mtg_index, nmi_spy_ptr);


/* PARAMETERS */

	dcl     nmi_match_bits			/* (input) */
				 bit (36) aligned;
	dcl     nmi_next_mtg_index			/* (input) */
				 fixed bin;
	dcl     nmi_spy_ptr				/* (input) */
				 ptr;

/* AUTOMATIC */

	dcl     nmi_count_ptr	 ptr;
	dcl     nmi_curr_mtg_ptr	 ptr;
	dcl     nmi_i		 fixed bin;
	dcl     nmi_name_entered	 char (32) varying;
	dcl     nmi_type		 fixed bin;

/* BASED */

	dcl     nmi_count		 fixed bin based (nmi_count_ptr);
	dcl     nmi_curr_mtg	 fixed bin based (nmi_curr_mtg_ptr);


	spy_ptr = nmi_spy_ptr;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb,
		     (0));
		call xforum_help_line_$pop;
		call xforum_status_$redisplay ((0));
		nmi_next_mtg_index = no_selected + 1;
		goto exit_next_meeting_internal;
	     end;

	if nmi_match_bits = ALL then do;
	     nmi_type = GET_ELIGIBLE;
	     nmi_count_ptr = addr (no_selected);
	     nmi_curr_mtg_ptr = addr (current_selected);
	end;
	else if nmi_match_bits = PARTICIPANT then do;
	     nmi_type = GET_ATTENDED;
	     nmi_count_ptr = addr (no_participant);
	     nmi_curr_mtg_ptr = addr (current_participant);
	end;
	else if nmi_match_bits = CHANGED then do;
	     nmi_type = GET_CHANGED;
	     nmi_count_ptr = addr (no_changed);
	     nmi_curr_mtg_ptr = addr (current_changed);
	end;
	else call error (0, "Internal error in next_meeting proc.");

	if nmi_count = 0 & nmi_type = GET_CHANGED
	then call handle_no_changed_mtgs;

	if nmi_count = 0 then do;
	     call ioa_ ("You have no ^[^;attended^;changed^] meetings.", nmi_type);
	     call timer_manager_$sleep (4, "11"b);
	     nmi_curr_mtg = no_selected + 1;
	     nmi_next_mtg_index = nmi_curr_mtg;
	     goto exit_next_meeting_internal;
	end;

	do nmi_i = nmi_curr_mtg + 1 to no_selected;
	     if (unspec (forums (nmi_i).flags) & nmi_match_bits)
	     then
		if (nmi_match_bits = CHANGED | ^forums (nmi_i).been_to)
		then goto next_found;
	end;

          do nmi_i = 1 to nmi_curr_mtg;
	     if (unspec (forums (nmi_i).flags) & nmi_match_bits)
	     then
		if (nmi_match_bits = CHANGED | ^forums (nmi_i).been_to)
		then goto next_found;
	end;


/* obviously none left	      */
	nmi_curr_mtg = no_selected + 1;
	nmi_next_mtg_index = nmi_curr_mtg;
	call ioa_ ("You have no ^[^;attended^;changed^] meetings.", nmi_type);
	call timer_manager_$sleep (4, "11"b);

	goto exit_next_meeting_internal;
	

next_found:
	nmi_curr_mtg = nmi_i;
	nmi_next_mtg_index = nmi_curr_mtg;

	nmi_name_entered = "";

exit_next_meeting_internal:
	return;

     end next_meeting_internal;

handle_no_changed_mtgs: proc;


/* PARAMETERS */

/* INTERNAL AUTOMATIC */

	dcl     hncm_i		 fixed bin;
	dcl     hncm_banner		 char (40);
	dcl     hncm_code		 fixed bin (35);
	dcl     hncm_name		 char (32);
	dcl     hncm_yes_ans	 bit (1);
	dcl     01 hncm_fi		 like forum_info;

	on quit
	     begin;
		call collect_spy_data (SPY_AT_11, "QUIT");
		goto exit_handle_no_changed_mtgs;
	     end;

	hncm_fi.version = forum_info_version_1;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_help_line_$push ("0"b, "", "", QUERY_USAGE);

	call command_query_$yes_no (hncm_yes_ans, 0, "",
	     "     Your meeting list shows no changed meetings.  If you answer" ||
	     "^/yes, each of the meetings you participate in will be checked for" ||
	     "^/changes and your meeting list will be updated.  This process can" ||
	     "^/take several minutes." ||
	     "^/^/Do you want to have your meetings checked and the list updated? ",
	     "You have no changed meetings according to the current changed meeting list." ||
	     "^/Do you want to have your meetings checked and the list updated? ");

	if ^hncm_yes_ans
	then do;
	     call collect_spy_data (SPY_AT_11, "no");
	     goto exit_handle_no_changed_mtgs;
	end;

	call ioa_ ("^/Checking meetings, this may take a while.");

	call collect_spy_data (SPY_AT_11, "yes");

	call xforum_help_line_$push ("0"b, "", "Return to Executive Forum menu", "");

	do hncm_i = 1 to xforum_meeting_list.no_selected;
	     if xforum_meeting_list.forums (hncm_i).participant
	     then do;
		if xforum_meeting_list.forums (hncm_i).forum_version = 1
		then hncm_name = rtrim (xforum_meeting_list.forums (hncm_i).long_name) || ".control";
		else hncm_name = rtrim (xforum_meeting_list.forums (hncm_i).long_name) || ".forum";

		call forum_$forum_info (xforum_meeting_list.forums (hncm_i).directory, hncm_name,
		     "", clock (), addr (hncm_fi), hncm_code);
		if hncm_code ^= 0
		then do;
		     call ioa_ ("The ^a meeting^/has been deleted or renamed since your meeting list was created.",
			xforum_meeting_list.forums (hncm_i).long_name);
		     call ioa_ ("To update your meeting list exit Executive Forum^/and reinvoke it with the -force control argument.");
		     xforum_meeting_list.forums (hncm_i).participant = "0"b;
		     call timer_manager_$sleep (4, "11"b);
		end;
		if hncm_fi.changes_count > 0
		then do;
		     xforum_meeting_list.no_changed = xforum_meeting_list.no_changed + 1;
		     xforum_meeting_list.forums (hncm_i).changed = TRUE;
		end;
	     end;
	end;

exit_handle_no_changed_mtgs:
	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call xforum_help_line_$pop;
	call ioa_$rsnnl ("Eligible ^d, Attended ^d, Changed ^d",
	     hncm_banner, (0), no_selected, no_participant, no_changed);
	call xforum_status_$update_banner (hncm_banner);
	if no_participant ^= 0 & no_changed ^= 0
	then call xforum_status_$redisplay ((0));

	return;

     end handle_no_changed_mtgs;

collect_spy_data: proc (csd_where, csd_response);


/* PARAMETERS */

	dcl     csd_where				/* (input) */
				 fixed bin;
	dcl     csd_response			/* (input) */
				 char (*);



	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

error: proc (e_code, e_reason);


/* PARAMETERS */

	dcl     e_code				/* (input) */
				 fixed bin (35);
	dcl     e_reason				/* (input) */
				 char (512);




	xmo_xforum_error_info.name = "xforum_main_options";
	xmo_xforum_error_info.entry = "";
	xmo_xforum_error_info.doing = "";
	xmo_xforum_error_info.code = e_code;
	xmo_xforum_error_info.reason = e_reason;

	call signal_ ("xforum_fatal_error", null (), addr (xmo_xforum_error_info), null ());

     end error;

     end xforum_main_options;




		    xforum_multics_mode.pl1         08/06/87  1025.1rew 08/06/87  1014.6       93546



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


/****^  HISTORY COMMENTS:
  1) change(85-01-08,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Removed the handle_interactive_messages input arg and replaced it
     with a call to xforum_user_profile$get_handle_interactive_messages
     and an automatic handle_interactive_messages.  There is no way
     that the value in the user's profile will change while in this
     module so the call to xforum_user_profile has to be made only
     once.
     
     85-01-14 Davids: replaced calls to accept_messages and
     defer_messages with calls to xforum_im_mgr$restore_original and
     defer_messages.
     
     85-02-13 Davids: Changed calling sequence of
     xforum_help_line_$change to include the new F3_message argument.
     
     85-04-22 Davids: Added a "0"b paramater to the call of the
     xforum_im_mgr$restor_origial entry.
  2) change(87-07-21,LJAdams), approve(87-07-21,MCR7684),
     audit(87-07-24,Blair), install(87-08-06,MR12.1-1065):
     Eliminated two unreferenced variables.
                                                   END HISTORY COMMENTS */


xforum_multics_mode: proc (menu_window_height);

/*
   BEGIN DESCRIPTION

   function:
      This module implements xforum multics mode. The major aspects of this
      mode are that the user_io window is expanded to include the status and
      menu windows and that the user is queried for a command via a prompt.
      After the command completes the user is prompted for another command,
      a null command, i.e. just a return will return the user to the Xforum
      he was in before he invoked multics mode.

   description of entry points:
      xforum_multics_mode: Quits are traped by a condition handler which causes
      all stack frames above xforum_multics_mode to be unwound and another
      prompt to be issued to the user. The user is not allowed to escape to a
      new command level. The conditions command_question, command_error,
      finish, and stringsize are handled by the standard systen handlers.
      Any other system condition (except quit) is handled by printing the
      messages assocaited with the handler, unwinding the stack, and prompting
      the user for a another command.

   description of internal procedures:
      error: This procedure is called if the command line that the user enters
      cannot be read, it indicates that something is very wrong. The
      xforum_fatal_error condition is signaled, this will cause xforum to
      terminate.

   known bugs:

   notes:

   history:

      84-07-28 Davids: Extracted from the xforum module. 
   
      84-08-13 Davids: Removed the special handling of active_function_error
      which allowed the system handler to be called. The any_other handler
      works just fine. Added a n_read = 0 to the any_other handler. The lack
      of this statement was causing fatal process errors when "pi" was signaled
      (don't understand why). Also added the handle_interactive_messages
      parameter and the code to handle interactive messages. If the flag is set
      then before the prompt is output messages will be accepted. Messages
      already recieved will be printed in the user_io window and then deleted.
      After the user indicates that he wants to return to the menu messages
      will again be defered

      84-08-30 Davids: Changed the any_other handler so that the call to
      find_condition_info_ used the address to an automatic copy of the
      condition_info structure. It was being passed an UNINITIALIZED pointer
      which was causing some very strange problems. Its a wonder it ever
      worked. Added a call to xforum_window_mgr$check_window_status to the quit
      handler so that in case the windows have a screwy status (like from a
      disconnect) they will be reset. Also added a xforum_redisplay_menu
      handler.

      84-09-28 Davids: Removed references to xforum_status_$update_usage and
      redisplay_usage. Replaced them with a call to xforum_help_line$change.

      84-10-22 Davids: Changed message handling so that it is the same as
      Xmail's, except for the -brief control arg for print_messages. Xforum
      will not start using the MR11 message system control args until after a
      controlled release tape is cut.

      84-11-06 Davids: Changed references to xforum_help_line to
      xforum_help_line_.

      84-11-08 Davids: Audit changes: 1) Some spelling and typo corrections
      to the comments. 2) Took all the n_read = 0 statements outof the
      condition handlers and before the first prompt is output and put an
      n_read = 0 after the multics_mode_loop label and before the actual loop.

      84-11-16 Davids: Added the "-brief" argument to the call to
      print_messages This is needed so that the call does not result in a "You
      have no messages" message being output. print_message was incompatibly
      changed.
   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     menu_window_height	 fixed bin;	/* (output) */

/* EXTERNAL STATIC */

	dcl     iox_$user_io	 ptr ext static;

/* ENTRIES */

	dcl     condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char (*), ptr, ptr);
	dcl     cu_$cp		 entry (ptr, fixed bin (21), fixed bin (35));
	dcl     find_condition_info_	 entry (ptr, ptr, fixed bin (35));
	dcl     ioa_$nnl		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     iox_$get_line	 entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     window_$sync	 entry (ptr, fixed bin (35));
	dcl     xforum_help_line_$change entry (bit(8), char(*), char(*), char(*));
	dcl     xforum_im_mgr$defer_messages entry ();
	dcl     xforum_im_mgr$restore_original entry (bit(1) aligned);
	dcl     xforum_user_profile$get_handle_interactive_messages entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$resynch_windows entry (fixed bin, bit (1));

/* CONDITIONS */

	dcl     (
	        any_other,
	        command_error,
	        command_question,
	        finish,
	        quit,
	        stringsize,
	        xforum_redisplay_menu
	        )			 condition;

/* INTERNAL AUTOMATIC */

	dcl     code		 fixed bin (35);
	dcl     handle_interactive_messages bit (1);
	dcl     line		 char (256);
	dcl     n_read		 fixed bin (21);
	dcl     unused_ptr		 ptr;
	dcl     unused_fb		 fixed bin;
	dcl     01 local_condition_info like condition_info;

/* INTERNAL STATIC */

	dcl     01 xmm_xforum_error_info like xforum_error_info internal static;

/* CONSTANTS */

	dcl     (
	        FIRST_PROMPT	 char (80) init ("Enter the command and press RETURN (to return to Xforum just press RETURN):"),
	        LINE_LEN		 fixed bin (21) init (256)
	        )			 internal static options (constant);

/* BUILTINS */

          dcl     addr                   builtin;
	dcl     null		 builtin;
	dcl     substr		 builtin;

/* BASED */

/* INCLUDE FILES */

%page;
%include condition_info;
%page;
%include xforum_error_info;
%page;
%include xforum_windows;

	on command_question system;

	on command_error system;

	on finish system;

	on stringsize system;

	on any_other
	     begin;
		call find_condition_info_ (null (), addr (local_condition_info), code);
		call condition_interpreter_ (null (), unused_ptr, unused_fb, 3,
		     local_condition_info.mc_ptr, (local_condition_info.condition_name),
		     local_condition_info.wc_ptr, local_condition_info.info_ptr);
		call xforum_help_line_$change ("0"b, "", "", FIRST_PROMPT);
		call iox_$control (iox_$user_io, "reset_more", null, (0));
		call ioa_$nnl ("^/Command: ");
		goto multics_mode_loop;
	     end;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call xforum_help_line_$change ("0"b, "", "", FIRST_PROMPT);
		call iox_$control (iox_$user_io, "reset_more", null, (0));
		call ioa_$nnl ("^/Command: ");
		goto multics_mode_loop;
	     end;

	on xforum_redisplay_menu
	     begin;
		call xforum_help_line_$change ("0"b, "", "", FIRST_PROMPT);
		call iox_$control (iox_$user_io, "reset_more", null, (0));
		call ioa_$nnl ("^/Command: ");
		goto multics_mode_loop;
	     end;

	handle_interactive_messages = xforum_user_profile$get_handle_interactive_messages ();

	menu_window_height = xforum_windows.menu.position.extent.height;

	call xforum_window_mgr$resynch_windows (-2, "0"b);

	call xforum_help_line_$change ("0"b, "", "", "Xforum Multics Mode");

	call ioa_$nnl (FIRST_PROMPT || "^/");

	if handle_interactive_messages
	then call xforum_im_mgr$restore_original ("0"b);

multics_mode_loop:
	n_read = 0;
	do while (n_read ^= 1);
	     call iox_$get_line (iox_$user_io, addr (line), LINE_LEN, n_read, code);
	     if code ^= 0
	     then call error (code, "Could not read command line");
	     if n_read > 1
	     then do;
		call xforum_help_line_$change ("0"b, "", "", "Xforum Multics Mode executing: " || substr (line, 1, n_read - 1));
		call window_$sync (iox_$user_io, code);
		call cu_$cp (addr (line), n_read - 1, code);
		call xforum_help_line_$change ("0"b, "", "", FIRST_PROMPT);
		call iox_$control (iox_$user_io, "reset_more", null (), (0));
		call ioa_$nnl ("^/Command: ");
	     end;
	end;

	if handle_interactive_messages
	then call xforum_im_mgr$defer_messages;

	return;

error: proc (e_code, e_reason);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);
	dcl     e_reason		 char (512);

	xmm_xforum_error_info.name = "xforum_multics_mode";
	xmm_xforum_error_info.entry = "";
	xmm_xforum_error_info.doing = "";
	xmm_xforum_error_info.code = e_code;
	xmm_xforum_error_info.reason = e_reason;

	if handle_interactive_messages
	then call xforum_im_mgr$defer_messages;

	call signal_ ("xforum_fatal_error", null (), addr (xmm_xforum_error_info), null ());

     end error;

     end xforum_multics_mode;





		    xforum_personalize_menu.pl1     08/06/87  1025.1rew 08/06/87  1014.2      197568



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

/****^  HISTORY COMMENTS:
  1) change(85-01-14,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Written.
     
     85-01-28 Davids: Added handlinf of F3 (previous menu) and
     corrected initial values for FK_**2 which where wrong.
     
     85-02-13 Davids: Renamed module to xforum_personalize_menu
     
     85-02-13 Davids: Changed calling sequence of
     xforum_help_line_$change and $push to include the new F3_message
     argument.
     
     85-02-14 Davids: Modified so that after the call to xforum_help_
     the status windows is reset and the menu window resizxed and menu
     redisplayed.  This is needed because The call to help could have
     resulted in the general help topics menu being displayed in the
     menu window.
     
     85-04-22 Davids: Added a "0"b paramater to the call of the
     xforum_im_mgr$restor_origial entry.
  2) change(87-04-07,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Added call to xforum_user_profile$set_user_fk_value to save user set value
     (function or escape).
  3) change(87-04-09,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Get wakeup state for msgs from xforum_im_mgr (state can be UNSET, ACCEPT,
     or DEFER).
                                                   END HISTORY COMMENTS */

xforum_personalize_menu: proc (xp_spy_ptr, xp_xforum_system_area_ptr);

/*
   BEGIN DESCTIPTION

   function:
      This module creates, displays, and destroys the Personalize Executive
      Forum menu. Based on the options selected by the user calls are made to
      the xforum_user_profile module to record the personaliztion choices of
      the user.

   description of entry points:
      xforum_personalize_menu: This entry manages the creation, display, and
      destruction of the personalization menu. It also contains the loop which
      displays the menu and gets a user choice. The function keys implemented
      are HELP, FIRST_MENU, QUIT, REDISPLAY, and MULTICS. The internal
      procedure personalize_item is called if the user selects a choice off of
      the menu. Condition handlers for quit, and xforum_redisplay and also
      set up. This entry also assigns entry values into the two arrays that
      correspond to xforum_user_profile$get and $set entries. 
      Before returning to its caller this entry also destroys the menu and
      call xforum_user_profile$update_profile to record the changes made by the
      user so they will be around in new processes.

   description of internal procedures:
      personalize_item: This internal procedure clears the user_io window,
      outputs the current state of the option the user selected. Gives the
      instructions for what kind of input is required, gets the input, and
      checks to be sure it is legal. If it is a help query (?) a call is
      made to xforum_help_. If its one of the choices a call is made to set
      the appropriate choice. If the call is successful a confirmation message
      is output. If the call is not successful nothing is output, it is
      assumed that xforum_user_profile output an appropriate message. All
      text messages, the text of the choices, confirmation messages, etc. are
      stored as internal static option constant arrays where the index of the
      array and the index of the menu option selected are the same.
      This procedure also handles the special actions that may need to be done
      for each choice. This procedure also has a quit condition handler so that
      if quit is "selected" the user still gets a confirmation message
      describing the current state of the option that he selected.
      Note that the user does not have to enter the full text of an option
      choice, the first letter of the input is tested.

      collect_spy_data: This procedure records the user choices from the
      personalization menu and whether quit was hit while in the menu or while
      changiong the state of an option.
   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     xp_spy_ptr		 ptr;		/* (input) */
	dcl     xp_xforum_system_area_ptr ptr;		/* (input) */

/* EXTERNAL STATIC */

	dcl     iox_$user_io	 ptr ext static;

/* ENTRIES */

	dcl     com_err_		 entry () options (variable);
	dcl     ioa_		 entry () options (variable);
	dcl     window_$bell	 entry (ptr, fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_create_menu_	 entry ((*) char (*) var, ptr, ptr, fixed bin (35));
          dcl     xforum_get_str_	 entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
	dcl     xforum_help_$get_help	 entry (ptr, char (*), (*) char (*) var, ptr, ptr);
	dcl     xforum_help_line_$change entry (bit(8), char(*), char(*), char(*));
          dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_help_line_$push entry (bit(8), char(*), char(*), char(*));
          dcl     xforum_im_mgr$get_wakeup_state entry () returns (fixed bin (2));
	dcl     xforum_im_mgr$defer_messages entry ();
	dcl     xforum_im_mgr$restore_original entry (bit(1) aligned);
	dcl     xforum_multics_mode	 entry (fixed bin);
	dcl     xforum_user_profile$get_handle_interactive_messages entry () returns (bit (1));
	dcl     xforum_user_profile$set_handle_interactive_messages entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$get_multics_mode entry () returns (bit (1));
	dcl     xforum_user_profile$set_multics_mode entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$get_menu_always entry () returns (bit (1));
	dcl     xforum_user_profile$set_menu_always entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$get_read_comments_by_subject entry () returns (bit (1));
	dcl     xforum_user_profile$set_read_comments_by_subject entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$get_use_function_keys entry () returns (bit (1));
	dcl     xforum_user_profile$set_use_function_keys entry (bit (1)) returns (bit (1));
          dcl     xforum_user_profile$set_user_fk_value entry (fixed bin (2));
          dcl     xforum_user_profile$get_user_fk_value entry returns (fixed bin (2));
          dcl     xforum_user_profile$valid_user_fk_FUNCTION entry returns (bit (1));
	dcl     xforum_user_profile$get_remove_menu_while_editing entry () returns (bit (1));
	dcl     xforum_user_profile$set_remove_menu_while_editing entry (bit (1)) returns (bit (1));
	dcl     xforum_user_profile$update_profile entry options (variable);
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     xforum_status_$update_banner entry (char (*));
	dcl     xforum_status_$update_title entry (char (*));
	dcl     xforum_window_mgr$check_window_status entry options (variable);
	dcl     xforum_window_mgr$menu_display entry (ptr);
	dcl     xforum_window_mgr$menu_get_choice entry (ptr, bit (1) aligned, fixed bin);
	dcl     xforum_window_mgr$resynch_windows entry (fixed bin, bit (1));


/* CONDITIONS */

	dcl     exit_executive_forum	 condition;
	dcl     quit		 condition;
	dcl     xforum_redisplay_menu	 condition;

/* INTERNAL AUTOMATIC */

	dcl     xp_choice		 fixed bin;
	dcl     xp_code		 fixed bin (35);
	dcl     xp_fkey		 bit (1) aligned;
	dcl     xp_menu_ptr		 ptr;
	dcl     xp_menu_window_height	 fixed bin;
	dcl     xp_xforum_user_profile_get_entry (6) entry () variable returns (bit (1));
	dcl     xp_xforum_user_profile_set_entry (6) entry (bit (1)) variable returns (bit (1));
	dcl     01 xp_menu_requirements like menu_requirements;
		     

/* INTERNAL STATIC */
     
          dcl     USE_ESCAPE_KEYS        fixed bin (2) internal static options (constant) init (1);
          dcl     USE_FUNCTION_KEYS      fixed bin (2) internal static options (constant) init (2);
          dcl     UNSET                  fixed bin (2) internal static options (constant) init (0);
		     

/* CONSTANTS */

	dcl     (
	        xp_CHOICE_1		 (6) char (15) init ("subject", "function", "menu", "clear", "xforum", "allow"),
	        xp_CHOICE_1_c	 (6) char (1) init ("s", "f", "m", "c", "x", "a"),
	        xp_CHOICE_1_MSG	 (6) char (150) init (
				 "You will now be using the subject oriented attending meeting menu.",
				 "You will now be using function keys.",
				 "You will now make list selections from a menu",
				 "The menu will be cleared when you are entering a comment with a new subject.",
				 "You will now use the Executive Forum interactive message processor.",
				 "Multics Command Mode is now allowed."),
	        xp_CHOICE_1_VALUE	 (6) bit (1) init ("1"b, "1"b, "1"b, "1"b, "1"b, "1"b),
	        xp_CHOICE_2		 (6) char (15) init ("entry", "escape", "query", "keep", "own", "disallow"),
	        xp_CHOICE_2_c	 (6) char (1) init ("e", "e", "q", "k", "o", "d"),
	        xp_CHOICE_2_MSG	 (6) char (150) init (
				 "You will now be using the entry order oriented attending meeting menu.",
				 "You will now be using escape sequences.",
				 "You will now be queried for list options.",
				 "The menu will be kept on the screen when you are entering a comment with^/   a new subject.",
				 "You will now use your own interactive message processor.",
				 "Multics Command Mode is now not allowed."),
	        xp_CHOICE_2_VALUE	 (6) bit (1) init ("0"b, "0"b, "0"b, "0"b, "0"b, "0"b),
	        xp_CHOICES_MSG	 (6) char (150) init (
				 "You can now choose between the subject and entry order oriented attending^/   menu menus.",
				 "You can now choose to use either function keys or escape sequences.",
				 "You can now choose to have lists displayed as menus or to be queried^/   for a list item",
				 "You can now choose to leave the menu on the screen or clear it and use the^/   space for entering comments.",
				 "You can now choose to use either the Executive Forum or your own interactive^/   message processor.",
				 "You can now choose to allow Multics Command Mode or to disallow it."),
	        xp_CURRENT_STATUS_MSG_ITEM_FALSE (6) char (150) init (
				 "You are currently using the entry order oriented attending meeting menu.",
				 "You are currently using escape sequences.",
				 "You are currently being queried for list items",
				 "Currently the menu is not cleared from the screen when you are entering a^/   comment with a new subject.",
				 "You are currently using your own interactive message processor.",
				 "Multics Command  Mode is currently not allowed."),
	        xp_CURRENT_STATUS_MSG_ITEM_TRUE (6) char (150) init (
				 "You are currently using the subject oriented attending meeting menu.",
				 "You are currently using function keys.",
				 "Lists are currently displayed as menus in the lower part of the screen.",
				 "Currently the menu is cleared from the screen when you are entering a^/   comment with a new subject",
				 "You are currently using the Executive Forum interactive message processor.",
				 "Multics Command Mode is currently allowed."),
	        xp_FK_FIRST_MENU	 fixed bin init (2),
	        xp_FK_FIRST_MENU2	 fixed bin init (9),
	        xp_FK_HELP		 fixed bin init (1),
	        xp_FK_MULTICS	 fixed bin init (8),
	        xp_FK_MULTICS2	 fixed bin init (15),
	        xp_FK_PREVIOUS	 fixed bin init (3),
	        xp_FK_PREVIOUS2	 fixed bin init (10),
	        xp_FK_QUIT		 fixed bin init (4),
	        xp_FK_QUIT2		 fixed bin init (11),
	        xp_FK_REDISPLAY	 fixed bin init (5),
	        xp_FK_REDISPLAY2	 fixed bin init (12),
	        xp_FOREVER		 bit (1) init ("1"b),
	        xp_HELP_ID		 (6) char (32) init (
				 "read_comments", "escape_keys", "prompts_or_menus", "editing_space", "message_window", "multics_mode"),
	        xp_HELP_LINE	 bit (8) init ("11010000"b),
	        xp_MENU_CHOICES	 (6) char (32) varying init (
				 "Read Comments By Subject",
				 "Always Use Escape Sequences",
				 "Display Lists As Menus",
				 "Remove Menu While Editing",
				 "Process Interactive Messages",
				 "Multics Command Mode"),
	        xp_MENU_HEIGHT	 fixed bin init (4)
	        )			 internal static options (constant);


/* BUILTINS */

          dcl     addr                   builtin;
	dcl     char		 builtin;
	dcl     length		 builtin;
	dcl     ltrim		 builtin;
	dcl     rtrim		 builtin;
	dcl     substr		 builtin;
	dcl     translate		 builtin;

/* BASED */

		     
/* INCLUDES */

%include menu_dcls;
%page;
%include xforum_spy;
%page;
%include xforum_prompts;

%include xforum_answers;

%include xforum_help_infos;


	spy_ptr = xp_spy_ptr;

	xp_xforum_user_profile_get_entry (1) = xforum_user_profile$get_read_comments_by_subject;
	xp_xforum_user_profile_get_entry (2) = xforum_user_profile$get_use_function_keys;
	xp_xforum_user_profile_get_entry (3) = xforum_user_profile$get_menu_always;
	xp_xforum_user_profile_get_entry (4) = xforum_user_profile$get_remove_menu_while_editing;
	xp_xforum_user_profile_get_entry (5) = xforum_user_profile$get_handle_interactive_messages;
	xp_xforum_user_profile_get_entry (6) = xforum_user_profile$get_multics_mode;

	xp_xforum_user_profile_set_entry (1) = xforum_user_profile$set_read_comments_by_subject;
	xp_xforum_user_profile_set_entry (2) = xforum_user_profile$set_use_function_keys;
	xp_xforum_user_profile_set_entry (3) = xforum_user_profile$set_menu_always;
	xp_xforum_user_profile_set_entry (4) = xforum_user_profile$set_remove_menu_while_editing;
	xp_xforum_user_profile_set_entry (5) = xforum_user_profile$set_handle_interactive_messages;
	xp_xforum_user_profile_set_entry (6) = xforum_user_profile$set_multics_mode;

	xp_menu_requirements.version = menu_requirements_version_1;
	call xforum_create_menu_ (xp_MENU_CHOICES, addr (xp_menu_requirements), xp_menu_ptr, xp_code);
	if xp_code ^= 0
	then do;
	     call com_err_ (xp_code, "", "Could not create Personalize Executive Forum menu.");
	     goto quick_exit_xforum_personalize_menu;
	end;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$bell (iox_$user_io, (0));
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_16, "QUIT");
		goto get_choice;
	     end;

	call xforum_window_mgr$resynch_windows (xp_MENU_HEIGHT, "1"b);

	call xforum_status_$update_title ("Personalize");
	call xforum_status_$update_banner ("Executive Forum");
	call xforum_status_$redisplay ((0));

	call xforum_window_mgr$menu_display (xp_menu_ptr);

	on xforum_redisplay_menu call xforum_window_mgr$menu_display (xp_menu_ptr);
	call xforum_help_line_$push (xp_HELP_LINE, "", "", "");
get_choice:
	do while (xp_FOREVER);
	     call xforum_help_line_$change (xp_HELP_LINE, "", "", "");
	     call xforum_window_mgr$menu_get_choice (xp_menu_ptr, xp_fkey, xp_choice);

	     if xp_fkey
	     then call collect_spy_data (SPY_AT_16, "F" || rtrim (ltrim (char (xp_choice))));
	     else call collect_spy_data (SPY_AT_16, rtrim (ltrim (char (xp_choice))));

	     if xp_fkey
	     then do;
		if xp_choice = xp_FK_HELP
		then do;
		     call xforum_help_$get_help (xp_menu_ptr, "Personalize", xp_MENU_CHOICES,
			spy_ptr, xp_xforum_system_area_ptr);
		     call xforum_window_mgr$resynch_windows (xp_MENU_HEIGHT, "0"b);
		     call xforum_status_$update_title ("Personalize");
		     call xforum_status_$update_banner ("Executive Forum");
		     call xforum_status_$redisplay ((0));
		     call xforum_window_mgr$menu_display (xp_menu_ptr);
		     end;
		else
		     if xp_choice = xp_FK_FIRST_MENU | xp_choice = xp_FK_FIRST_MENU2
		then goto exit_xforum_personalize_menu;
		else
		     if xp_choice = xp_FK_PREVIOUS | xp_choice = xp_FK_PREVIOUS2
		then goto exit_xforum_personalize_menu;
		else
		     if xp_choice = xp_FK_QUIT | xp_choice = xp_FK_QUIT2
		then do;
		     call xforum_user_profile$update_profile;
		     call menu_$destroy (xp_menu_ptr, (0));
		     signal exit_executive_forum;
		end;
		else
		     if xp_choice = xp_FK_REDISPLAY | xp_choice = xp_FK_REDISPLAY2
		then call xforum_redisplay_;
		else
		     if (xp_choice = xp_FK_MULTICS | xp_choice = xp_FK_MULTICS2) & xforum_user_profile$get_multics_mode ()
		then do;
		     call xforum_multics_mode (xp_menu_window_height);
		     call xforum_window_mgr$resynch_windows (xp_menu_window_height, "0"b);
		     call xforum_redisplay_;
		end;
		else call window_$bell (iox_$user_io, (0));
	     end;
	     else call personalize_item (xp_choice);
	end;

exit_xforum_personalize_menu:
	call xforum_user_profile$update_profile;
	call menu_$destroy (xp_menu_ptr, (0));
	call xforum_help_line_$pop;

quick_exit_xforum_personalize_menu:
	call window_$clear_window (iox_$user_io, (0));
	return;

personalize_item: proc (pi_item_index);

/* PARAMETERS */

	dcl     pi_item_index	 fixed bin;	/* (input) */

/* CONDITIONS */
	dcl     quit		 condition;

/* INTERNAL AUTOMATIC */

          dcl     pi_code                fixed bin (35);
	dcl     pi_input_line	 char (256);
          dcl     reply		 char (256) var;
          dcl     prompt		 char (256) var;
          dcl     user_set_fk_value      fixed bin (2);
	        
/* CONSTANTS */

          dcl     (
                  MAX_LEN                 fixed bin init (256),
                  GET_FK_ESC_CHOICE       fixed bin init (2),
                  PROCESS_IM_MSG          fixed bin init (5)
                  );

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_17, "QUIT");
		call window_$clear_window (iox_$user_io, (0));
		if xp_xforum_user_profile_get_entry (pi_item_index) ()
		then call ioa_ (xp_CHOICE_1_MSG (pi_item_index));
		else call ioa_ (xp_CHOICE_2_MSG (pi_item_index));
		goto exit_personalize_item;
	     end;

	call window_$clear_window (iox_$user_io, (0));

          if pi_item_index = GET_FK_ESC_CHOICE
          then do;
               if xforum_user_profile$valid_user_fk_FUNCTION ()
						/* both function & escape keys are valid for ttp	*/
              then do;
	        call ioa_ (xp_CHOICES_MSG (pi_item_index));
	        user_set_fk_value = xforum_user_profile$get_user_fk_value ();
	        if user_set_fk_value = USE_FUNCTION_KEYS &
                     ^xforum_user_profile$get_use_function_keys ()
                  then if xp_xforum_user_profile_set_entry (pi_item_index) (xp_CHOICE_1_VALUE (pi_item_index)) then ;
						/* reset original user value; this can get reset  */
						/* per invocation by the system if the terminal	*/
						/* does not support function key usage.		*/
	    end;
              else do;
                   call ioa_ ("This terminal type only supports escape sequences.");
                   goto exit_personalize_item;
	    end;
           end;

	call xforum_help_line_$change (""b, "", "", "Press  ? and RETURN:help   BREAK:To leave things unchanged");

	if xp_xforum_user_profile_get_entry (pi_item_index) ()
	then call ioa_ (xp_CURRENT_STATUS_MSG_ITEM_TRUE (pi_item_index));
	else call ioa_ (xp_CURRENT_STATUS_MSG_ITEM_FALSE (pi_item_index));
   
          answer_array.N = FOUR;
          answer_array.max_length = MAX_LEN;
          answer_array.answer (1) = xp_CHOICE_1 (pi_item_index);
	answer_array.answer (2) = xp_CHOICE_1_c (pi_item_index);
	answer_array.answer (3) = xp_CHOICE_2 (pi_item_index);
          answer_array.answer (4) = xp_CHOICE_2_c (pi_item_index);
          prompt = "Please enter only " || rtrim(xp_CHOICE_1(pi_item_index)) || " or " || rtrim(xp_CHOICE_2(pi_item_index));
          call xforum_get_str_ ((prompt), addr(answer_array), PROMPT_HELP, xp_HELP_ID (pi_item_index), reply, pi_code);

get_user_response:
	pi_input_line = substr (reply, 1, length(reply));
	pi_input_line = translate (pi_input_line, "abcdefghjiklmnopqrstuvwxyz", "ABCDEFGHJIKLMNOPQRSTUVWXYZ");

	if pi_input_line = xp_CHOICE_1 (pi_item_index) |
	   substr (pi_input_line, 1, 1) = xp_CHOICE_1_c (pi_item_index)
	then do;
	     call window_$clear_window (iox_$user_io, (0));
	     
	     if pi_item_index = GET_FK_ESC_CHOICE
	     then call xforum_user_profile$set_user_fk_value (USE_FUNCTION_KEYS);
	     if xp_xforum_user_profile_set_entry (pi_item_index) (xp_CHOICE_1_VALUE (pi_item_index))
	     then call ioa_ (xp_CHOICE_1_MSG (pi_item_index));
	end;
	else if pi_input_line = xp_CHOICE_2 (pi_item_index) |
	        substr (pi_input_line, 1, 1) = xp_CHOICE_2_c (pi_item_index)
	then do;
	     call window_$clear_window (iox_$user_io, (0));
	        
	     if pi_item_index = GET_FK_ESC_CHOICE
	     then call xforum_user_profile$set_user_fk_value (USE_ESCAPE_KEYS);
	     if xp_xforum_user_profile_set_entry (pi_item_index) (xp_CHOICE_2_VALUE (pi_item_index))
              then call ioa_ (xp_CHOICE_2_MSG (pi_item_index));
	    end;

	 if pi_item_index = PROCESS_IM_MSG		/* process interactive messages */
	then do;
               if xforum_im_mgr$get_wakeup_state () = UNSET 
               then ;				/* User has neither accept or defer set	*/
	     else if xforum_user_profile$get_handle_interactive_messages ()
	     then call xforum_im_mgr$defer_messages;
	     else call xforum_im_mgr$restore_original ("0"b);
	end;

exit_personalize_item:
	return;

     end personalize_item;

collect_spy_data: proc (csd_where, csd_response);


/* PARAMETERS */

	dcl     csd_where				/* (input) */
				 fixed bin;
	dcl     csd_response			/* (input) */
				 char (*);



	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;


     end xforum_personalize_menu;




		    xforum_redisplay_.pl1           12/03/84  1149.3rew 12/03/84  1112.1       15732



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

xforum_redisplay_: proc ();

/*
   BEGIN DESCRIPTION

   function:
      This module is used to redisplay the entire screen.

      xforum_redisplay: The xforum_redisplay_menu condition is signaled to
      redisplay the menu. A condition is used so that only 1 module is used
      to display a particular menu. The xforum_status_$redisplay entry will
      display both the status window and the help line window.

   description:

   known bugs:

   notes:

   history:
      84-10-16 Davids: Added a call to clear the help line window so that
      when xforum_status$redisplay calls xforum_help_line$redisplay the
      help line will really be redisplayed.
   
   END DESCRIPTION
*/

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     xforum_status_$redisplay entry (fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));

/* CONDITIONS */

	dcl     xforum_redisplay_menu	 condition;

/* INTERNAL AUTOMATIC */

/* INTERNAL STATIC */

/* CONSTANTS */

/* BUILTINS */

/* BASED */

/* INCLUDES */
%page;
%include xforum_windows;

	call window_$clear_window (xforum_windows.status.iocb, (0));
	call window_$clear_window (xforum_windows.menu.iocb, (0));
	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call window_$clear_window (xforum_windows.help_line.iocb, (0));
	signal xforum_redisplay_menu;
	call xforum_status_$redisplay ((0));

	return;

     end xforum_redisplay_;




		    xforum_status_.pl1              02/24/88  0828.2rew 02/24/88  0653.0      151398



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



/****^  HISTORY COMMENTS:
  1) change(85-01-25,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed the truncation string from " ..." to "....".  This was
     done to make very appearent that numbers truncated in the middle
     are not shorter numbers.  Also changed the values of new_field_len
     from a constant 12 if the input value is not "" to its actual
     length + 2.  Did the same for total_field_len except the constant
     there was 20.  The +2 is to separate the new and total fields from
     the banner field.
     
     85-02-21 Davids: Added code in the update_current entry that
     checks the input str for a new_line character.  If one exists it
     uses only the characters to the left of it.  The "..." string is
     appended onto the truncated string to show that something is
     missing.  This was needed so that multi-line subjects could be at
     least partially displayed.  It was decided to truncate instead of
     translating the new line into some other character becuase it was
     felt that the new line represented a logical break point (why else
     have it).
  2) change(88-01-19,LJAdams), approve(88-02-09,MCR7838),
     audit(88-02-19,Blair), install(88-02-24,MR12.2-1027):	
     Changed all field lengths from 80 to 132 in order to accomodate 132
     character terminals.
                                                   END HISTORY COMMENTS */


xforum_status_:

/*
   BEGIN DESCRIPTION

   function:
      This module is used to manage the contents of the status window and the
      help line window. The status window is a 2 line line window above the
      menu window. The first line is named the title line while the second line
      is the data line. The help_line window is a 1 line window below user_io.
      In this module it is called the usage_line. These lines are images of the
      screen output.

   description of entry points:
      initialize: This entry sets the values of some internal static variables
      that are used by the rest of the entries.

      update_total: This entry is used to set the total field in the data_line.
      The new total is input as a string which contains the characters
      "total:". The internal proc UPDATE is used to position the new string on
      the data_line. It is positioned to start in column 1 and will be
      truncated if longer than 20 characters.

      update_new: This entry is used to set the new field in the data line.
      The new new is input as a string which contains the characters "new:".
      The internal proc UPDATE is used to position the new string on the
      data_line. If the new string can fit on the data_line in the space
      left by the total string then the RIGHT_JUSTIFY procedure is called to
      create a new string with enough padding on the left to result in a right
      justified new string. The UPDATE procedure is then called to place the 
      new string on the data line.

      update_banner: This entry is used to place a banner on the data_line.
      If the banner if shorter than the data_line a call to CENTER is made to
      create a new string with enough spaces on the left to cause the banner
      to be centered. A call is then made to UPDATE to position the banner on
      the data_line starting in column 1.

      update_current: This entry is used to place the current meeting index
      on the data line. The current data must fit in the space left over
      from 2 * the space used in the total field or the new field, which ever
      is bigger. This has the effect of centering the current data on the data
      line. A call to RAW_UPDATE is made to place spaces between the total and
      new fields - erasing what was there. Calls are then made to CENTER and
      UPDATE to center the current data within the space determined from the
      calcuation described abive, and place the data on the data line.

      update_title: This entry is used to place a title on the title line.
      A space is added to each end of the title and CENTER is called to center
      the title plus spaces on the line. The dash (-) character is used as a
      pad character instead of spaces. A call to UPDATE is then made to
      position title plus spaces plus dashes on the line. 

      redisplay: This entry is used to cause the text stored in the title, data
      and help lines to be output to the screen. The window_display_ entry is
      used. This entry matches the current text of the windows and changes only
      those characters that need to be changed. window_sync_ calls follow the
      window_display_ calls to force the display instead of waiting for a full
      buffer.

   description of internal procedures:
      CENTER: Given a string, and a length this internal procedure pads the
      input string on the left with enough spaces to cause the string to be
      centered in a string of the given length. This padded string is then
      returned. If the string is greater than the length, it is truncated to
      the input length.

      RIGHT_JUSTIFY: Given a string, and a length this internal procedure pads
      the input string on the left with enough spaces to cause the string to be
      right justified in a string of the given length. This padded string is
      then returned. If the string is greater than the length, it is truncated
      to the input length.

      UPDATE: This internal procedure inserts a given string into one of the
      "lines" (title, data). The string is constrained to start at a
      given column and be no more than a given length. If the string length
      is less than the given length the string is just inserted into the line
      via a call to RAW_UPDATE. If the string length is greater than the given
      length and greater than 4 than the first <input length - 4> characters of
      the string are inserted into the line. These characters are followed by
      " ...". If the string length is less than of equal to 4 but the input 
      length is even less then the first <input length> characters of the
      string are placed in the line.

      RAW_UPDATE: This internal procedure inserts the given string into another
      given string. The string is inserted starting at a given column.

   known bugs:

   notes:

   history
      84-01-?? Deryk Barker: Procedure for handling xforum's status window.
      Some ideas borrowed from xmail's equivalent.

      84-05-03 Davids: Modified so that the status message does not share the
      line with the number of new transactions and the total number of
      transaction. The new and total numbers now share the line with current
      transaction numbers.

      84-07-06 Davids: Added the update_title entry. This will be used to put
      the menu title, including meeting name, into the status line so it can be
      removed from the menu. This will allow the menu title to be displayed
      even if the process is performing local menu display.

      84-07-24 Davids: Created 3 separate variables to hold the data, title,
      and usage lines. This allowed easy spliting of the usage line (help line
      window) from the data and title (status window).

      84-07-25 Davids: Added the redisplay_usage entry so that the only the
      usage message can be redisplayed. This is needed for Multics mode.

      84-07-27 Davids: Added calls to window_$sync to the redisplay and
      redisplay_usage entry points.

      84-07-31 Davids: Removed call to CENTER from update_usage entry. This has
      the effect of left justifying the usage message. Added code in
      update_title to bracket title with spaces before the pad characters are
      added.

      84-08-02 Davids: Added the update_help_line, push_help_line, and
      pop_help_line entry points. This was done so that the help line could be
      updated from within emacs.

      84-09-28 Davids: Deleted the entries redisplay_usage, update_usage,
      update_help_line, push_help_line, and pop_help_line. Modified the
      redisplay entry so that it redisplays the help line by calling
      xforum_help_line$redisplay.

      84-10-03 Davids: Changed the new field length from 9 to 12 to accommodate
      the larger text string "Unseen:".

      84-11-06 Davids: Changed references to xforum_help_line to
      xforum_help_line_.

      84-11-13 Davids: Auditing changes: 1) Moved returns that occured inside
      the begin blocks of the update_new, banner, current, and title entries
      to outside the begin blocks. 2) Changed the initialization of the
      window_image arrau from string (window_image) = "" to just
      window_image = "". 3) Replaced the substr of SPACES to get a string of
      spaces to a reference to copy (in update_current). Other changes:
      Reorganized the declarations.
   END DESCRIPTION
*/

initialize:
     proc ();

/* PARAMETERS */

/* EXTERNAL STATIC */

/* ENTRIES */

	dcl     window_display_	 entry (ptr, (*) char (*), fixed bin (35));
	dcl     xforum_help_line_$redisplay entry options (variable);

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

	dcl     used_cols		 fixed bin;
	dcl     window_image_ptr	 ptr init (addr (static_window_image));


/* INTERNAL STATIC */

	dcl     (
	        banner_field_len	 fixed bin,
	        current_field_len	 fixed bin,
	        data_line		 char (132) init (""),
	        new_field_len	 fixed bin,
	        status_window	 (2) char (132) init ("", ""),
	        static_window_image	 (2) char (132) unal init ("", ""),
	        title_field_len	 fixed bin,
	        title_line		 char (132) init (""),
	        total_field_len	 fixed bin,
	        window_image_width	 fixed bin init (79)
	        )			 internal static;

/* CONSTANTS */


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


/* BUILTINS */

	dcl     (
	        addr,
	        char,
	        copy,
	        divide,
	        index,
	        length,
	        ltrim,
	        max,
	        min,
	        mod,
	        rtrim,
	        substr
	        )			 builtin;

/* BASED */

	dcl     window_image	 (2) char (window_image_width) based (window_image_ptr);

/* INCLUDE FILES */

%include xforum_windows;
%page;
%include window_dcls;

	window_image_width =
	     min (length (static_window_image (1)), xforum_windows.status.width);
	window_image = "";

	total_field_len, new_field_len = 0;

	title_field_len = window_image_width;

	banner_field_len, current_field_len =
	     window_image_width - (total_field_len + new_field_len);

	return;

update_total:
     entry (str);

	dcl     str		 char (*);

	if str ^= ""
	then total_field_len = length (rtrim (str)) + 2; /* 2 space separator */

	call UPDATE (addr (data_line), 1, total_field_len, str);

	if str = ""
	then total_field_len = 0;

	return;

update_new:
     entry (str);

	if str ^= ""
	then new_field_len = length (rtrim (str)) + 2; /* 2 space separator */

	begin;

	     dcl	   field		      char (new_field_len);
	     dcl	   trimmed_value	      char (length (str)) var;
	     dcl	   trimmed_len	      fixed bin;
	     dcl	   starting_col	      fixed bin;

	     starting_col = window_image_width - new_field_len + 1;

	     trimmed_value = ltrim (rtrim (str));

	     trimmed_len = length (trimmed_value);

	     if trimmed_len < new_field_len then do;
		call RIGHT_JUSTIFY ((trimmed_value), field);
		call UPDATE (addr (data_line), starting_col, new_field_len, field);
	     end;
	     else call UPDATE (addr (data_line), starting_col, new_field_len, str);

	     if str = ""
	     then new_field_len = 0;

	end;					/* begin */

	return;

update_banner:
     entry (str);

	begin;

	     dcl	   field		      char (banner_field_len);
	     dcl	   trimmed_value	      char (length (str)) var;
	     dcl	   trimmed_len	      fixed bin;


	     trimmed_value = ltrim (rtrim (str));
	     trimmed_len = length (trimmed_value);

	     if trimmed_len < banner_field_len then do;
		call CENTER ((trimmed_value), field, " ");
		call UPDATE (addr (data_line), 1, banner_field_len, field);
	     end;
	     else call UPDATE (addr (data_line), 1, banner_field_len, str);

	end;					/* begin */

	return;

update_current: entry (str);

/* AUTOMATIC */

dcl uc_nl_index fixed bin;
	      



          used_cols = 2 * max (total_field_len, new_field_len);

	current_field_len = window_image_width - used_cols;

	begin;

	     dcl	   field		      char (current_field_len);
	     dcl	   trimmed_value	      char (length (str)) var;
	     dcl	   trimmed_len	      fixed bin;
	     dcl	   starting_col	      fixed bin;

	     starting_col = total_field_len + 1;

	     call RAW_UPDATE (addr (data_line), total_field_len + 1,
		window_image_width - total_field_len - new_field_len,
		copy (" ", window_image_width - total_field_len - new_field_len));

               uc_nl_index = index (str, xs_NL);
               if uc_nl_index = 0
	     then trimmed_value = ltrim (rtrim (str));
               else trimmed_value = ltrim (rtrim (substr (str, 1, uc_nl_index - 1))) || "...";
	     trimmed_len = length (trimmed_value);

	     if trimmed_len < current_field_len then do;
		call CENTER ((trimmed_value), field, " ");
		call UPDATE (addr (data_line), starting_col, current_field_len, field);
	     end;
	     else call UPDATE (addr (data_line), starting_col, current_field_len, str);

	end;					/* begin */

	return;

update_title: entry (str);

	begin;

	     dcl	   field		      char (title_field_len);
	     dcl	   trimed_value	      char (length (str)) var;
	     dcl	   trimed_value_len	      fixed bin;

	     trimed_value = ltrim (rtrim (str));
	     trimed_value_len = length (trimed_value);

	     call CENTER (" " || trimed_value || " ", field, "-");

	     call UPDATE (addr (title_line), 1, title_field_len, field);

	end;

	return;

redisplay:
     entry (P_code);

	dcl     P_code		 fixed bin (35);

	status_window (1) = title_line;
	status_window (2) = data_line;

	call window_display_ (xforum_windows.status.iocb, status_window,
	     P_code);
	call window_$sync (xforum_windows.status.iocb, P_code);

	call xforum_help_line_$redisplay;

	return;

CENTER:
     proc (P_str, P_field, P_pad);

	dcl     (P_str, P_field)	 char (*);
	dcl     P_pad		 char (1);
	dcl     (field_len, str_len, n_pad, l_pad, r_pad)
				 fixed bin;

	field_len = length (P_field);
	str_len = length (P_str);

	if str_len >= field_len then do;
	     P_field = P_str;
	     return;
	end;
	n_pad = field_len - str_len;
	l_pad = divide (n_pad, 2, 17, 0);
	r_pad = l_pad + mod (n_pad, 2);
	P_field = copy (P_pad, l_pad) || P_str || copy (P_pad, r_pad);

     end CENTER;

RIGHT_JUSTIFY:
     proc (P_str, P_field);

	dcl     (P_str, P_field)	 char (*);
	dcl     (field_len, str_len, n_pad)
				 fixed bin;

	field_len = length (P_field);
	str_len = length (P_str);

	if str_len >= field_len then do;
	     P_field = P_str;
	     return;
	end;

	n_pad = field_len - str_len;

	P_field = copy (" ", n_pad) || P_str;


     end RIGHT_JUSTIFY;

UPDATE:
     proc (line_ptr, col, len, new_value);

	dcl     line_ptr		 ptr;
	dcl     (col, len)		 fixed bin,
	        new_value		 char (*);
	dcl     short_new_value	 defined (new_value) char (len),
	        trunc_new_value	 defined (new_value)
				 char (len - length (TRUNCATION_STRING));
	dcl     TRUNCATION_STRING	 init ("....") char (4) static options (constant);

	if len >= length (new_value) then
	     call RAW_UPDATE (line_ptr, col, len, new_value);
	else if len <= length (TRUNCATION_STRING)
	     | len >= length (rtrim (new_value)) then
	     call RAW_UPDATE (line_ptr, col, len, short_new_value);
	else do;
	     call RAW_UPDATE (line_ptr, col, length (trunc_new_value),
		trunc_new_value);
	     call RAW_UPDATE (line_ptr, col + length (trunc_new_value),
		length (TRUNCATION_STRING), TRUNCATION_STRING);
	end;


     end UPDATE;

RAW_UPDATE:
     proc (ru_line_ptr, col, len, new_value);

	dcl     ru_line_ptr		 ptr;
	dcl     (col, len)		 fixed bin,
	        new_value		 char (*);
	dcl     ru_line		 char (132) based (ru_line_ptr);

	dcl     field_p		 ptr,
	        field_l		 fixed bin,
	        field		 char (field_l) based (field_p);


	field_p = addr (substr (ru_line, col));
	field_l = len;
	if char (new_value, len) ^= field then
	     field = new_value;

     end RAW_UPDATE;

     end xforum_status_;




		    xforum_sub_attend_mtg_menu.pl1  08/06/87  1025.1rew 08/06/87  1014.9      446868



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


/****^  HISTORY COMMENTS:
  1) change(85-02-19,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Created by copying the xforum_ent_attend_mtg_menu module.
     
     85-03-19 Davids: Fixed the next_subject procedure so that if no
     unread subject is found it will still update the status
     information.  this requires re-reading the old current message to
     get the status.  This is needed so that deleted and expunged
     transactions found during the search for a new subject are removed
     from unread count displayed in the status line.  Also fixed a
     problem with referencing the last seen transaction when the user
     has just entered a meeting.  The user's current transaction is set
     to his last seen transaction.  The transaction is read, the
     subject recorded and the transaction freed.  If the last seen
     transaction was deleted an error will occur when the transaction
     is freed - the error code returned from the read was not checked.
     Now if the last seen transaction cannot be read the current
     transaction is set to the first transaction (first
     undeleted/unreaped).  If an attempt to read the first transaction
     fails an error is reported and the procedured is exited.
  2) change(85-03-25,Davids), approve(86-02-07,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added code to options 6 and 9 so that enter_trans is only called
     if the read_only flag for the meeting is off.  If its on an error
     message is output.  This saves the user from having to enter a
     comment only to find out that he cannot do anything with it.
     
     85-03-27 Davids: Replaced code in attend_a_meeting that now is in
     the set_up_meeting entry of xforum_attend_mtg_utilities with a
     call to that entry.  Also modified the code handling the help
     function to reset the title line of the status window and
     redisplay the status and help line windows.  This is needed if the
     user had the general topics menu display.
     
     85-04-04 Davids: Implemented the select_subject procedure and
     added the transactions_processed_message procedure which is used
     by the select_subject procedure.
     
     85-05-06 Davids: Added a test of aam_fidx after the call to
     set_up_meeting in attend_a_meeting.  If aam_fidx is 0 the meeting
     was not opened so a return is done.  Any error message was output
     by set_up_meeting.
  3) change(85-06-05,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     In the select_comment procedure, moved the call to
     xforum_help_line_$push so that it occurs before the ioa call which
     outputs the prompt.  It was after the prompt which caused it to be
     executed after every invalid entry in which case the prompt was
     reissued.  This would cause the help_line stack to fill up.  Also
     added a call to clear the window before an error message is
     output.
     
     85-06-20 Davids: Changed calling sequence of xforum_format_$append
     so that the bit_count parameter which is input/output comes after
     all the input parameters (i.e.  the bit (1) switch).
  4) change(86-02-18,LJAdams), approve(86-02-18,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Setting xforum_meeting_info.current to 0 prior to closing meeting or quit.
  5) change(87-04-15,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Changed to allow_command_processor_ escapes.  Used constants for screen
     options to get rid of magic numbers.
                                                   END HISTORY COMMENTS */

xforum_sub_attend_mtg_menu: proc (xsamm_curr_meeting_index, xsamm_match_bits, xsamm_spy_ptr);

/*
   BEGIN DESCRIPTION

   function:
      This module creates, displays and destroys the subject oriented attend
      meeting menu. It also implements all the functions related to the options
      in the menu.

   description of entry points:
      xforum_sub_attend_mtg_menu: This entry is a simple loop that calls
      the internal procedure attend_a_meeting and then gets the next meeting
      index and calls attend_a_meeting again. The loop is broken when the
      user exits a meeting and indicates that he does not want to go to another
      meeting (attend_a_meeting returns xsamm_more as false) or
      attend_a_meeting is given an invalid meeting index (which will happen if
      there is no next meeting, xsamm_more is again returned as false).

   description of internal procedures:
      attend_a_meeting: This procedure is used to attend a meeting. It first
      checks to be sure that the input meeting index is valid, if not it
      returns (the more flag is false). If it is a valid index it sets up
      condition handlers, initializes the meeting_info structure, gets all
      the forum info on the meeting, and creates the menu. It then displays
      the menu and loops getting user selections and calling procedures to
      execute those selections. When the user stops attending the meeting
      the meeting is closed and the menu destroyed.

      display_trans: This procedure is used to display transaction. The bottom
      window is first cleared. A loop is entered which calls
      xforum_get_selected_trans to get a pointer to a selected transaction,
      the transaction number is used to update the status window and the
      transaction displayed via xforum_format_. The loop continues until
      a invalid_trans_idx error code is returned. Other error codes are
      ignored. The loop is initialized via a call to xforum_get_selected_trans.
      Xforum_get_selected_trans handles all the details of determining what
      transactions have been selected and how to get them in sequential order.

      enter_trans: This procedure is called when replying to a transaction or
      when entering a new transaction. An input flag indicates which operation
      the user is performing. The emacs extension is found by absolute pathname
      passed into emacs_. The absolute pathname is determined by finding the
      absolute pathname of the current module and then changing the entry name.
      This is done via the calls to hcs_$make_ptr and hcs_$fs_get_path_name
      after the here label. A special segment is created in the process dir for
      storing the users transaction. If the user is replying then another
      segment is created for storing the transaction the user is replying to.
      The pointers to these transactions are stored as internal static so the
      segments can be reused. The user's comemnt is added to the forum meeting
      via a call to forum_$enter_trans.

      next_trans: This procedure selects the next transaction as the current
      transaction and displays the transaction via a call to xforum_format_.
      The next transaction is found via a call to xforum_trans_. A subject
      chain will not be followed. The current transaction must be either a
      single transaction or a range of transaction, i.e. I:J for there to be
      a next transaction.

      prev_trans: This procedure selects the previous transaction as the
      current transaction and displays the transaction via a call to
      xforum_format_. The previous transaction is found via a call to
      xforum_trans_. A subject chain will not be followed. The current
      transaction must be either a single transaction or a range of
      transaction, i.e  I:J for there to be a previous transaction.

      list_transaction: This procedure looks remarkably like the display
      procedure. The only differences are that xforum_format_$list is called
      instead of xforum_format_$display.

      select_trans_spec: This procedure prompts the user for a transaction
      spec. Once the spec has been input a call is made to
      xforum_validate_trans_spec to check the spec and set the current
      transactions. The prompting is done via ioa_ instead of via
      command_query. Help processing is handling by actually checking to see if
      the input was a "?" character an calling xcforum_help_$display if it was.

      copy_comments: This procedure uses ioa_ to query the user for a file
      name. A name of ? is checked for an a help message is output via
      xforum_help_. A name of ?? is checked for and a message indicating that
      no menu is available is output. Invalid names are determined
      For the case of a ?, ??, or invalid name the prompt is repeated.
      The users ?, ??, invalid file names and valid file names are recorded
      in the spy structure. invalid file names all have the name "invalid".
      valid file names are recorded as "name" or "pathname" depending on if 
      they contain a > or <. The actual names are not recorded.
      For a valid file name the segment is initiated, if it does not exist it
      is created. If it cannot be created an error is output and the code
      returns. A message is then output saying that the writting is taking
      place. The second part of this procedure looks exactly like the display
      procedure. The only difference is xforum_format_$append is called instead
      of $display and that the number of comments actually processed is
      counted. The last thing that this procedure does is clear the bottom
      window and output a message saying how many transactions were output
      and giving the file name.

      next_unread_trans: This procedure set the current transaction to the next
      unread transaction and then display teh current transaction. The value of
      the next unread transaction is updated by the call to update_status.

      meeting_maintenance: This procedure will be used to generate the meeting
      maintenance menu and respond to selections made from that menu. Currently
      it just outputs a message saying that it is unimplemented.

      update_status: This procedure has three functions. First it updates
      the forum statistics. It sets the seen flag for version 2 forums and
      the last_seen_idx for version 1 meetings (if of course the input trans
      idx is larger than the current last seen idx). Second it updates the
      statistics kept in the meeting list by calling forum_ to get the lastest
      statistics, these statistics of course reflect the updates just entered.
      Third it uses the new statistics to output updated totals and new in the
      status line. NOTE that this procedure is called right BEFORE the
      transaction is displayed. There is therefore a small window when forum
      thinks that the user has seen a transaction but it has not yet been
      displayed. Things were done this way so that the status line could
      reflect the current transaction and the number of new transaction minus
      the transaction just selected before the display was started. The
      alternative would be to have the forum and xforum statics out of sync.

      collect_spy_data: This is exactly the same as every other
      collect_spy_data. See xforum_main_options.

      error: This is exactly the same as every other error. See
      xforum_main_options.

   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     xsamm_curr_meeting_index fixed bin;	/* (input) */
	dcl     xsamm_match_bits	 bit (36) aligned;
	dcl     xsamm_spy_ptr	 ptr;

/* GLOBAL */

/* EXTERNAL STATIC */

	dcl     forum_error_table_$invalid_trans_idx fixed bin (35) ext static;
	dcl     forum_error_table_$trans_deleted fixed bin (35) ext static;
	dcl     forum_error_table_$trans_reaped fixed bin (35) ext static;
	dcl     iox_$user_io	 ptr ext static;


/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     get_temp_segments_	 entry (char (*), (*) ptr, fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rsnnl		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     window_$bell	 entry (ptr, fixed bin (35));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     window_$overwrite_text entry (ptr, char (*), fixed bin (35));
	dcl     window_$position_cursor 
                                         entry (ptr, fixed bin, fixed bin, fixed bin (35));
	dcl     window_$sync	 entry (ptr, fixed bin (35));
	dcl     xforum_attend_mtg_utilities$close_meeting
			           entry (ptr, ptr, fixed bin, fixed bin, ptr);
	dcl     xforum_attend_mtg_utilities$copy_to_name
                                         entry (ptr, char (32), ptr, fixed bin (24));
	dcl     xforum_attend_mtg_utilities$enter_trans 
                                         entry (ptr, fixed bin, ptr, bit (1) aligned, bit (1) aligned);
	dcl     xforum_attend_mtg_utilities$next_unread_comment
                                         entry (ptr, fixed bin, fixed bin, ptr);
	dcl     xforum_attend_mtg_utilities$set_up_meeting
                                         entry (ptr, ptr, fixed bin, bit (1) aligned, fixed bin, char (256), char (256));
	dcl     xforum_attend_mtg_utilities$update_status
                                         entry (ptr, fixed bin, char (*), fixed bin, fixed bin);
	dcl     xforum_create_menu_	 entry ((*) char (*) var, ptr, ptr, fixed bin (35));
	dcl     xforum_dyn_menu_$display_and_get_choice
                                         entry ((*) char (*), fixed bin, char (*), char (*), char (*), 
                                         fixed bin, ptr, fixed bin);
	dcl     xforum_dyn_menu_$prompt_instead_of_menu
                                         entry (char (*), char (*), char (*), char (*), char (*), fixed bin,
				 ptr, char (*) var);
	dcl     xforum_format_$append	 entry (ptr, ptr, bit (1) aligned, fixed bin (24), fixed bin (35));
	dcl     xforum_format_$display entry (ptr, bit (1) aligned, fixed bin (35));
	dcl     xforum_get_selected_trans$first
                                         entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_selected_trans$next
                                         entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_str_	 entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
	dcl     xforum_help_$get_help	 entry (ptr, char (*), (*) char (*) var, ptr, ptr);
	dcl     xforum_help_line_$change
                                         entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_help_line_$push entry (bit (8), char (*), char (*), char (*));
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_main_options$index_of_next_meeting entry (bit (36) aligned, ptr) returns (fixed bin);
	dcl     xforum_multics_mode	 entry (fixed bin);
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_status_$update_title
                                         entry (char (*));
	dcl     xforum_status_$redisplay
                                         entry (fixed bin (35));
	dcl     xforum_trans_$next_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$prev_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$read	 entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_user_profile$get_menu_always
                                         entry () returns (bit (1));
	dcl     xforum_user_profile$get_multics_mode
                                         entry () returns (bit (1));
	dcl     xforum_window_mgr$check_window_status
                                         entry options (variable);
	dcl     xforum_window_mgr$menu_display
                                         entry (ptr);
	dcl     xforum_window_mgr$menu_get_choice
                                         entry (ptr, bit (1) aligned, fixed bin);
	dcl     xforum_window_mgr$resynch_windows
                                         entry (fixed bin, bit (1));

/* CONDITIONS */

	dcl     cleanup		 condition;
	dcl     exit_executive_forum	 condition;
	dcl     quit		 condition;
	dcl     xforum_redisplay_menu	 condition;

/* INTERNAL AUTOMATIC */

	dcl     xsamm_next_mtg_index	 fixed bin;
	dcl     xsamm_more		 bit (1) aligned;

/* INTERNAL STATIC */


/* CONSTANTS */

	dcl     ALL		 bit (36) aligned init ("111111110000000000000000000000000000"b) internal static options (constant);
	dcl     CHANGED		 bit (36) aligned init ("000000010000000000000000000000000000"b) internal static options (constant);
	dcl     FALSE		 bit (1) aligned init ("0"b) internal static options (constant);
          dcl     MAX_LEN                fixed bin init (256) internal static options (constant); 
	dcl     ME		 char (26) init ("xforum_sub_attend_mtg_menu")
				 internal static options (constant);
	dcl     NL		 char (1) init ("
") internal static options (constant);
	dcl     ON		 bit (1) aligned init ("1"b) internal static options (constant);
	dcl     PARTICIPANT		 bit (36) aligned init ("000100000000000000000000000000000000"b) internal static options (constant);
	dcl     QUERY_USAGE		 char (69) init ("Press  ? and RETURN:help   BREAK:To leave current comments unchanged")
				 internal static options (constant);
          dcl (                          /* SUBJECT MTG CHOICES */
              DISPLAY_UNREAD             fixed bin init (1),
	    DISPLAY_CURRENT            fixed bin init (2),
	    DISPLAY_NEXT               fixed bin init (3),
	    DISPLAY_PREV               fixed bin init (4),
	    DISPLAY_ALL		 fixed bin init (5),
	    REPLY			 fixed bin init (6),
	    NEXT_SUBJ_UNREAD           fixed bin init (7),
	    GET_SUBJECT		 fixed bin init (8),
	    TALK			 fixed bin init (9),
	    COPY_SUBJECT		 fixed bin init (10),
	    SKIP_REST_SUBJ		 fixed bin init (11),
	    GET_COMMENT		 fixed bin init (12),
	    GET_NEXT_MTG		 fixed bin init (13),
	    MTG_MAINTENANCE		 fixed bin init (14)
              )			 int static options (constant);


          dcl (                          /* mtg type */
              GET_ATTENDED               fixed bin init (2),
	    GET_CHANGED		 fixed bin init (3),
              GET_ELIGIBLE               fixed bin init (1)
	    )			 int static options (constant);

/* BUILTINS */

	dcl     addr		 builtin;
	dcl     char		 builtin;
	dcl     convert		 builtin;
	dcl     index		 builtin;
	dcl     length		 builtin;
	dcl     ltrim		 builtin;
	dcl     mod		 builtin;
	dcl     null		 builtin;
	dcl     rtrim		 builtin;
	dcl     string		 builtin;
	dcl     substr		 builtin;
	dcl     verify		 builtin;

/* BASED */


/* INCLUDE FILES */

%include access_mode_values;
%page;
%include forum_dcls;
%page;
%include forum_flags;
%page;
%include forum_user_trans;
%page;
%include menu_dcls;
%page;
%include xforum_error_info;
%page;
%include xforum_meeting_info;
%page;
%include xforum_meeting_list;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;
%page;
%include xforum_windows;
%page;
%include xforum_answers;



%include xforum_prompts;


%include xforum_help_infos;


	call attend_a_meeting (xsamm_curr_meeting_index, xsamm_match_bits, xsamm_more, xsamm_spy_ptr);
	do while (xsamm_more);
	     xsamm_next_mtg_index = xforum_main_options$index_of_next_meeting (xsamm_match_bits, xsamm_spy_ptr);
	     call attend_a_meeting (xsamm_next_mtg_index, xsamm_match_bits, xsamm_more, xsamm_spy_ptr);
	end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call window_$clear_window (xforum_windows.menu.iocb, (0));

	return;

attend_a_meeting: proc (aam_midx, aam_match_bits, aam_more, aam_spy_ptr);

	dcl     aam_subject		 char (256);
	dcl     aam_match_bits	 bit (36) aligned;
	dcl     aam_midx		 fixed bin;
	dcl     aam_more		 bit (1) aligned;
	dcl     aam_chairman_msg_exists bit (1) aligned init (FALSE);
	dcl     aam_print_chairman_msg bit (1) aligned init (FALSE);
	dcl     aam_chairman_msg	 char (256);
	dcl     aam_fidx		 fixed bin;
	dcl     aam_type		 fixed bin;
	dcl     aam_meeting_type	 (3) char (9) varying
				 init ("Eligible ", "Changed ", "Attended ");
	dcl     aam_headers		 (1) char (44) varying;
						/* control strings   */
	dcl     aam_total_ctl	 char (9) init ("Total: ^d");
	dcl     aam_new_ctl		 char (10) init ("Unread: ^d");
	dcl     aam_current_ctl	 char (23) init ("Current Subject: ^a:^i");
	dcl     aam_choices		 (14) char (40) varying
				 init (
				 "Display Unread Comment(s)",
				 "Display Current Comment",
				 "Display Next Comment",
				 "Display Previous Comment",
				 "Display All Comments",
				 "Reply To Current Comment",
				 "Next Subject With Unread Comments",
				 "Select Subject",
				 "Start New Discussion",
				 "Copy Current Subject",
				 "Skip Rest of Current Subject",
				 "Select/Display Comment Number",
				 "",
				 "Meeting Maintenance");
	dcl     aam_mtg_menu_height	 fixed bin init (8);
	dcl     aam_menu_window_height fixed bin;
	dcl     1 aam_mtg_requirements like menu_requirements;
	dcl     aam_mtg_menu_ptr	 ptr init (null);
	dcl     aam_code		 fixed bin (35);
	dcl     aam_spy_ptr		 ptr;
	dcl     aam_current_menu_ptr	 ptr;
	dcl     aam_fkey		 bit (1) aligned;
	dcl     aam_choice		 fixed bin;
	dcl     aam_multics_mode	 bit (1);

/* CONSTANTS */

	dcl     (
	        aam_FIRST_MENU	 fixed bin init (2),
	        aam_FIRST_MENU2	 fixed bin init (9),
	        aam_HELP		 fixed bin init (1),
	        aam_MULTICS		 fixed bin init (8),
	        aam_MULTICS2	 fixed bin init (15),
	        aam_PREV_MENU	 fixed bin init (3),
	        aam_PREV_MENU2	 fixed bin init (10),
	        aam_QUIT		 fixed bin init (4),
	        aam_QUIT2		 fixed bin init (11),
	        aam_READ_ONLY_MESSAGE	 char (150) init (
				 "You are not allowed to enter comments in this meeting." ||
				 "^/Send mail to ^a for an explanation and/or a change in status."),
	        aam_REDISPLAY	 fixed bin init (5),
	        aam_REDISPLAY2	 fixed bin init (12),
	        aam_REPLY		 bit (1) aligned init ("1"b),
	        aam_TALK		 bit (1) aligned init ("0"b)
	        )			 internal static options (constant);

	aam_more = "0"b;

	if aam_midx < 1 | aam_midx > no_selected
	then return;

	spy_ptr = aam_spy_ptr;

	aam_multics_mode = xforum_user_profile$get_multics_mode ();

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$bell (xforum_windows.menu.iocb, (0));
		call xforum_help_line_$change ("10110000"b, "Leave Meeting", "", "");
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_7, "QUIT");
		xforum_meeting_info.current = 0;
		goto meeting_get_choice;
	     end;

	on cleanup
	     begin;
		if aam_fidx ^= -1 then do;
                         xforum_meeting_info.current = 0;
		     call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
			xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);
                    end;
	     end;

	call xforum_attend_mtg_utilities$set_up_meeting (xforum_meeting_list_ptr, xforum_meeting_info_ptr, aam_midx, "1"b,
	     aam_fidx, aam_subject, aam_chairman_msg);
	if aam_fidx = 0
	then return;

	if aam_match_bits = ALL then
	     aam_type = GET_ELIGIBLE;
	else if aam_match_bits = CHANGED then
	     aam_type = GET_ATTENDED;
	else if aam_match_bits = PARTICIPANT then
	     aam_type = GET_CHANGED;

	aam_headers (1) = "Attending " || rtrim (xforum_meeting_info.name) || " meeting";
	call xforum_status_$update_title ((aam_headers (1)));

	aam_choices (13) = "Go To Next " || aam_meeting_type (aam_type) || "Meeting";

	call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
	     0, aam_subject, 0, aam_fidx);
	call xforum_window_mgr$resynch_windows (aam_mtg_menu_height, "1"b);

	aam_mtg_requirements.version = menu_requirements_version_1;

	call xforum_create_menu_ (aam_choices, addr (aam_mtg_requirements), aam_mtg_menu_ptr, aam_code);
	if aam_code ^= 0 then do;
	     call com_err_$suppress_name (aam_code, ME, "Trying to create meeting menu.");
	     goto exit_attend_a_meeting;
	end;

	call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);

	on xforum_redisplay_menu
	     call xforum_window_mgr$menu_display (aam_mtg_menu_ptr); /* for redisplay function	      */

	if rtrim (aam_chairman_msg) ^= ""
	then call ioa_ ("^a", aam_chairman_msg);

	aam_current_menu_ptr = aam_mtg_menu_ptr;

/* get choice					*/

meeting_get_choice:
	do while (ON);
	     call xforum_window_mgr$menu_get_choice (aam_mtg_menu_ptr, aam_fkey, aam_choice);

	     if aam_fkey
	     then call collect_spy_data (SPY_AT_7, "F" || rtrim (ltrim (char (aam_choice))));
	     else call collect_spy_data (SPY_AT_7, rtrim (ltrim (char (aam_choice))));

	     if aam_fkey then
		if aam_choice = aam_HELP
		then do;
		     call xforum_help_$get_help (aam_mtg_menu_ptr, "Meeting", aam_choices,
			spy_ptr, xforum_system_area_ptr);
		     call xforum_status_$update_title ((aam_headers (1)));
		     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
			0, aam_subject, 0, aam_fidx);
		     call xforum_status_$redisplay ((0));
		     call xforum_window_mgr$resynch_windows (aam_mtg_menu_height, "0"b);
		     call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);
		end;
		else if aam_choice = aam_FIRST_MENU | aam_choice = aam_FIRST_MENU2
		then goto exit_attend_a_meeting;
		else if aam_choice = aam_PREV_MENU | aam_choice = aam_PREV_MENU2
		then goto exit_attend_a_meeting;
		else if aam_choice = aam_QUIT | aam_choice = aam_QUIT2
		then do;
                         xforum_meeting_info.current = 0;
		     call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
			xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);
		     signal exit_executive_forum;
		end;
		else if aam_choice = aam_REDISPLAY | aam_choice = aam_REDISPLAY2
		then call xforum_redisplay_;
		else if (aam_choice = aam_MULTICS | aam_choice = aam_MULTICS2) & aam_multics_mode
		then do;
		     call xforum_multics_mode (aam_menu_window_height);
		     call xforum_window_mgr$resynch_windows (aam_menu_window_height, "0"b);
		     call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
			0, aam_subject, 0, aam_fidx);
		     call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);
		     goto meeting_get_choice;
		end;
		else call window_$bell (xforum_windows.menu.iocb, (0));
	     else do;
		if aam_choice = DISPLAY_UNREAD
		then call display_unread (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = DISPLAY_CURRENT
		then call display_current (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = DISPLAY_NEXT
		then call display_next (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = DISPLAY_PREV
		then call display_previous (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = DISPLAY_ALL
		then call display_all (aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = REPLY
		then do;
		     if ^forums (aam_midx).flags.read_only
		     then do;
			call xforum_attend_mtg_utilities$enter_trans (xforum_meeting_info_ptr, aam_fidx, spy_ptr, aam_REPLY, "1"b);
			aam_current_menu_ptr = null ();
		     end;
		     else do;
			call window_$clear_window (xforum_windows.bottom.iocb, (0));
			call ioa_ (aam_READ_ONLY_MESSAGE, forums (aam_midx).chairman);
		     end;
		end;
		else
		     if aam_choice = NEXT_SUBJ_UNREAD
		then call next_subject (aam_fidx, forums (aam_midx).forum_version, aam_subject);
		else
		     if aam_choice = GET_SUBJECT
		then do;
		     call select_subject (spy_ptr);
		     call display_current (aam_fidx, forums (aam_midx).forum_version);
		end;
		else
		     if aam_choice = TALK
		then do;
		     if ^forums (aam_midx).flags.read_only
		     then do;
			call xforum_attend_mtg_utilities$enter_trans (xforum_meeting_info_ptr, aam_fidx, spy_ptr, aam_TALK, "1"b);
			aam_current_menu_ptr = null ();
		     end;
		     else do;
			call window_$clear_window (xforum_windows.bottom.iocb, (0));
			call ioa_ (aam_READ_ONLY_MESSAGE, forums (aam_midx).chairman);
		     end;
		end;
		else
		     if aam_choice = COPY_SUBJECT
		then call copy_comments (spy_ptr, aam_fidx, forums (aam_midx).forum_version);
		else
		     if aam_choice = SKIP_REST_SUBJ
		then call skip_rest_of_subject (aam_fidx, forums (aam_midx).forum_version, aam_subject);
		else
		     if aam_choice = GET_COMMENT
		then do;
		     call select_comment (spy_ptr, aam_subject);
		     call display_current (aam_fidx, forums (aam_midx).forum_version);
		end;
		else
		     if aam_choice = GET_NEXT_MTG
		then do;
                         xforum_meeting_info.current = 0;
		     call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
			xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);
		     aam_more = "1"b;
		     return;
		end;
		else
		     if aam_choice = MTG_MAINTENANCE
		then call meeting_maintenance;
	     end;

	     call iox_$control (xforum_windows.bottom.iocb, "reset_more",
		null, (0));			/* get back in step		      */

	     if aam_current_menu_ptr ^= aam_mtg_menu_ptr
	     then do;
		call xforum_window_mgr$resynch_windows (aam_mtg_menu_height, "1"b);
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call xforum_status_$update_title ((aam_headers (1)));
		call xforum_attend_mtg_utilities$update_status (xforum_meeting_info_ptr,
		     0, aam_subject, 0, aam_fidx);
		call xforum_window_mgr$menu_display (aam_mtg_menu_ptr);

		aam_current_menu_ptr = aam_mtg_menu_ptr;
	     end;
	end;

exit_attend_a_meeting:
          xforum_meeting_info.current = 0;
	call xforum_attend_mtg_utilities$close_meeting (xforum_meeting_info_ptr,
	     xforum_meeting_list_ptr, aam_midx, aam_fidx, aam_mtg_menu_ptr);

     end attend_a_meeting;

display_unread: proc (du_fidx, du_version);

/* PARAMETERS */

	dcl     du_fidx		 fixed bin;
	dcl     du_version		 fixed bin;

/* AUTOMATIC */

	dcl     du_code		 fixed bin (35);
	dcl     du_is_first		 bit (1) aligned;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	du_code = 0;
	du_is_first = "1"b;

	xforum_meeting_info.flags.allref = "1"b;
	xforum_meeting_info.current_ref = xforum_meeting_info.current;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, du_code);
	do while (du_code ^= forum_error_table_$invalid_trans_idx);
	     if du_code = 0
	     then do;
		if xforum_meeting_info.seen_map_ptr -> seen_map (forum_user_trans.trans_no)
		then free forum_user_trans;
		else do;
		     xforum_meeting_info.current = forum_user_trans.trans_no;
		     call xforum_attend_mtg_utilities$update_status
			(xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, du_version, du_fidx);
		     call xforum_format_$display (forum_user_trans_ptr, du_is_first, du_code);
		     du_is_first = "0"b;
		end;
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, du_code);
	end;

	xforum_meeting_info.flags.allref = "0"b;

	if du_is_first
	then call ioa_ ("All comments on this subject have been read");

	return;

     end display_unread;

display_current: proc (dc_fidx, dc_version);

/* PARAMETERS */

	dcl     dc_fidx		 fixed bin;
	dcl     dc_version		 fixed bin;

/* AUTOMATIC */

	dcl     dc_code		 fixed bin (35);

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	dc_code = 0;

	call xforum_trans_$read (xforum_meeting_info.current, forum_user_trans_ptr, dc_code);
	if dc_code ^= 0
	then call com_err_$suppress_name (dc_code, ME, "Could not read current comment");
	else do;
	     call xforum_attend_mtg_utilities$update_status
		(xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, dc_version, dc_fidx);
	     call xforum_format_$display (forum_user_trans_ptr, "1"b, dc_code);
	end;

	return;

     end display_current;

display_next: proc (dn_fidx, dn_version);

/* PARAMETERS */

	dcl     dn_fidx		 fixed bin;
	dcl     dn_version		 fixed bin;

/* AUTOMATIC */

	dcl     dn_code		 fixed bin (35);

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	dn_code = 0;

	call xforum_trans_$next_ref (xforum_meeting_info.current, forum_user_trans_ptr, dn_code);
	if dn_code = forum_error_table_$invalid_trans_idx
	then call ioa_ ("There is no next comment on this subject.");
	else
	     if dn_code ^= 0
	then call com_err_$suppress_name (dn_code, ME, "Could not read next comment");
	else do;
	     xforum_meeting_info.current = forum_user_trans.trans_no;
	     call xforum_attend_mtg_utilities$update_status
		(xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, dn_version, dn_fidx);
	     call xforum_format_$display (forum_user_trans_ptr, "1"b, dn_code);
	end;

	return;

     end display_next;

display_previous: proc (dp_fidx, dp_version);

/* PARAMETERS */

	dcl     dp_fidx		 fixed bin;
	dcl     dp_version		 fixed bin;

/* AUTOMATIC */

	dcl     dp_code		 fixed bin (35);

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	dp_code = 0;

	call xforum_trans_$prev_ref (xforum_meeting_info.current, forum_user_trans_ptr, dp_code);
	if dp_code = forum_error_table_$invalid_trans_idx
	then call ioa_ ("There is no previous comment on this subject.");
	else
	     if dp_code ^= 0
	then call com_err_$suppress_name (dp_code, ME, "Could not read previous comment");
	else do;
	     xforum_meeting_info.current = forum_user_trans.trans_no;
	     call xforum_attend_mtg_utilities$update_status
		(xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, dp_version, dp_fidx);
	     call xforum_format_$display (forum_user_trans_ptr, "1"b, dp_code);
	end;

	return;

     end display_previous;

display_all: proc (da_fidx, da_version);

/* PARAMETERS */

	dcl     da_fidx		 fixed bin;
	dcl     da_version		 fixed bin;

/* AUTOMATIC */

	dcl     da_code		 fixed bin (35);
	dcl     da_is_first		 bit (1) aligned;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	da_code = 0;
	da_is_first = "1"b;

	xforum_meeting_info.flags.allref = "1"b;
	xforum_meeting_info.current_ref = xforum_meeting_info.current;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, da_code);
	do while (da_code ^= forum_error_table_$invalid_trans_idx);
	     if da_code = 0
	     then do;
		xforum_meeting_info.current = forum_user_trans.trans_no;
		call xforum_attend_mtg_utilities$update_status
		     (xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, da_version, da_fidx);
		call xforum_format_$display (forum_user_trans_ptr, da_is_first, da_code);
		da_is_first = "0"b;
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, da_code);
	end;

	xforum_meeting_info.flags.allref = "0"b;

	return;

     end display_all;

next_subject: proc (ns_fidx, ns_version, ns_subject);

/* PARAMETERS */

	dcl     ns_fidx		 fixed bin;
	dcl     ns_version		 fixed bin;
	dcl     ns_subject		 char (256);

/* AUTOMATIC */

	dcl     ns_code		 fixed bin (35);
	dcl     ns_old_current	 fixed bin;




	ns_old_current = xforum_meeting_info.current;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_attend_mtg_utilities$next_unread_comment (xforum_meeting_info_ptr,
	     ns_fidx, ns_version, forum_user_trans_ptr);

	if forum_user_trans_ptr = null ()
	then do;
	     call ioa_ ("No unread subjects.");
	     xforum_meeting_info.current = ns_old_current;
	     call xforum_trans_$read (xforum_meeting_info.current, forum_user_trans_ptr, ns_code);
	     if forum_user_trans.subject_length <= MAX_LEN
	     then ns_subject = forum_user_trans.subject;
	     else ns_subject = substr (forum_user_trans.subject, 1, MAX_LEN);
	     call xforum_attend_mtg_utilities$update_status
		(xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, ns_version, ns_fidx);
	     free forum_user_trans;
	end;
	else do;
	     if forum_user_trans.subject_length <= MAX_LEN
	     then ns_subject = forum_user_trans.subject;
	     else ns_subject = substr (forum_user_trans.subject, 1, MAX_LEN);
	     call xforum_attend_mtg_utilities$update_status
		(xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, ns_version, ns_fidx);
	     call xforum_format_$display (forum_user_trans_ptr, "1"b, ns_code);
	end;


	return;

     end next_subject;

select_subject: proc (ss_spy_ptr);

/* PARAMETERS */

	dcl     ss_spy_ptr		 ptr;

/* AUTOMATIC */

	dcl     ss_code		 fixed bin (35);
	dcl     ss_i		 fixed bin;
	dcl     ss_last_reference_ptr	 ptr;
	dcl     ss_old_current	 fixed bin;
	dcl     ss_next_trans	 fixed bin;
	dcl     ss_response		 char (256) varying;
	dcl     ss_response_len	 fixed bin;
	dcl     ss_seen_for_subject_ptr ptr;
	dcl     ss_selected_index	 fixed bin;
	dcl     ss_subject_index	 fixed bin;
	dcl     ss_subjects_ptr	 ptr;
	dcl     ss_transactions_processed fixed bin;
	dcl     ss_working_segs_ptr	 (3) ptr;

/* CONSTANT */

	dcl     ss_NAME		 char (14) init ("select subject") internal static options (constant);

/* BASED */

	dcl     ss_seen_for_subject	 (xforum_meeting_info.last_trans + 1) bit (1) unaligned based (ss_seen_for_subject_ptr);
	dcl     ss_last_reference	 (ss_subject_index) fixed bin based (ss_last_reference_ptr);
	dcl     ss_subjects		 (ss_subject_index) char (32) based (ss_subjects_ptr);


	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call ioa_ ("Building a list of subjects, this may take a while.");

	ss_old_current = xforum_meeting_info.current;
	ss_working_segs_ptr (1) = null ();
	ss_working_segs_ptr (2) = null ();
	ss_working_segs_ptr (3) = null ();

	call xforum_help_line_$push ("0"b, "", "Leave current subject unchanged", "");

	on quit
	     begin;
		xforum_meeting_info.current = ss_old_current;
		goto exit_select_subject;
	     end;

	call get_temp_segments_ (ss_NAME, ss_working_segs_ptr, ss_code);
	if ss_code ^= 0
	then do;
	     call com_err_$suppress_name (ss_code, ss_NAME, "Could not get a segment to store subjects - aborting select subject request.");
	     goto exit_select_subject;
	end;


	ss_seen_for_subject_ptr = ss_working_segs_ptr (1);
	ss_subjects_ptr = ss_working_segs_ptr (2);
	ss_last_reference_ptr = ss_working_segs_ptr (3);
	string (ss_seen_for_subject) = "0"b;
	ss_subject_index = 0;
	ss_next_trans = 1;
	ss_transactions_processed = 0;

	do while (ss_next_trans <= xforum_meeting_info.last_trans);
	     call xforum_trans_$read (ss_next_trans, forum_user_trans_ptr, ss_code);
	     if ss_code = 0
	     then do;
		ss_transactions_processed = ss_transactions_processed + 1;
		if mod (ss_transactions_processed, 200) = 0
		then call transactions_processed_message (ss_transactions_processed);
		ss_subject_index = ss_subject_index + 1;
		if forum_user_trans.subject_length > 32
		then ss_subjects (ss_subject_index) = substr (forum_user_trans.subject, 1, 29) || "...";
		else ss_subjects (ss_subject_index) = forum_user_trans.subject;
		ss_i = index (ss_subjects (ss_subject_index), NL);
		if ss_i ^= 0
		then do;
		     if ss_i > 29
		     then ss_subjects (ss_subject_index) = substr (forum_user_trans.subject, 1, 29) || "...";
		     else ss_subjects (ss_subject_index) = substr (forum_user_trans.subject, 1, ss_i - 1) || "...";
		end;
		ss_seen_for_subject (ss_next_trans) = "1"b;
		ss_last_reference (ss_subject_index) = ss_next_trans;
		free forum_user_trans;
		ss_i = ss_next_trans;
		call xforum_trans_$next_ref (ss_i, forum_user_trans_ptr, ss_code);
		do while (ss_code = 0);
		     ss_transactions_processed = ss_transactions_processed + 1;
		     if mod (ss_transactions_processed, 200) = 0
		     then call transactions_processed_message (ss_transactions_processed);
		     ss_seen_for_subject (forum_user_trans.trans_no) = "1"b;
		     ss_last_reference (ss_subject_index) = forum_user_trans.trans_no;
		     ss_i = forum_user_trans.trans_no;
		     free forum_user_trans;
		     call xforum_trans_$next_ref (ss_i, forum_user_trans_ptr, ss_code);
		end;
	     end;

	     ss_next_trans = ss_next_trans + 1;
	     do while (ss_seen_for_subject (ss_next_trans) & ss_next_trans <= xforum_meeting_info.last_trans);
		ss_next_trans = ss_next_trans + 1;
	     end;
	end;

	if xforum_user_profile$get_menu_always ()
	then do;
display_menu:
	     call xforum_dyn_menu_$display_and_get_choice (ss_subjects, ss_subject_index, "Comment Subject Selection",
		"ENTER SUBJECT", "Leave current subject unchanged", SPY_AT_19, ss_spy_ptr, ss_selected_index);
	     if ss_selected_index = -1
	     then goto prompt_for_subject;
	     else
		if ss_selected_index = 0
	     then xforum_meeting_info.current = ss_old_current;
	     else xforum_meeting_info.current = ss_last_reference (ss_selected_index);
	     goto exit_select_subject;
	end;
	else do;
prompt_for_subject:
	     call xforum_dyn_menu_$prompt_instead_of_menu ("Leave current subject unchanged", "Enter Subject", "Subjects",
		"subjects", "select_subject", SPY_AT_19, ss_spy_ptr, ss_response);

	     if ss_response = "??"
	     then goto display_menu;

	     ss_response_len = length (ss_response);
	     if ss_response_len = 0
	     then xforum_meeting_info.current = ss_old_current;
	     else do;
		xforum_meeting_info.current = 0;
		do ss_i = 1 to ss_subject_index while (xforum_meeting_info.current = 0);
		     if ss_response = substr (ss_subjects (ss_i), 1, ss_response_len)
		     then xforum_meeting_info.current = ss_last_reference (ss_i);
		end;
		if xforum_meeting_info.current = 0
		then do;
		     call ioa_ ("No comment chain could be found on the subject of ^a", ss_response);
		     call ioa_ ("Please re-enter the subject or ?? for a menu of subjects");
		     goto prompt_for_subject;
		end;
	     end;
	end;

exit_select_subject:
	if ss_working_segs_ptr (1) ^= null ()
	then call release_temp_segments_ (ss_NAME, ss_working_segs_ptr, ss_code);

	call xforum_help_line_$pop;

	return;

     end select_subject;

copy_comments: proc (cc_spy_ptr, cc_fidx, cc_version);

/* PARAMETERS */

	dcl     cc_spy_ptr		 ptr;
	dcl     cc_fidx		 fixed bin;
	dcl     cc_version		 fixed bin;

/* AUTOMATIC */

	dcl     cc_bc		 fixed bin (24);
	dcl     cc_code		 fixed bin (35);
	dcl     cc_entry_name	 char (32);
	dcl     cc_number_of_comments	 fixed bin;
	dcl     cc_seg_ptr		 ptr;

	call xforum_attend_mtg_utilities$copy_to_name (cc_spy_ptr, cc_entry_name, cc_seg_ptr, cc_bc);
	if cc_seg_ptr = null ()
	then goto exit_copy_comments;

	cc_number_of_comments = 0;
	call ioa_ ("^/^/   Comments are being copied to ^a.", cc_entry_name);
	call xforum_help_line_$push ("0"b, "", "Return to Meeting menu", "");

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call xforum_help_line_$pop;
		call collect_spy_data (SPY_AT_15, "QUIT");
		goto exit_copy_comments;
	     end;

	xforum_meeting_info.flags.allref = "1"b;
	xforum_meeting_info.current_ref = xforum_meeting_info.current;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, cc_code);
	do while (cc_code ^= forum_error_table_$invalid_trans_idx);
	     if cc_code = 0
	     then do;
		cc_number_of_comments = cc_number_of_comments + 1;
		call xforum_attend_mtg_utilities$update_status
		     (xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, cc_version, cc_fidx);
		call xforum_format_$append (forum_user_trans_ptr, cc_seg_ptr, "0"b, cc_bc, cc_code);
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, cc_code);
	end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));
	call ioa_ ("^d comments copied to file ^a.", cc_number_of_comments, cc_entry_name);

exit_copy_comments:
	return;

     end copy_comments;

skip_rest_of_subject: proc (sros_fidx, sros_version, sros_subject);

/* PARAMETERS */

	dcl     sros_fidx		 fixed bin;
	dcl     sros_version	 fixed bin;
	dcl     sros_subject	 char (256);

/* AUTOMATIC */

	dcl     sros_code		 fixed bin (35);





	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call ioa_ ("Skipping rest of subject.");

	xforum_meeting_info.flags.allref = "1"b;
	xforum_meeting_info.current_ref = xforum_meeting_info.current;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, sros_code);
	do while (sros_code ^= forum_error_table_$invalid_trans_idx);
	     if sros_code = 0
	     then do;
		xforum_meeting_info.current = forum_user_trans.trans_no;
		call xforum_attend_mtg_utilities$update_status
		     (xforum_meeting_info_ptr, forum_user_trans.trans_no, forum_user_trans.subject, sros_version, sros_fidx);
		free forum_user_trans;
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, sros_code);
	end;

	xforum_meeting_info.allref = "0"b;

	call next_subject (sros_fidx, sros_version, sros_subject);

	return;

     end skip_rest_of_subject;

select_comment: proc (sc_spy_ptr, sc_subject);

/* PARAMETERS */

	dcl     sc_spy_ptr		 ptr;
	dcl     sc_subject		 char (256);

/* AUTOMATIC */

          dcl     error_table_$long_record 
                                         fixed bin(35) ext static;
	dcl     sc_code		 fixed bin (35);
	dcl     sc_comment_number	 fixed bin;
	dcl     sc_reply		 char (132);
          dcl     reply		 char (132) varying;

	spy_ptr = sc_spy_ptr;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call xforum_help_line_$pop;
		call xforum_status_$redisplay ((0));
		call collect_spy_data (SPY_AT_10, "QUIT");
		goto exit_select_comment;
	     end;

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	call xforum_help_line_$push ("0"b, "", "", QUERY_USAGE);

select_comment_prompt:
          answer_array.N = 0;                               /* All answers acceptable			*/
          answer_array.max_length = MAX_LEN;		/* max length of comment specifier		*/
          call xforum_get_str_ ((COMMENT_PROMPT), addr(answer_array), PROMPT_HELP, "select_comment", reply, sc_code);

          if sc_code = error_table_$long_record
          then do;
               call window_$clear_window (xforum_windows.bottom.iocb, (0));
	     call ioa_ ("^/Max length (^d) for comment specifiers exceeded - please reenter^/  (or press BREAK to return to menu).", MAX_LEN);
	     goto select_comment_prompt;
	     end;

	if length(reply) = 0
	then call collect_spy_data (SPY_AT_10, "RETURN");
	else do;
	     if reply = "?"
	     then call collect_spy_data (SPY_AT_10, "?");
	     else if verify (reply, "0123456789") ^= 0
	     then call collect_spy_data (SPY_AT_10, "number");
	     else call collect_spy_data (SPY_AT_10, "ERROR");

	     if verify (reply, "0123456789") ^= 0
	     then do;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call ioa_ ("Only a single comment number may be entered");
		goto select_comment_prompt;
	     end;

	     sc_comment_number = convert (xforum_meeting_info.current, substr (reply, 1));
	     call xforum_trans_$read (sc_comment_number, forum_user_trans_ptr, sc_code);
	     if sc_code = forum_error_table_$invalid_trans_idx
	     then do;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call ioa_ ("Comment ^i does not exist.", sc_comment_number);
		goto select_comment_prompt;
	     end;
	     else
		if sc_code = forum_error_table_$trans_deleted | sc_code = forum_error_table_$trans_reaped
	     then do;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call ioa_ ("Comment ^i has been deleted.", sc_comment_number);
		goto select_comment_prompt;
	     end;
	     else
		if sc_code ^= 0
	     then do;
		call window_$clear_window (xforum_windows.bottom.iocb, (0));
		call ioa_ ("Comment ^i cannot be read, please choose another comment.", sc_comment_number);
		goto select_comment_prompt;
	     end;
	     else do;
		if forum_user_trans.subject_length <= MAX_LEN
		then sc_subject = forum_user_trans.subject;
		else sc_subject = substr (forum_user_trans.subject, 1, MAX_LEN);
		free forum_user_trans;
		xforum_meeting_info.current = sc_comment_number;
	     end;
	end;

	call xforum_help_line_$pop;

exit_select_comment:
	return;

     end select_comment;

meeting_maintenance: proc;



	call ioa_ ("Meeting Maintenance has not yet been implemented.");
	call timer_manager_$sleep (4, "11"b);

	return;

     end meeting_maintenance;

transactions_processed_message: proc (tpm_number);

/* PARAMETERS */

	dcl     tpm_number		 fixed bin;

/* AUTOMATIC */

	dcl     tpm_message		 char (50);


	call window_$position_cursor (iox_$user_io, 3, 22, (0));
	call ioa_$rsnnl ("^d out of ^d comments processed.", tpm_message, (0), tpm_number, xforum_meeting_info.last_trans);
	call window_$overwrite_text (iox_$user_io, rtrim (tpm_message), (0));
	call window_$sync (iox_$user_io, (0));

	return;

     end transactions_processed_message;

collect_spy_data: proc (csd_where, csd_response);

	dcl     csd_where		 fixed bin;
	dcl     csd_response	 char (*);

	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

     end xforum_sub_attend_mtg_menu;




		    xforum_trans_.pl1               08/06/87  1025.1rew 08/06/87  1014.9      118962



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



/****^  HISTORY COMMENTS:
  1) change(86-02-07,LJAdams), approve(86-02-18,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added the lastref "lref" and restref "rref" options.
  2) change(87-04-09,LJAdams), approve(87-04-22,MCR7684),
     audit(87-04-27,Blair), install(87-08-06,MR12.1-1065):
     For last_ref entry point initialize return parameter to 0 before start of
     processing.
                                                   END HISTORY COMMENTS */


xforum_trans_: proc;

/*
   BEGIN DESCRIPTION

   function:
      This programs contains entries for reading the current, and for finding
      next, previous, first transactions, also previous, next and first
      references to current transaction.

      read: This entry reads the transaction specified by the input index from
      the current meeting, and returns a pointer to the transaction structure.
      forum_ is called to get a pointer to the transaction structure. This
      structure is allocated in system_free and is freed in the xforum_format_
      module. In addition if the requested transaction has an index higher
      than the current last_seen transaction index the value of last_seen is
      updated.

      first_trans: This entry point finds and returns a pointer to the
      first transaction in the current meeting. This is done by looping though
      the transactions 1, 2, 3, etc. looking for one that has not been deleted.
      forum_ is called to get a transaction pointer. The
      last_seen value is also updated if the just read transaction has a higher
      index than the last_seen value. Note that if an error code other than
      trans_deleted or trans_reaped is returned by forum_ the entry will return
      with and undefined pointer value and that error code value. 

      prev_trans: This entry point finds and returns a pointer to the
      prev transaction in the current meeting. The previous transaction is the
      next non-deleted transaction with an index smaller than the current
      transaction. The logic is similar to that in the first_trans entry except
      that the loop index starts at current_index - 1 and is decremented.

      next_trans: This entry finds and returns a pointer to the next
      transaction in the current meeting. The next transaction is the next
      non-deleted transaction with an index larger than the current
      transaction. The logic is similar to that in the first_trans  entry
      except that the loop index starts at current_index + 1.

      first_ref: This entry point finds and returns a pointer to the
      first transaction for the current subject chain in the current meeting.
      The first transaction is found by calling forum_ to get the next and
      previous references to the current transaction and then by looping
      on the previous transaction to get its previous transaction until there
      are no more previous transaction. Once the first transaction is found
      a call to forum_ is made to get the transaction structure ptr. If that
      call fails (returns a non-zero error code) a call to
      xforum_trans_$next_ref is made. If that call fails the error code is
      returned to the caller. Note that the xforum_meeting_info table is not
      updated or used in any way by this entry.

      prev_ref: This entry point finds and returns a pointer to the previous
      transaction for the current subject chain in the current meeting.
      A call to forum_ is made to get the previous and next references. If
      there is not a previous reference the error code invalid_trans_idx is
      returned. If there is a previous reference and it has not been deleted
      a call to forum_ is made to get the transaction pointer and that pointer
      is returned. If an error occurs then the error is returned. If the
      transaction has been deleted a call is made to get its previous and next
      transactions and the loop repeats. A flag is returned by forum_ to 
      indicate if the transaction has been deleted - the xforum_meeting_info
      table is not used.

      next_ref: This entry point finds and returns a pointer to the next
      transaction for the current subject chain in the current meeting.
      The logic is identical to that in prev_ref with the exception that the
      next reference is used instead of the prev reference.

      last_ref: This entry point finds and returns a pointer to the last
      transaction for the current suject chain in the current meeting.
      The logic is identical to that in prev_ref except that the next
      reference is used instead of the prev reference and the looping
      continues until there are no more next references.

   description:

   known bugs:

   notes:

   history:
      83-12-?? DBarkey: Originally written

      84-09-25 Davids: Removed references to xforum_trans_array. The array is
      being deleted because it enforces an upper limit on the number of
      transaction that xforum can handle. The entries read, first_trans,
      prev_trans, and next_trans needed to be restructured quite a bit. None
      of the other entries were effected.
 
      84-11-08 Davids: Audit changes: 1) Simplified the loops for the
      first_trans, prev_trans, and next_trans entries, removed the repeat
      and while clauses and added to and by clauses. Also reformated
      declarations.

   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     P_tidx		 fixed bin parameter;
	dcl     P_forum_user_trans_ptr ptr parameter;
	dcl     P_code		 fixed bin (35) parameter;

/* EXTERNAL STATIC */

	dcl     forum_error_table_$invalid_trans_idx fixed bin (35) ext static;
	dcl     forum_error_table_$trans_deleted fixed bin (35) ext static;
	dcl     forum_error_table_$trans_reaped fixed bin (35) ext static;

/* ENTRIES */

	dcl     xforum_trans_$read	 entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$next_ref entry (fixed bin, ptr, fixed bin (35));
          dcl     xforum_trans_$prev_ref entry (fixed bin, ptr, fixed bin (35));

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

	dcl     code		 fixed bin (35);
	dcl     delete_sw		 bit (1) aligned;
	dcl     i			 fixed bin;
	dcl     nref		 fixed bin;
	dcl     pref		 fixed bin;
	dcl     tidx		 fixed bin;

/* INTERNAL STATIC */

/* CONSTANTS */

	dcl     TRUE		 bit (1) aligned init ("1"b) static options (constant);

/* BUILTINS */

/* BASED */

/* INCLUDE FILES */

%include forum_dcls;
%page;
%include forum_user_trans;
%page;
%include xforum_meeting_info;
%page;
%include xforum_meeting_list;
%page;
%include xforum_ptr_struct_;
%page;

read: entry (P_tidx, P_forum_user_trans_ptr, P_code);

	idx = xforum_meeting_info.idx;
	tidx = P_tidx;
	P_code = 0;

	call forum_$read_trans (idx, tidx, xforum_system_area_ptr,
	     forum_user_trans_ptr, code);
	if code ^= 0 then do;
	     P_code = code;
	     return;
	end;

	P_forum_user_trans_ptr = forum_user_trans_ptr;

	if tidx > xforum_meeting_info.last_trans
	then xforum_meeting_info.last_trans = tidx;
						/* this could have appeared
				   recently	      */

	return;

first_trans: entry (P_forum_user_trans_ptr, P_code);

	P_code = 0;

	do i = 1 by 1;
	     call forum_$read_trans (idx, i, xforum_system_area_ptr,
		forum_user_trans_ptr, code);
	     if code ^= 0
	     then do;
		if code ^= forum_error_table_$trans_deleted
		     & code ^= forum_error_table_$trans_reaped
		then do;
		     P_code = code;
		     return;
		end;
	     end;
	     else do;
		P_forum_user_trans_ptr = forum_user_trans_ptr;
		if xforum_meeting_info.last_trans < i
		then xforum_meeting_info.last_trans = i;
		return;
	     end;
	end;

prev_trans: entry (P_tidx, P_forum_user_trans_ptr, P_code);

	P_code = 0;

	tidx = P_tidx;

	do i = tidx - 1 to 1 by -1;
	     call forum_$read_trans (idx, i, xforum_system_area_ptr,
		forum_user_trans_ptr, code);
	     if code ^= 0
	     then do;
		if code ^= forum_error_table_$trans_deleted
		     & code ^= forum_error_table_$trans_reaped
		then do;
		     P_code = code;
		     return;
		end;
	     end;
	     else do;
		P_forum_user_trans_ptr = forum_user_trans_ptr;
		if xforum_meeting_info.last_trans < i
		then xforum_meeting_info.last_trans = i;
		return;
	     end;
	end;
	P_code = forum_error_table_$invalid_trans_idx;
	return;

next_trans: entry (P_tidx, P_forum_user_trans_ptr, P_code);

	P_code = 0;

	tidx = P_tidx;

	do i = tidx + 1 by 1;
	     call forum_$read_trans (idx, i, xforum_system_area_ptr,
		forum_user_trans_ptr, code);
	     if code ^= 0
	     then do;
		if code ^= forum_error_table_$trans_deleted
		     & code ^= forum_error_table_$trans_reaped
		then do;
		     P_code = code;
		     return;
		end;
	     end;
	     else do;
		P_forum_user_trans_ptr = forum_user_trans_ptr;
		if xforum_meeting_info.last_trans < i
		then xforum_meeting_info.last_trans = i;
		return;
	     end;
	end;

first_ref: entry (P_tidx, P_forum_user_trans_ptr, P_code);

	P_code = 0;

	tidx = P_tidx;

	call forum_$trans_ref_info (idx, tidx, ONLY_UNDELETED, pref, nref, delete_sw, code);
	if code ^= 0 then do;
	     P_code = code;
	     return;
	end;

	if pref = 0 then do;			/* this was the first	      */
	     call xforum_trans_$read (tidx, forum_user_trans_ptr, code);
	     P_code = code;
	     P_forum_user_trans_ptr = forum_user_trans_ptr;
	     return;
	end;

	do i = pref repeat pref while (TRUE);
	     call forum_$trans_ref_info (idx, i, ONLY_UNDELETED, pref, nref, delete_sw,
		code);
	     if code ^= 0 then do;
		P_code = code;
		return;
	     end;

	     if pref = 0 then do;
		call xforum_trans_$read (i, forum_user_trans_ptr, code);
		if code ^= 0
		then				/* fref not there get next	      */
		     call xforum_trans_$next_ref (i, forum_user_trans_ptr,
			code);
		P_code = code;			/* one way or another	      */
		P_forum_user_trans_ptr = forum_user_trans_ptr;
		return;
	     end;
	end;

prev_ref: entry (P_tidx, P_forum_user_trans_ptr, P_code);

	P_code = 0;

	tidx = P_tidx;

	call forum_$trans_ref_info (idx, tidx, ONLY_UNDELETED, pref, nref, delete_sw, code);
	if code ^= 0 then do;
	     P_code = code;
	     return;
	end;

	if pref = 0 then do;
	     P_code = forum_error_table_$invalid_trans_idx;
	     return;
	end;

	do i = pref repeat pref while (TRUE);
	     if ^delete_sw then do;
		call xforum_trans_$read (i, forum_user_trans_ptr, code);
		if code ^= 0 then do;
		     P_code = code;
		     return;
		end;
		else do;
		     P_forum_user_trans_ptr = forum_user_trans_ptr;
		     return;
		end;
	     end;					/* deleted - try for next	      */
	     call forum_$trans_ref_info (idx, i, ONLY_UNDELETED, pref, nref, delete_sw,
		code);
	     if code ^= 0 then do;
		P_code = code;
		return;
	     end;

	     if pref = 0 then do;
		P_code = forum_error_table_$invalid_trans_idx;
		return;
	     end;
	end;

next_ref: entry (P_tidx, P_forum_user_trans_ptr, P_code);

	P_code = 0;

	tidx = P_tidx;

	call forum_$trans_ref_info (idx, tidx, ONLY_UNDELETED, pref, nref, delete_sw, code);
	if code ^= 0 then do;
	     P_code = code;
	     return;
	end;

	if nref = 0 then do;
	     P_code = forum_error_table_$invalid_trans_idx;
	     return;
	end;

	do i = nref repeat nref while (TRUE);
	     if ^delete_sw then do;
		call xforum_trans_$read (i, forum_user_trans_ptr, code);
		if code ^= 0 then do;
		     P_code = code;
		     return;
		end;
		else do;
		     P_forum_user_trans_ptr = forum_user_trans_ptr;
		     return;
		end;
	     end;					/* deleted - try for next	      */
	     call forum_$trans_ref_info (idx, i, ONLY_UNDELETED, pref, nref, delete_sw,
		code);
	     if code ^= 0 then do;
		P_code = code;
		return;
	     end;

	     if nref = 0 then do;
		P_code = forum_error_table_$invalid_trans_idx;
		return;
	     end;
	  end;
         

last_ref: entry (P_tidx, P_forum_user_trans_ptr, P_code);

          nref = P_tidx;
	P_code, code = 0;

	do while(nref ^= 0 & code = 0);
               tidx = nref;
	     call forum_$trans_ref_info (idx, tidx, ONLY_UNDELETED, pref, nref, delete_sw, code);
	     if code ^= 0 then do;
                    P_code = code;
		return;
	     end;
          end;

          if ^delete_sw then do;
               call xforum_trans_$read (tidx, forum_user_trans_ptr, code);
               if code ^= 0 then do;
                    P_code = code;
                    return;
	     end;
               else do;
                    P_forum_user_trans_ptr = forum_user_trans_ptr;
                    return;
               end;
          end;
          else do;					/* get last undeleted			*/
               call xforum_trans_$prev_ref (tidx, forum_user_trans_ptr, code);
               P_forum_user_trans_ptr = forum_user_trans_ptr;
               return;
          end;
    
     end xforum_trans_;




		    xforum_user_profile.pl1         12/07/87  1328.2rew 12/07/87  1321.6      283842



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


/****^  HISTORY COMMENTS:
  1) change(85-02-18,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Modified the get routine so that the profile exists case is part
     of the if-then-else statement.  The only thing not part of it is
     the original call to value_ and the calls to
     set_use_function_key_i.  Removed the label exit_get and the two
     gotos to it for the cases of no value segment and no xforum
     profile.  The gotos were skiping the call to
     set_use_function_key_i and that cased all subsequent calls to get
     the function_key_data_ptr to return null - not good.
     
     85-04-15 Davids: Added code in the get entry to test the value of
     the new_features_menu_version and call the warn_user_of_changes
     routine to warn the users of changes, and to update the value in
     the structure and update the version in the value seg so that
     warning is not output again.  Also changed the init_user_profile
     routine to set the value of the new_features_menu_version from
     "NONE " to "1.0-2.0 " and the convert_version routine to
     automatically warn the the user when converting a 1.0 or 1.1
     version profile.  It will also update the value.  Note that for
     future versions a test may have to be made since it will be
     possible to have a new version of the profile without having user
     visable changes.  Finially added the warn_user_of_changes routine
     which just outputs the warning message.
     
     85-05-30 Davids: Changed the make_value_seg procedure so that it
     creates the default value seg as a permanent value seg (second
     argument to value_$init_seg = 0) instead of a perprocess value seg
     (second arg = 1).  A perprocess default value seg was causing
     value_ to take a not_in_read_bracket condition.
  2) change(86-02-20,LJAdams), approve(86-02-20,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Changed message displayed when profile has been damaged or is inconsistent
     to be less threatening.
  3) change(87-04-06,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-27,Blair), install(87-08-06,MR12.1-1065):
     Added entry points set_user_fk_value and get_user_fk_value to set/get the
     option that the user has requested; i.e., use function keys or use escape
     keys.  Changed version to 2.1.
  4) change(87-11-04,LJAdams), approve(87-11-10,MCR7800),
     audit(87-12-01,Gilcrease), install(87-12-07,MR12.2-1008):
     Suppress error messages for missing value segment or missing
     xforum_profile._.  The value segment/xforum_profile._ will be silently
     rebuilt and default values will be applied.
                                                   END HISTORY COMMENTS */


xforum_user_profile: proc;

/*
   BEGIN DESCRIPTION

   function:
      This module maintains the user's xforum profile.

   description of entry points:
      get: This entry is used get a copy of the user's profile from the
      value segment and save it in an internal static structure. If the
      profile cannot be found it is assumed that the user has never used
      xforum before. An output flag is set to true and the profile is
      initialized and stored in the profile. This entry will also call
      convert_version to update any profiles that are not the current version.

      update_profile: This entry is used to force the internal static profile
      to be stored in the user's value segment. Note that changing the static
      structure via a set entry WILL NOT cause the value segment copy to be
      updated.

      display_profile: This entry displays the internal static copy of the
      profile on user_io. The contents of the static copy must have been
      initialized via a call to get. This is a debugging entry.

      delete_profile: This entry deletes the user's xforum profile from the
      user's profile segment. It is a debugging entry.

      set_handle_interactive_messages: Sets the static flag to the input value.
      Always returns "1"b

      get_handle_interactive_messages: Returns the static flag.

      set_multics_mode: Sets the static flag to the input value. Always returns
      "1"b

      get_multics_mode: Returns the static flag.

      set_menu_always: Sets the static flag to the input value. Always returns
      "1"b

      get_menu_always: Returns the static flag.

      set_read_comments_by_subject: Sets the static flag to the input
      value. Always returns "1"b

      get_read_comments_by_subject: Returns the static flag.

      set_use_function_keys: Sets the static flag to the input value. Returns
      "1"b if the set was successful, i.e. the user has enough function keys or
      "0"b if the user cannot use function keys.

      get_use_function_keys: Returns the static flag.

      set_remove_menu_while_editing: Sets the static flag to the input value.
      Always returns "1"b

      get_remove_menu_while_editing: Returns the static flag.

      set_function_key_data_ptr: Sets the pointer to the function_key_data
      structure. This is used only in those cases where the function keys are
      not the normal terminal keys or the standard escase sequences. Always
      returns "1"b

      get_function_key_data_ptr: Returns a pointer to the function_key_data
      structure.

      set_new_features_menu_version: Sets the value of the new new features
      menu version. Always returns "1"b

      get_new_features_menu_version: Returns the value of the new features menu
      version.

   description of internal procedures:
      init_user_profile: this procedure loads the internal static copy of
      the user's profile and then writes that structure into the user's
      profile segment. The xforum profile has a key of "xforum_user_profile._".

      make_value_seg: this procedure creates a segment named <person_id>.value
      in the users home dir. It also inits that segment so that its a permanent
      value segment. This procedure is called if its determined that the user
      does not already have a permanent value segment. If the value segment
      is created but cannot be initaialized it is deleted.

      convert_version: this procedure is used to convert an xforum profile
      with an old version to the new version. If the version of the old xforum
      profile is not recognized then a new profile is written with the lastest
      version and default values. A warning message telling the user that his
      profile is being re-initialized because of damage is output.

      set_use_function_keys_i: This procedure actually sets the value of the
      profile switch. Before the switch is set to allow function keys to be
      used a check is made to be sure that they can be used. If they cannot
      be used and the user requested them a warning is issued. This procedure
      also set the value of the function_key_data_ptr within the profile.
      If escape sequences are to be used it sets the value from an internal
      static pointer which was set by a call to xforum_default_fkeys_. If the
      static pointer is null the call to default_fkeys is made first.

      can_use_function_keys: This procedure determines if the user can use
      function keys. It is based on the terminal type and the state of the
      profile multics mode flag. If the flag is set the terminal must have
      at least 8 function keys. If the flag is not set the user must have at
      least 7 function keys. This procedure sets the value of an internal
      static pointer which points to the function_key_data structure for the
      terminal. If this pointer is non-null when the procedure is entered
      the function_key_data structure is freed. This is done because it is
      possible that the user changed terminals.

      update_profile_i: this procedure deletes the old profile from the value
      segment and stores the new profile in the value segment. The error code
      error_table_$oldnamerr returned from the delete operation is ignored.
      Any other error either from the delete operation or the store operation
      will cause an xforum fatal error.

      error: this procedure is used to signal the xforum_fatal_error condition.
      This is called only in cases where system routines return unexpected
      error codes.

   known bugs:

   notes:
      84-10-23 Davids: Commented out the call to set_use_function_keys_i in
      the get entry to prevent the "not enough function keys must use escape
      sequences" message from being printed at that point. A call to the
      set_use_function_keys entry will be made from the xforum module to set
      the function key usage. This is needed so that the message is not output
      if the user included the -esc control arg when he invoked xforum. When
      the escape_sequence control args go away this code should be executed.

   history:
      84-08-14 Davids: Written

      84-08-29 Davids: Added the display_profile and delete_profile entries.
      These are for debuging purposes only.

      84-09-25 Davids: Changed the name of the element in the value segment
      from xforum_user_profile to xforum_user_profile._.

      84-09-28 Davids: Added the set and get entry points for
      handle_interactive_messages, multics_mode, menu_always,
      read_comments_by_subject_chain, and use_function_keys. Changed the names
      of the profile elements allow_multics_mode and 
      use_function_keys_if_possible to just multics_mode and use_function_keys.

      84-10-01 Davids: Added the function_key_data_ptr to the profile and
      changed the version from 1.0 to 1.1. Added the internal procs
      set_use_function_keys_i and can_use_function_keys. Modified get so that
      it sets the function_key_data_ptr in the profile. Modified
      convert_version to handle the conversion from 1.0 to 1.1.

      84-10-23 Davids: Changed get entry point so that the call to
      set_use_function_keys_i is based solely on the value of
      xup_user_profile.use_function_keys instead of on that valuef and the
      value of xup_user_profile.multics_mode. Commented out the call to
      set_use_function_keys_i in the get entry to prevent the "not enough
      function keys must use escape sequences" message from being printed at
      that point. A call to the set_use_function_keys entry will be made from
      the xforum module to set the function key usage. This is needed so that
      the message is not output if the user included the -esc control arg when
      he invoked xforum. When the escape_sequence control args go away this
      code should be executed.

      84-11-08 Davids: Audit changes: 1) Corrected some message text typos in
      the convert_version procedure. 2) Created the xup_USER_PROFILE_VERSION_1
      constant. 3) Combined three separate if in can_use_function_keys which
      determine if the terminal has enough function keys into a sequence of
      if-then-else.

      84-12-13 Davids: Added the make_value_segment procedure. Also added
      code to the get entry so that if the error returned by value_$get_data
      is noentry the make_value_segment procedure is called. This takes care
      of the case where the user does not already have a value segment.
   
      85-01-08 Davids: Added the set_function_key_data_ptr. This was needed so
      that the xforum_help_$get_help routine could change the function keys to
      make ?? a function key. Also added the element remove_menu_while_editing
      to the profile and the entry points (set get)_remove_menu_while_editing.
      It was not necessary to create a new profile version since the element
      has a default value of "0"b and it replaces a bit in a MBZ field.

      85-01-09 Davids: Changed the (get set)_read_comments_by_subject_chain
      to just read_comments_by_subject. The long name was screwing things up.

      85-01-10 Davids: Added the element new_features_menu_version to the
      profile, updated the profile version to 2.0, modified the convert_version
      routine to convert version 1 and version 1.1 profiles to 2.0 and the
      init_user_profile routine to create a 2.0 profile. The default value of
      new_features_menu_version element is "NONE    ". Also added entry points
      to set and get the value. Added the entry update_profile. This was done
      becuase it seem to expensive to update the profile in the value segment
      after every call to a set entry. The internal routine update_profile_i
      was also created and the routines init_user_profile, and convert_version
      were modified to use it instead of call value_ entries directly. All set
      entries now return a bit (1) flag. This flag indicates if the set was
      successful. All entries except set_use_function_keys always return "1"b.
      There are cases when the user cannot use function keys, i.e. a terminal
      which only has 4 function keys, so set_use_function_keys can return
      either a "1"b or a "0"b. Also removed the comment that was around the
      call to set_use_function_keys_i in the get entry. The comment was there
      because the call was also in xforum to handle the -esc control arg and
      having in the get routine would cause the not enough function keys
      warning to be output twice (if it would be output at all). Since the arg
      is now obsolete it should be done here. If the warning comes out twice
      so be it.

      85-01-15 Davids: Added code to make_value_segment to delete the just
      created value segment if it could not be initialized.
   END DESCRIPTION
*/

/* PARAMETERS */

/* look under individual entry points and procedures */

/* EXTERNAL STATIC */

	dcl     error_table_$oldnamerr fixed bin (35) ext static;
	dcl     error_table_$noentry	 fixed bin (35) ext static;
	dcl     iox_$user_io	 ptr ext static;

/* ENTRIES */

	dcl     com_err_		 entry () options (variable);
	dcl     delete_$ptr		 entry (ptr, bit (36) aligned, char (*), fixed bin (35));
	dcl     hcs_$make_seg	 entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     ttt_info_$function_key_data entry (char (*), ptr, ptr, fixed bin (35));
	dcl     user_info_		 entry (char (*), char (*), char (*));
	dcl     user_info_$homedir	 entry (char (*));
	dcl     value_$delete_data	 entry (ptr, bit (36) aligned, char (*), fixed bin (35));
	dcl     value_$get_data	 entry (ptr, bit (36) aligned, char (*), ptr, ptr, fixed bin (18), fixed bin (35));
	dcl     value_$init_seg	 entry (ptr, fixed bin, ptr, fixed bin (19), fixed bin (35));
	dcl     value_$set_data	 entry (ptr, bit (36) aligned, char (*), ptr, fixed bin (18), ptr, ptr, fixed bin (18), fixed bin (35));
	dcl     xforum_default_fkeys_	 entry () returns (ptr);

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

/* INTERNAL STATIC */

	dcl     (
	        xup_escape_sequence_function_key_data_ptr ptr init (null ()),
	        xup_term_type_function_key_data_ptr ptr init (null ()),
	        01 xup_xforum_error_info like xforum_error_info,
	        01 xup_user_profile	 like user_profile_overlay
	        )			 internal static;

/* CONSTANTS */

	dcl     (
	        xup_CURRENT_NEW_FEATURES_MENU_VERSION char (8) init ("1.0-2.1"),
	        xup_CURRENT_USER_PROFILE_VERSION char (8) init ("xup  2.1"), /* version of the profile str */
	        xup_PERMANENT	 bit (36) aligned init ("01"b), /* use permanet value seg not per process value */
	        xup_USER_PROFILE_VERSION_1 char (8) init ("xup  1.0"),
	        xup_USER_PROFILE_VERSION_1_1 char (8) init ("xup  1.1"),
	        xup_VALUE_SEG_PTR	 ptr init (null ()),/* null ptr means use default value seg */
	        xup_XFORUM_USER_PROFILE char (21) init ("xforum_user_profile._") /* name of element in value seg */
	        )			 internal static options (constant);

	dcl     UNSET		 fixed bin (2) int static options (constant) init (0);
	dcl     USE_ESCAPE_KEYS	 fixed bin (2) int static options (constant) init (1);
	dcl     USE_FUNCTION_KEYS	 fixed bin (2) int static options (constant) init (2);

/* BUILTINS */

	dcl     (
	        addr,
	        empty,
	        null,
	        rtrim,
	        size
	        )			 builtin;

/* BASED */

	dcl     01 user_profile_overlay based,
		02 version	 char (8),
		02 handle_interactive_messages bit (1) unaligned,
		02 multics_mode	 bit (1) unaligned,
		02 menu_always	 bit (1) unaligned,
		02 read_comments_by_subject_chain bit (1) unaligned,
		02 use_function_keys bit (1) unaligned,
		02 remove_menu_while_editing bit (1) unaligned,
		02 mbz		 bit (30) unaligned,
		02 function_key_data_ptr ptr,
		02 new_features_menu_version char (8),
		02 user_set_fk_value fixed bin (2);	/* 0 = UNSET     */
						/* 1 = ESC keys  */
						/* 2 = FUNC keys */


/* INCLUDES */

%include access_mode_values;
%page;
%include function_key_data;
%page;
%include terminal_info;
%page;
%include xforum_error_info;

	call error (0, "main entry point of xforum_user_profile was called");

get: entry (g_first_time_user);

/* PARAMETERS */

	dcl     g_first_time_user	 bit (1) aligned;	/* (output) true if the user has never invoked xforum before */

/* AUTOMATIC */

	dcl     g_local_area	 area (50);	/* space for value to allocate the user_profile structure in */
	dcl     g_code		 fixed bin (35);	/* error code returned by value_$get_data */
	dcl     g_data_ptr		 ptr;		/* pointer to the user profile allocated by value */
	dcl     g_unused_b1		 bit (1);
	dcl     g_unused_fb18	 fixed bin (18);	/* returned by value_$get_data */

/* BASED */

	dcl     g_version_overlay	 char (8) based;	/* so that we can read the structures version */
	dcl     Serror_occurred	 bit (1);


	Serror_occurred = "0"b;

	call value_$get_data (xup_VALUE_SEG_PTR, xup_PERMANENT, xup_XFORUM_USER_PROFILE,
	     addr (g_local_area), g_data_ptr, g_unused_fb18, g_code);
	if g_code = error_table_$noentry
	then do;
		call make_value_seg;
		call init_user_profile;
		g_first_time_user = "1"b;
	     end;
	else
	     if g_code = error_table_$oldnamerr
	then do;
		call init_user_profile;
		call timer_manager_$sleep (4, "11"b);
		Serror_occurred = "1"b;
	     end;
	else
	     if g_code ^= 0
	then call error (g_code, "Could not get user profile");
	else do;
		g_first_time_user = "0"b;
		if g_data_ptr -> g_version_overlay ^= xup_CURRENT_USER_PROFILE_VERSION
		then do;
			call convert_version (g_data_ptr); /* xup_user_profile is global */
			Serror_occurred = "1"b;
		     end;
		else xup_user_profile = g_data_ptr -> user_profile_overlay;
	     end;

	if ^Serror_occurred & xup_user_profile.new_features_menu_version ^= xup_CURRENT_NEW_FEATURES_MENU_VERSION
	then do;
                    if ^g_first_time_user
                    then call warn_user_of_changes;

		xup_user_profile.new_features_menu_version = xup_CURRENT_NEW_FEATURES_MENU_VERSION;
		call update_profile_i;
	     end;

	if xup_user_profile.use_function_keys
	then g_unused_b1 = set_use_function_keys_i ("1"b);
	else g_unused_b1 = set_use_function_keys_i ("0"b);

	return;

update_profile: entry;

	call update_profile_i;

	return;

display_profile: entry;

	call ioa_ ("version                        ^a", xup_user_profile.version);
	call ioa_ ("handle_interactive_messages    ^b", xup_user_profile.handle_interactive_messages);
	call ioa_ ("multics_mode                   ^b", xup_user_profile.multics_mode);
	call ioa_ ("menu_always                    ^b", xup_user_profile.menu_always);
	call ioa_ ("read_comments_by_subject_chain ^b", xup_user_profile.read_comments_by_subject_chain);
	call ioa_ ("use_function_keys              ^b", xup_user_profile.use_function_keys);
	call ioa_ ("remove_menu_while_editing      ^b", xup_user_profile.remove_menu_while_editing);
	call ioa_ ("mbz                            ^b", xup_user_profile.mbz);
	call ioa_ ("function_key_data_ptr          ^p", xup_user_profile.function_key_data_ptr);
	call ioa_ ("new_features_menu_version      ^a", xup_user_profile.new_features_menu_version);

	return;

delete_profile: entry;

/* AUTOMATIC */

	dcl     dp_code		 fixed bin (35);



	call value_$delete_data (xup_VALUE_SEG_PTR, xup_PERMANENT, xup_XFORUM_USER_PROFILE, dp_code);
	if dp_code ^= 0
	then call com_err_ (dp_code, "xforum_user_profile$delete_profile", "Could not delete profile");
	else call ioa_ ("Your Executive Forum user profile has been deleted.");

	return;

set_handle_interactive_messages: entry (shim_flag) returns (bit (1));

/* PARAMETERS */

	dcl     shim_flag		 bit (1);


	xup_user_profile.handle_interactive_messages = shim_flag;

	return ("1"b);



get_handle_interactive_messages: entry returns (bit (1));

	return (xup_user_profile.handle_interactive_messages);

set_multics_mode: entry (smm_flag) returns (bit (1));

/* PARAMETERS */

	dcl     smm_flag		 bit (1);

/* AUTOMATIC */

	dcl     smm_unused_b1	 bit (1);






	xup_user_profile.multics_mode = smm_flag;
	if xup_user_profile.multics_mode & xup_user_profile.use_function_keys
	then smm_unused_b1 = set_use_function_keys_i ("1"b);

	return ("1"b);



get_multics_mode: entry returns (bit (1));

	return (xup_user_profile.multics_mode);

set_menu_always: entry (sma_flag) returns (bit (1));

/* PARAMETERS */

	dcl     sma_flag		 bit (1);


	xup_user_profile.menu_always = sma_flag;

	return ("1"b);



get_menu_always: entry returns (bit (1));

	return (xup_user_profile.menu_always);

set_read_comments_by_subject: entry (srcbs_flag) returns (bit (1));

/* PARAMETERS */

	dcl     srcbs_flag		 bit (1);


	xup_user_profile.read_comments_by_subject_chain = srcbs_flag;

	return ("1"b);



get_read_comments_by_subject: entry returns (bit (1));

	return (xup_user_profile.read_comments_by_subject_chain);

set_use_function_keys: entry (sufk_flag) returns (bit (1));

/* PARAMETERS */

	dcl     sufk_flag		 bit (1);

/* AUTOMATIC */

	dcl     sufk_return_value	 bit (1);


	sufk_return_value = set_use_function_keys_i (sufk_flag);

	return (sufk_return_value);



get_use_function_keys: entry returns (bit (1));

	return (xup_user_profile.use_function_keys);

set_user_fk_value: entry (ufk_value);

	dcl     ufk_value		 fixed bin (2);

	if ufk_value = USE_FUNCTION_KEYS
	then if ^can_use_function_keys ()		/* dont reset value if not valid */
	     then return;

	xup_user_profile.user_set_fk_value = ufk_value;

	return;


valid_user_fk_FUNCTION: entry returns (bit (1));

	dcl     vufk_return_value	 bit (1);

	vufk_return_value = can_use_function_keys ();

	return (vufk_return_value);


get_user_fk_value: entry returns (fixed bin (2));

	return (xup_user_profile.user_set_fk_value);

set_remove_menu_while_editing: entry (srmwe_flag) returns (bit (1));

/* PARAMETERS */

	dcl     srmwe_flag		 bit (1);


	xup_user_profile.remove_menu_while_editing = srmwe_flag;

	return ("1"b);



get_remove_menu_while_editing: entry returns (bit (1));

	return (xup_user_profile.remove_menu_while_editing);

set_function_key_data_ptr: entry (sfkdp_function_key_data_ptr) returns (bit (1));

/* PARAMETERS */

	dcl     sfkdp_function_key_data_ptr ptr;

	xup_user_profile.function_key_data_ptr = sfkdp_function_key_data_ptr;

	return ("1"b);




get_function_key_data_ptr: entry returns (ptr);

	return (xup_user_profile.function_key_data_ptr);

set_new_features_menu_version: entry (snfmv_version) returns (bit (1));

/* PARAMETERS */

	dcl     snfmv_version	 char (8);

	xup_user_profile.new_features_menu_version = snfmv_version;

	return ("1"b);






get_new_features_menu_version: entry returns (char (8));

	return (xup_user_profile.new_features_menu_version);

init_user_profile: proc;


	xup_user_profile.version = xup_CURRENT_USER_PROFILE_VERSION;
	xup_user_profile.handle_interactive_messages = "1"b;
	xup_user_profile.multics_mode = "0"b;
	xup_user_profile.menu_always = "0"b;
	xup_user_profile.read_comments_by_subject_chain = "0"b;
	xup_user_profile.use_function_keys = "1"b;
	xup_user_profile.user_set_fk_value = 0;
	xup_user_profile.remove_menu_while_editing = "0"b;
	xup_user_profile.mbz = "0"b;
	xup_user_profile.function_key_data_ptr = null ();
	xup_user_profile.new_features_menu_version = xup_CURRENT_NEW_FEATURES_MENU_VERSION;
	xup_user_profile.user_set_fk_value = UNSET;

	call update_profile_i;

	return;

     end init_user_profile;

make_value_seg: proc;

/* AUTOMATIC */

	dcl     mvs_code		 fixed bin (35);
	dcl     mvs_code2		 fixed bin (35);
	dcl     mvs_home_dir	 char (168);
	dcl     mvs_person_id	 char (32);
	dcl     mvs_unused1		 char (1);
	dcl     mvs_unused2		 char (1);
	dcl     mvs_value_seg_ptr	 ptr;

/* CONSTANTS */

	dcl     mvs_SEGMENT		 bit (36) aligned init ("1001"b) internal static options (constant);






	call user_info_$homedir (mvs_home_dir);

	call user_info_ (mvs_person_id, mvs_unused1, mvs_unused2);

	call hcs_$make_seg (mvs_home_dir, rtrim (mvs_person_id) || ".value", "", RW_ACCESS_BIN, mvs_value_seg_ptr, mvs_code);
	if mvs_code ^= 0
	then call error (mvs_code, "Value segment does not exist and it cannot be created.");

	call value_$init_seg (mvs_value_seg_ptr, 0, null (), 0, mvs_code);
	if mvs_code ^= 0
	then do;
		call delete_$ptr (mvs_value_seg_ptr, mvs_SEGMENT, "xforum_user_profile", mvs_code2);
		if mvs_code2 = 0
		then call error (mvs_code, "The just created value segment could not be initialized, it has been deleted.");
		else call error (mvs_code2, "The just created value segment could not be initialized, it also could not be deleted.");
	     end;

	return;

     end make_value_seg;

convert_version: proc (cv_data_ptr);

/* PARAMETERS */

	dcl     cv_data_ptr		 ptr;		/* (input) pointer to user profile stored in value seg */

/* BASED */

	dcl     cv_version_overlay	 char (8) based;

	if cv_data_ptr -> cv_version_overlay = xup_USER_PROFILE_VERSION_1
	then do;
		xup_user_profile = cv_data_ptr -> user_profile_overlay;
		xup_user_profile.version = xup_CURRENT_USER_PROFILE_VERSION;
		xup_user_profile.function_key_data_ptr = null ();
		call warn_user_of_changes;
		xup_user_profile.new_features_menu_version = xup_CURRENT_NEW_FEATURES_MENU_VERSION;
		call update_profile_i;
	     end;
	else
	     if cv_data_ptr -> cv_version_overlay = xup_USER_PROFILE_VERSION_1_1
	then do;
		xup_user_profile = cv_data_ptr -> user_profile_overlay;
		xup_user_profile.version = xup_CURRENT_USER_PROFILE_VERSION;
		call warn_user_of_changes;
		xup_user_profile.new_features_menu_version = xup_CURRENT_NEW_FEATURES_MENU_VERSION;
		call update_profile_i;
	     end;
	else do;
		call ioa_ ("Your user profile is inaccessible or contains invalid data.  A new profile");
		call ioa_ ("containing default values is being built for you.  You may change these");
		call ioa_ ("values by selecting the personalization option on the menu.");
		call timer_manager_$sleep (4, "11"b);

		call init_user_profile;
	     end;

	return;

     end convert_version;

set_use_function_keys_i: proc (sufki_flag) returns (bit (1));

/* PARAMETERS */

	dcl     sufki_flag		 bit (1);

/* AUTOMATIC */

	dcl     sufki_return_value	 bit (1);




	sufki_return_value = "1"b;

	if sufki_flag
	then do;
		if can_use_function_keys ()
		then do;
			if xup_user_profile.user_set_fk_value = USE_ESCAPE_KEYS
			then /* do NOT override users value		*/
			     xup_user_profile.use_function_keys = "0"b;
			else xup_user_profile.use_function_keys = "1"b;
		     end;
		else do;
			call ioa_ ("Function keys are not supported by this terminal type.^/   Escape sequences must be used.");
			call timer_manager_$sleep (4, "11"b);
			xup_user_profile.use_function_keys = "0"b;
			sufki_return_value = "0"b;
		     end;
	     end;
	else xup_user_profile.use_function_keys = "0"b;

	if xup_user_profile.use_function_keys
	then xup_user_profile.function_key_data_ptr = xup_term_type_function_key_data_ptr;
	else do;
		if xup_escape_sequence_function_key_data_ptr = null ()
		then xup_escape_sequence_function_key_data_ptr = xforum_default_fkeys_ ();
		xup_user_profile.function_key_data_ptr = xup_escape_sequence_function_key_data_ptr;
	     end;

	return (sufki_return_value);

     end set_use_function_keys_i;

can_use_function_keys: proc () returns (bit (1));

/* AUTOMATIC */

	dcl     cufk_can_use_function_keys bit (1);
	dcl     cufk_code		 fixed bin (35);
	dcl     01 cufk_term_info	 like terminal_info;

	if xup_term_type_function_key_data_ptr ^= null ()
	then free xup_term_type_function_key_data_ptr -> function_key_data;

	cufk_term_info.version = terminal_info_version;
	call iox_$control (iox_$user_io, "terminal_info", addr (cufk_term_info), cufk_code);
	if cufk_code ^= 0
	then do;
		cufk_can_use_function_keys = "0"b;
		goto exit_can_use_function_keys;
	     end;

	call ttt_info_$function_key_data (cufk_term_info.term_type, null, xup_term_type_function_key_data_ptr, cufk_code);
	if cufk_code ^= 0
	then do;
		cufk_can_use_function_keys = "0"b;
		goto exit_can_use_function_keys;
	     end;

	if xup_term_type_function_key_data_ptr -> function_key_data.highest >= 8
	then cufk_can_use_function_keys = "1"b;
	else
	     if xup_term_type_function_key_data_ptr -> function_key_data.highest <= 6
	then cufk_can_use_function_keys = "0"b;
	else
	     if xup_term_type_function_key_data_ptr -> function_key_data.highest = 7 & ^xup_user_profile.multics_mode
	then cufk_can_use_function_keys = "1"b;
	else cufk_can_use_function_keys = "0"b;

exit_can_use_function_keys:
	return (cufk_can_use_function_keys);

     end can_use_function_keys;

update_profile_i: proc;

/* AUTOMATIC */

	dcl     upi_code		 fixed bin (35);
	dcl     upi_unused_ptr	 ptr;
	dcl     upi_unused_fb18	 fixed bin (18);



	call value_$delete_data (xup_VALUE_SEG_PTR, xup_PERMANENT, xup_XFORUM_USER_PROFILE, upi_code);
	if upi_code ^= 0 & upi_code ^= error_table_$oldnamerr
	then call error (upi_code, "Could not delete old profile prior to updating");
	call value_$set_data (xup_VALUE_SEG_PTR, xup_PERMANENT, xup_XFORUM_USER_PROFILE,
	     addr (xup_user_profile), size (xup_user_profile), null (), upi_unused_ptr, upi_unused_fb18, upi_code);
	if upi_code ^= 0
	then call error (upi_code, "Could not update your old user profile");

	return;

     end update_profile_i;

warn_user_of_changes: proc;

	call ioa_ ("Executive Forum has been changed since you last used it. Select option");
	call ioa_ ("""f"" in the General Help Topics menu for a description of the changes.");
	call timer_manager_$sleep (4, "11"b);

	return;

     end warn_user_of_changes;

error: proc (e_code, e_reason);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);
	dcl     e_reason		 char (512);

	xup_xforum_error_info.name = "xforum_user_profile";
	xup_xforum_error_info.entry = "";
	xup_xforum_error_info.doing = "";
	xup_xforum_error_info.code = e_code;
	xup_xforum_error_info.reason = e_reason;

	call signal_ ("xforum_fatal_error", null (), addr (xup_xforum_error_info), null ());

     end error;

     end xforum_user_profile;




		    xforum_validate_trans_spec_.pl1 08/06/87  1025.1rew 08/06/87  1014.2      298134



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



/****^  HISTORY COMMENTS:
  1) change(85-01-24,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added the set_specified internal proc and its call.
     
     85-02-13 Davids: Changed calling sequence of
     xforum_help_line_$change and $push to include the new F3_message
     argument.
  2) change(86-02-07,LJAdams), approve(86-02-18,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Added the lastref "lref" and restref "rref" options.
  3) change(87-04-15,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-30,Blair), install(87-08-06,MR12.1-1065):
     Changed to allow command_processor_ escapes.
                                                   END HISTORY COMMENTS */


xforum_validate_trans_spec_: proc (P_xforum_meeting_info_ptr, P_spy_ptr, P_trans_spec, P_code);

/*
   BEGIN DESCRIPTION

   function:
      This procedure validates the transaction specifier supplied and either
      returns a standard error code or updates the xforum_meeting_info
      structure appropriately
      
   description of entry points:
      xforum_validate_trans_spec: transaction validation occurs in phases.
      First the specifier is checked to see if its the keyword "search" or "s"
      if it is the search_for_string procedure is called. If not the specifier
      is checked to see if it is nothing but numbers and spaces and there is
      at least 1 space, if so its a set and the set_specified procedure is
      called. These two types of specifiers where added to the code and it
      was decided that this was the simplest approach instead of trying to
      update the keyword tables. If the above two checks fail then
      the characters are checked to be sure that there are only legal
      characters. These are made up of the set of numerals, +, -, :, and the
      letters that make up the (rest of the) keywords.
      Next, the input spec is checked to see if an initial substring matches
      any of the keywords that must appear alone, and if so a check is made to
      be sure that the keyword does indeed appear alone. The trans spec is then
      processed by setting the appropriate values and flags in the
      xforum_meeting_info structure. 
      If the trans spec is not a keyword that must appear alone it is either
      a range or an individual transaction. A subspecification is formed by
      taking the characters before the ":" character and after the ":"
      character. The internal proc verify_spec_string is called to verify these
      subspecifications.
      If the second subspec is null then the original spec did not include
      the ":" character and did not specify a range.  If a range is specified
      a final check is made to be sure that the second subspec specifies a 
      higher transaction than the first subspec.

   description of internal procs:
      verify_spec_string: This internal proc checks to be sure that the
      subspecification of a range end point or of a single transaction is
      valid. A subspec may be a number, keyword or a number,keyword+-number.
      the subspec is first checked to see if its just a number. After the
      transaction number identified by the subspec is determined a call to
      forum_ is made to read the transaction. The purpose is to verify that the
      transaction exits. If the transaction does not exist a call to com_err_
      is made with the error code returned by forum_. The error code is global
      to verify_spec_string so that it can be tested when the reoutine returns.

      search_for_string: this procedure prompts the user to enter a string.
      If all the flags are set to zero then there is only 1 comment selected.
      If only 1 comment is selected then all the comments in the meeting will
      be searched. This is done by saving the current comment index and setting
      the all flag. If there are multiple comments (one of the flags is non
      zero) then only those comments are serached. Messages are output
      telling the user what comments are being searched and what string is
      being looked for. A temp segment is obtained and the set_array structure
      overlaid on it. Each comment that is found to contain the search string
      is added to the set_array. If after all comments have been searched no
      comments arte found then a message to that effect is output and the
      currently selected comments does not change. This requires that if there
      was originally only 1 comment selected the all flag be turned off and the
      current value reset. If the old_current value is non-zero it means that
      there was originally one one comment selected. If only 1 comment was
      found with the search string it is treated as if the user specified
      the comment directly, all the flags are turned off and the current
      field set to that the located comment. If multiple comments were found
      the temporary set array is copied over into the meeting_info set array.
      A quit handler is set up to restore the original selected comments and
      record that the user hit quit. The temp segment is release and the help
      line restored right before the return - which the quit handler goes to.

      set_specified: this procedure pulls apart a sequence of comment numbers
      separated by spaces. It tests to be sure that the comment exists and 
      records the number in a set_array. It also builds a string to be
      displayed for the current comments:.If the indicated transaction does no
      exist or has been deleted a message to that effect is output and the
      index not put in the set_array. The rest of the indices are processed. If
      no comments are selected a message to that effect is output. If only 1
      comment is selected it is treated as if the user entered only the
      number for the comment instead of a set.

      convert_to_number: This procedure is used to convert a string
      representing a comment index into a number. The size condition is
      trapped so that if the number is too large a meaningful error is output
      instead of the size condition message. The number is converted into a
      fixed bin (17,0) because that is what the transaction index parameter
      in forum_$read_trans is declared as. The message indicates that the
      input comment index does not exist.

      report_error: this procedure is used to report errors back to the user.
      It first clears the bottom window so that the user will not get a more
      prompt before the error message and so that the error message stands out.
      Also for the forum error codes invalid_trans_idx, trans_deleted,
      trans_reaped, and bad_trans_spec a standard message is output instead of
      the message associated with the error code. This makes sure that the
      word transaction does not appear and also that the message is a sentance.

      collect_spy_data: this procedure is used to collect information about the
      users response to the prompt and about his use of the quit key. 

      error: this procedure is used to singal xforum_fatal_error, It is called
      only if there is some problem in getting the users response to the
      prompt. There should never be a problem with this.

   known bugs:

   notes:
      84-12-13 Davids: The description of internal procs and entry points 
      probably needs to be updated.
   history:

      83-12-?? DBarker: original coded.

      84-09-06 Davids: Added standard header.

      84-09-11 Davids: Added check to be sure that the P_trans_spec is longer
      than KETTAB1(i) before the substr on P_trans_spec is done.

      84-10-25 Davids: Added code to free the forum_user_trans structure after
      every call to xforum_trans. By not freeing the structures it is possible
      to expand the system area so much that a RQO in the pdir occurs.
      Modified the way that the last transaction is set. The code use to loop
      from the current transaction to the next transaction until the call to
      next failed. The last transaction found was the last transaction. It now
      makes a call to forum_$forum_limits to get the upto date last_trans
      and uses that. It also updates the info in the meeting_list structure.

      84-10-29 Davids: Removed a free in the current section of
      verify_spec_string that I added on 84-10-25. Since it is current there
      was no call to xforum_trans to allocate a forum_user_trans structure
      that has to be freed.

      84-11-06 Davids: Added the internal procedure convert_to_number. Also
      changed the internal automatic comment indices from fixed bin (35) to
      fixed bin since this is what is needed by xforum_trans and ultimately
      forum_. Changed error handling so that if the user specifies an
      index that does not exist the message "Comment <num> does not exist"
      is output instead of "Specified transaction does not exist <num>".

      84-11-15 Davids: Auditing changes: 1) Simplified the if-then-else
      statements that handle the keywords to remove duplicated code. 2) Added
      the "in clause" to the free statements. 3) Corrected messages to end in
      puncuation. 4) Replaced numbers determining which key words were used
      with named constants. 5) Corrected check for overlapping range spec so
      that i:i will NOT kick out as an error. Other changes: 1) Replaced
      transaction with comment in messages. 2) Put dcls in the standard format.

      84-12-13 Davids: Added the procedure report_error. Changed all calls to
      ioa_ and com_err_ to call report_error instead.

      85-01-15 Davids: Added ltrim's to all occurences of char (sub1) so that
      leading spaces are removed.
   END DESCRIPTION
*/

/* PARAMETERS */

	dcl     P_xforum_meeting_info_ptr ptr;
	dcl     P_spy_ptr		 ptr;
	dcl     P_trans_spec	 char (*);
	dcl     P_code		 fixed bin (35);

/* EXTERNAL STATIC */

	dcl     iox_$user_io	 ptr ext static;
	dcl     forum_error_table_$bad_trans_spec fixed bin (35) ext static;
	dcl     forum_error_table_$invalid_trans_idx fixed bin (35) ext static;
	dcl     forum_error_table_$trans_deleted fixed bin (35) ext static;
	dcl     forum_error_table_$trans_reaped fixed bin (35) ext static;

/* ENTRIES */

	dcl     com_err_$suppress_name entry () options (variable);
	dcl     cv_dec_		 entry (char (*)) returns (fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     get_temp_segment_	 entry (char (*), ptr, fixed bin (35));
	dcl     release_temp_segment_	 entry (char (*), ptr, fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     xforum_get_selected_trans$first entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_selected_trans$next entry (ptr, ptr, fixed bin (35));
	dcl     xforum_get_str_	 entry (char(*) var, ptr, char(*), char(*), char(*) var, fixed bin(35));
	dcl     xforum_help_line_$change entry (bit(8), char(*), char(*), char(*));
	dcl     xforum_help_line_$pop	 entry options (variable);
	dcl     xforum_help_line_$push entry (bit(8), char(*), char(*), char(*));
	dcl     xforum_trans_$read	 entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$first_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$first_trans entry (ptr, fixed bin (35));
	dcl     xforum_trans_$next_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$next_trans entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$prev_ref entry (fixed bin, ptr, fixed bin (35));
          dcl     xforum_trans_$last_ref entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_trans_$prev_trans entry (fixed bin, ptr, fixed bin (35));
	dcl     xforum_window_mgr$check_window_status entry options (variable);

/* CONDITIONS */

	dcl     quit		 condition;

/* INTERNAL AUTOMATIC */

	dcl     (sub1, sub2)	 char (40);
	dcl     (sub1n, sub2n)	 fixed bin;
	dcl     i			 fixed bin;
	dcl     range_specified	 bit (1) aligned;
	dcl     code		 fixed bin (35);


/* INTERNAL STATIC */

	dcl     01 xvts_xforum_error_info like xforum_error_info internal static;

/* CONSTANTS */

	dcl     (
	        ON		 bit (1) init ("1"b),
	        OFF		 bit (1) init ("0"b),
	        KEYTAB1		 (15) char (8) var	/* keywords that must appear alone */
				 init ("allref", "aref", "firstref", "fref", "nextref",
				 "nref", "prevref", "pref", "lastref", "lref", "restref", "rref", "all", "a", "new"),
	        KEYTAB2		 (10) char (7) var	/* keywords that needn't appear alone */
				 init ("first", "f", "prev", "p", "current", "c",
				 "next", "n", "last", "l"),
	        ALLREF		 fixed bin init (1),
	        AREF		 fixed bin init (2),
	        FIRSTREF		 fixed bin init (3),
	        FREF		 fixed bin init (4),
	        NEXTREF		 fixed bin init (5),
	        NREF		 fixed bin init (6),
	        PREVREF		 fixed bin init (7),
	        PREF		 fixed bin init (8),
	        LASTREF                fixed bin init (9),
	        LREF		 fixed bin init (10),
	        RESTREF		 fixed bin init (11),
	        RREF		 fixed bin init (12),
	        ALL		 fixed bin init (13),
	        A			 fixed bin init (14),
	        NEW		 fixed bin init (15),
	        FIRST		 fixed bin init (1),
	        F			 fixed bin init (2),
	        PREV		 fixed bin init (3),
	        P			 fixed bin init (4),
	        CURRENT		 fixed bin init (5),
	        C			 fixed bin init (6),
	        LAST		 fixed bin init (9),
	        L			 fixed bin init (10)
	        )			 internal static options (constant);

/* BUILTINS */

	dcl     (
	        addr,
	        after,
	        before,
	        char,
	        hbound,
	        index,
	        length,
	        ltrim,
	        null,
	        rtrim,
	        search,
	        string,
	        substr,
	        unspec,
	        verify
	        )			 builtin;

/* BASED */

	dcl     TRUE		 bit (1) based (addr (ON));
	dcl     xforum_system_area	 area based (xforum_system_area_ptr);


/* INCLUDE FILES */

%include forum_dcls;
%page;
%include forum_user_trans;
%page;
%include xforum_error_info;
%page;
%include xforum_meeting_info;
%page;
%include xforum_ptr_struct_;
%page;
%include xforum_spy;
%page;
%include xforum_windows;
%page;
%include xforum_prompts;


%include xforum_answers;


%include xforum_help_infos;


	P_code = 0;
	forum_user_trans_ptr = null ();

	if P_trans_spec = "search" | P_trans_spec = "s"
	then do;
	     call search_for_string;
	     goto exit_xforum_validate_trans_spec;
	end;

	if ((verify (P_trans_spec, "0123456789 ") = 0) & (index (P_trans_spec, " ") ^= 0))
	then do;
	     call set_specified (P_trans_spec);
	     goto exit_xforum_validate_trans_spec;
	end;

	if verify (P_trans_spec, "0123456789+-:acefilnprstuvwx") ^= 0
	then goto bad_trans_spec;

/* characters are alright at least  */
	do i = 1 to hbound (KEYTAB1, 1);
	     if length (P_trans_spec) >= length (KEYTAB1 (i))
	     then do;
		if KEYTAB1 (i) = substr (P_trans_spec, 1, length (KEYTAB1 (i)))
		then goto found_in_tab1;
	     end;
	end;

	goto not_in_tab1;

found_in_tab1:
	if length (P_trans_spec) ^= length (KEYTAB1 (i))
	then goto bad_trans_spec;			/* these kws must be alone */


	if i = ALLREF | i = AREF
	then do;
	     if xforum_meeting_info.current = 0
	     then do;
		P_code = forum_error_table_$bad_trans_spec;
		call report_error (0, "^a incompatible with current comment specifier.", P_trans_spec);
		goto exit_xforum_validate_trans_spec;
	     end;
	     unspec (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.allref = TRUE;
	     xforum_meeting_info.current_ref = xforum_meeting_info.current;
	     goto exit_xforum_validate_trans_spec;
	end;
          else
               if i = RESTREF | i = RREF
          then do;
               if xforum_meeting_info.current = 0
               then do;
                    P_code = forum_error_table_$bad_trans_spec;
		call report_error (0, "^a incompatible with current comment specifier.", P_trans_spec);
		goto exit_xforum_validate_trans_spec;
                end;
	     unspec (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.restref = TRUE;
	     xforum_meeting_info.current_ref = xforum_meeting_info.current;
	     goto exit_xforum_validate_trans_spec;
	end;

	else
	     if i = ALL | i = A
	then do;
	     unspec (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.all = TRUE;
	     goto exit_xforum_validate_trans_spec;
	end;
	else
	     if i = NEW
	then do;
	     if xforum_meeting_info.last_seen ^< xforum_meeting_info.last_trans
	     then do;
		P_code = forum_error_table_$bad_trans_spec;
		call report_error (0, "There are no new comments.", "");
		goto exit_xforum_validate_trans_spec;
	     end;
	     unspec (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.new = TRUE;
	     goto exit_xforum_validate_trans_spec;
	end;
	else do;					/* firstref | fref | nextref | nref | prevref | pref */
						/* lastref | lref				*/
	     if xforum_meeting_info.current = 0
	     then do;
		P_code = forum_error_table_$bad_trans_spec;
		call report_error (0, "^a incompatible with current comment specifier.", P_trans_spec);
		goto exit_xforum_validate_trans_spec;
	     end;

	     if i = FIRSTREF | i = FREF
	     then call xforum_trans_$first_ref (xforum_meeting_info.current,
		     forum_user_trans_ptr, code);
	     else
		if i = NEXTREF | i = NREF
	     then call xforum_trans_$next_ref (xforum_meeting_info.current,
		     forum_user_trans_ptr, code);
	     else
		if i = PREVREF | i = PREF 
	     then call xforum_trans_$prev_ref (xforum_meeting_info.current,
		     forum_user_trans_ptr, code);
	     else
	          if i = LASTREF | i = LREF
	     then call xforum_trans_$last_ref (xforum_meeting_info.current,
	               forum_user_trans_ptr, code);

	     if code ^= 0
	     then do;
		P_code = code;
		call report_error (P_code, "^a", P_trans_spec);
		goto exit_xforum_validate_trans_spec;
	     end;
	     unspec (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.current = forum_user_trans.trans_no;
	     free forum_user_trans in (xforum_system_area);
	     goto exit_xforum_validate_trans_spec;
	end;

not_in_tab1:					/* let's make some better checks    */
	sub1 = before (P_trans_spec, ":");

	call verify_spec_string (sub1, sub1n);
	if code ^= 0 then do;
	     P_code = code;
	     goto exit_xforum_validate_trans_spec;	/* error messages printed by subr   */
	end;

	sub2 = after (P_trans_spec, ":");

	if sub2 = "" then
	     range_specified = OFF;
	else do;
	     range_specified = ON;

	     call verify_spec_string (sub2, sub2n);
	     if code ^= 0 then do;
		P_code = code;
		goto exit_xforum_validate_trans_spec;
	     end;
	end;

	if range_specified
	then do;					/* check range validity */
	     if sub2n < sub1n
	     then do;
		P_code = forum_error_table_$bad_trans_spec;
		call report_error (0, "Range specification overlaps ^a.", P_trans_spec);
		goto exit_xforum_validate_trans_spec;
	     end;

	     unspec (xforum_meeting_info.flags) = "0"b;

	     xforum_meeting_info.flags.range = ON;

	     xforum_meeting_info.low = sub1n;

	     xforum_meeting_info.high = sub2n;

	     xforum_meeting_info.current = 0;
	end;
	else do;					/* not range		      */
	     unspec (xforum_meeting_info.flags) = "0"b;

	     xforum_meeting_info.current = sub1n;
	end;

exit_xforum_validate_trans_spec:
	return;

bad_trans_spec:
	P_code = forum_error_table_$bad_trans_spec;
	call report_error (0, "Invalid comment specification.", "");
	return;

verify_spec_string: proc (str, num);

	dcl     str		 char (*);
	dcl     num		 fixed bin;

	dcl     (sub1, sub2)	 char (40);
	dcl     (sub1n, sub2n)	 fixed bin;
	dcl     c			 char (1);
	dcl     vss_last_trans	 fixed bin;
	dcl     unused1		 bit (36) aligned;
	dcl     vss_i		 fixed bin;

	if verify (rtrim (str), "0123456789") = 0 then do;
						/* numeric anyway    */
	     sub1 = str;

	     sub1n = convert_to_number (str);

	     call xforum_trans_$read (sub1n, forum_user_trans_ptr, code);
	     if code ^= 0
	     then do;
		call report_error (code, "^a", str);
		goto exit_verify_spec_string;
	     end;
	     else do;
		num = sub1n;
		free forum_user_trans in (xforum_system_area);
		goto exit_verify_spec_string;
	     end;
	end;					/* not numeric - must be +|-	      */
	if search (str, "+-") ^= 0
	then do;
	     c = substr (str, search (str, "+-"), 1);
	     sub1 = before (str, c);
	     sub2 = after (str, c);
	end;
	else do;
	     sub1 = str;
	     sub2 = "";
	end;

	if verify (rtrim (sub2), "0123456789") ^= 0 then do;
	     code = forum_error_table_$bad_trans_spec;
	     call report_error (0, "Comment offsets must be numeric ^a.", str);
	     goto exit_verify_spec_string;
	end;

	sub2n = convert_to_number (sub2);

	if verify (rtrim (sub1), "0123456789") = 0 then
	     sub1n = convert_to_number (sub1);
	else do;					/* need to find in KEYTAB2	      */
	     do i = 1 to hbound (KEYTAB2, 1);
		if KEYTAB2 (i) = rtrim (sub1) then
		     goto found_in_tab2;
	     end;

	     goto bad_trans_spec;			/* slightly naughty */

found_in_tab2:
	     if i = FIRST | i = F
	     then do;
		call xforum_trans_$first_trans (forum_user_trans_ptr,
		     code);
		if code ^= 0 then do;
		     call report_error (code, "^a", ltrim (char (sub1)));
		     goto exit_verify_spec_string;
		end;

		sub1n = forum_user_trans.trans_no;
		free forum_user_trans in (xforum_system_area);
	     end;
	     else
		if i = CURRENT | i = C
	     then do;
		if xforum_meeting_info.current = 0 then do;
		     code = forum_error_table_$bad_trans_spec;
		     call report_error (0, "^a incompatible with current comment specifier.", ltrim (char (sub1)));
		     goto exit_verify_spec_string;
		end;
		sub1n = xforum_meeting_info.current;
	     end;
	     else
		if i = LAST | i = L
	     then do;
		call forum_$forum_limits (xforum_meeting_info.idx,
		     ONLY_UNDELETED,
		     xforum_meeting_info.last_seen,
		     xforum_meeting_info.first_trans,
		     vss_last_trans,
		     xforum_meeting_info.new_trans, unused1, (0));

		if vss_last_trans > xforum_meeting_info.last_trans
		then do;
		     do vss_i = xforum_meeting_info.last_trans + 1 to vss_last_trans;
			xforum_meeting_info.seen_map_ptr -> seen_map (vss_i) = "0"b;
			xforum_meeting_info.unread_count = xforum_meeting_info.unread_count + 1;
		     end;
		     if xforum_meeting_info.next_unread = -1
		     then xforum_meeting_info.next_unread = xforum_meeting_info.last_trans + 1;
		     xforum_meeting_info.last_trans = vss_last_trans;
		end;

		sub1n = vss_last_trans;
	     end;
	     else do;				/* previous or next */
		if xforum_meeting_info.current = 0
		then do;
		     if ^xforum_meeting_info.range
		     then do;			/* range is ok */
			code = forum_error_table_$bad_trans_spec;
			call report_error (0, "^a incompatible with current comment specifier.", ltrim (char (sub1)));
			goto exit_verify_spec_string;
		     end;
		end;

		if i = PREV | i = P
		then do;
		     if xforum_meeting_info.range
		     then call xforum_trans_$prev_trans (xforum_meeting_info.low,
			     forum_user_trans_ptr, code);
		     else call xforum_trans_$prev_trans (xforum_meeting_info.current,
			     forum_user_trans_ptr, code);
		end;
		else do;				/* next */
		     if xforum_meeting_info.range
		     then call xforum_trans_$next_trans (xforum_meeting_info.high,
			     forum_user_trans_ptr, code);
		     else call xforum_trans_$next_trans (xforum_meeting_info.current,
			     forum_user_trans_ptr, code);
		end;

		if code ^= 0
		then do;
		     call report_error (code, "^a", ltrim (char (sub1)));
		     goto exit_verify_spec_string;
		end;

		sub1n = forum_user_trans.trans_no;
		free forum_user_trans in (xforum_system_area);
	     end;
	end;

	if c = "+" then
	     num = sub1n + sub2n;
	else num = sub1n - sub2n;

	if num < 1
	then do;					/* can't have that */
	     code = forum_error_table_$invalid_trans_idx;
	     call report_error (code, "", str);
	     goto exit_verify_spec_string;
	end;

	call xforum_trans_$read (num, forum_user_trans_ptr, code);
	if code = 0
	then free forum_user_trans in (xforum_system_area);
	else call report_error (code, "^a", str);

exit_verify_spec_string:
	return;

     end verify_spec_string;

search_for_string: proc;

/* AUTOMATIC */

	dcl     sfs_code		 fixed bin (35);
	dcl     sfs_old_current_comment fixed bin;
	dcl     sfs_reply		 char (256) varying;
	dcl     sfs_satisfies_search_ptr ptr;
          dcl     prompt                 char (256);

/* CONSTANT */

          dcl     MAX_LEN                fixed bin init (256) internal static options (constant);
	         
/* EXTERNAL ENTRY */

          dcl     error_table_$long_record	
                                         fixed bin(35) ext static;
	         

	xforum_meeting_info_ptr = P_xforum_meeting_info_ptr;
	spy_ptr = P_spy_ptr;
	sfs_old_current_comment = 0;
          answer_array.N = 0;
	answer_array.max_length = MAX_LEN;

	on quit
	     begin;
		call xforum_window_mgr$check_window_status;
		call window_$clear_window (iox_$user_io, (0));
		call collect_spy_data (SPY_AT_18, "QUIT");
		if sfs_old_current_comment ^= 0
		then do;
		     xforum_meeting_info.current = sfs_old_current_comment;
		     string (xforum_meeting_info.flags) = "0"b;
		end;
		goto exit_search_for_string;
	     end;

	call window_$clear_window (iox_$user_io, (0));

	call xforum_help_line_$push ("0"b, "", "", "Press  ? and RETURN:help  BREAK:To leave current comments unchanged");

          prompt = TEXT_PROMPT;
get_search_string:
          call xforum_get_str_ ((prompt), addr(answer_array), PROMPT_HELP, "search_spec", sfs_reply, sfs_code);
 
          if sfs_code = error_table_$long_record
          then do;
               call ioa_ ("The search text can only be ^d characters - please reenter^/   (or press BREAK to return to menu).", MAX_LEN);
	     goto get_search_string;
          end;

	if length(sfs_reply) = 0
	then do;
	     call collect_spy_data (SPY_AT_18, "RETURN");
               prompt = BREAK_PROMPT;
	     goto get_search_string;
	end;

	if string (xforum_meeting_info.flags) = "0"b
	then do;
	     sfs_old_current_comment = xforum_meeting_info.current;
	     xforum_meeting_info.flags.all = "1"b;
	end;
	else sfs_old_current_comment = 0;

	if xforum_meeting_info.flags.all
	then call ioa_ ("^/Searching all comments in this meeting for the text ^a,^/   this may take a while", sfs_reply);
	else call ioa_ ("^/Searching the currently selected comments for the text ^a,^/ this may take a while", sfs_reply);

	call xforum_help_line_$change ("0"b, "", "To abort search and leave current comments unchanged", "");

	call get_temp_segment_ ("xforum_validate_trans_spec", sfs_satisfies_search_ptr, sfs_code);
	if sfs_code ^= 0
	then call error (sfs_code, "Could not get temp segment to hold comment indicies that satisfiy text search.");

	sfs_satisfies_search_ptr -> set_array.number = 0;
	sfs_satisfies_search_ptr -> set_array.spec = sfs_reply;

	call xforum_get_selected_trans$first (xforum_meeting_info_ptr, forum_user_trans_ptr, sfs_code);
	do while (sfs_code ^= forum_error_table_$invalid_trans_idx);
	     if sfs_code = 0
	     then do;
		if index (forum_user_trans_ptr -> forum_user_trans.text, sfs_satisfies_search_ptr -> set_array.spec) ^= 0
		then do;
		     sfs_satisfies_search_ptr -> set_array.number = sfs_satisfies_search_ptr -> set_array.number + 1;
		     sfs_satisfies_search_ptr -> set_array.index (sfs_satisfies_search_ptr -> set_array.number) = forum_user_trans_ptr -> forum_user_trans.trans_no;
		end;
	     end;
	     call xforum_get_selected_trans$next (xforum_meeting_info_ptr, forum_user_trans_ptr, sfs_code);
	end;

	if sfs_satisfies_search_ptr -> set_array.number = 0
	then do;
	     call ioa_ ("^/No comments contained the text ^a", sfs_reply);
	     P_code = forum_error_table_$bad_trans_spec;
	     if sfs_old_current_comment ^= 0
	     then do;
		xforum_meeting_info.current = sfs_old_current_comment;
		string (xforum_meeting_info.flags) = "0"b;
	     end;
	end;
	else if sfs_satisfies_search_ptr -> set_array.number = 1
	then do;
	     xforum_meeting_info.current = sfs_satisfies_search_ptr -> set_array.index (1);
	     string (xforum_meeting_info.flags) = "0"b;
	end;
	else do;
	     string (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.flags.set = "1"b;
	     xforum_meeting_info.set_array_ptr -> set_array.number = sfs_satisfies_search_ptr -> set_array.number;
	     xforum_meeting_info.set_array_ptr -> set_array = sfs_satisfies_search_ptr -> set_array;
	end;

exit_search_for_string:
	call release_temp_segment_ ("xforum_validate_trans_spec", sfs_satisfies_search_ptr, (0));
	call xforum_help_line_$pop;

	return;

     end search_for_string;

set_specified: proc (ss_trans_spec);

/* PARAMETERS */

	dcl     ss_trans_spec	 char (*);

/* AUTOMATIC */

	dcl     ss_code		 fixed bin (35);
	dcl     ss_index		 fixed bin;
	dcl     ss_index_string	 char (10) varying;
	dcl     ss_trans_spec_temp	 char (500) varying;





	set_array.number = 0;
	set_array.spec = "";
	ss_trans_spec_temp = ltrim (rtrim (ss_trans_spec));
	do while (length (ss_trans_spec_temp) > 0);
	     ss_index_string = before (ss_trans_spec_temp, " ");
	     ss_trans_spec_temp = ltrim (after (ss_trans_spec_temp, " "));
	     ss_index = convert_to_number ((ss_index_string));
	     call xforum_trans_$read (ss_index, forum_user_trans_ptr, ss_code);
	     if ss_code = 0
	     then do;
		free forum_user_trans in (xforum_system_area);
		set_array.number = set_array.number + 1;
		set_array.index (set_array.number) = ss_index;
		if length (set_array.spec) + length (ss_index_string) + 1 <= SET_ARRAY_SPEC_LEN
		then do;
		     set_array.spec = set_array.spec || ss_index_string;
		     set_array.spec = set_array.spec || " ";
		end;
	     end;
	     else do;
		if ss_code = forum_error_table_$trans_deleted | ss_code = forum_error_table_$trans_reaped
		then call ioa_ ("Comment ^i has been deleted and will not be included in the set.", ss_index);
		else call ioa_ ("Comment ^i does not exist and will not be included in the set.", ss_index);
		call timer_manager_$sleep (3, "11"b);
	     end;
	end;

	if set_array.number = 0
	then do;
	     call ioa_ ("^/No comments were selected.");
	     P_code = forum_error_table_$bad_trans_spec;
	end;
	else
	     if set_array.number = 1
	then do;
	     string (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.current = set_array.index (1);
	end;
	else do;
	     string (xforum_meeting_info.flags) = "0"b;
	     xforum_meeting_info.flags.set = "1"b;
	     xforum_meeting_info.current = 0;
	end;

	return;

     end set_specified;

(size): convert_to_number: proc (ctn_str) returns (fixed bin);

/* PARAMETERS */

	dcl     ctn_str		 char (*);

/* AUTOMATIC */

	dcl     ctn_i		 fixed bin;

/* CONDITIONS */

	dcl     size		 condition;

	on size
	     begin;
		P_code = forum_error_table_$invalid_trans_idx;
		call report_error (P_code, "", ctn_str);
		goto exit_xforum_validate_trans_spec;
	     end;

	ctn_i = cv_dec_ (ctn_str);

	return (ctn_i);

     end convert_to_number;

report_error: proc (re_code, re_message, re_data);

	dcl     re_code		 fixed bin (35);
	dcl     re_message		 char (*);
	dcl     re_data		 char (*);

	call window_$clear_window (xforum_windows.bottom.iocb, (0));

	if re_code = forum_error_table_$invalid_trans_idx
	then call ioa_ ("Comment ^a does not exist.", re_data);
	else
	     if re_code = forum_error_table_$trans_deleted | re_code = forum_error_table_$trans_reaped
	then call ioa_ ("Comment ^a has been deleted.", re_data);
	else
	     if re_code = forum_error_table_$bad_trans_spec
	then call ioa_ ("^a is not a valid comment specifier", re_data);
	else
	     if re_code = 0
	then call ioa_ (re_message, re_data);
	else call com_err_$suppress_name (re_code, "", re_message, re_data);

	return;

     end report_error;

collect_spy_data: proc (csd_where, csd_response);

/* PARAMETERS */

	dcl     csd_where		 fixed bin;
	dcl     csd_response	 char (*);

	spy.count = spy.count + 1;
	spy.choices (count).at = csd_where;
	spy.choices (count).choice = csd_response;

	return;

     end collect_spy_data;

error: proc (e_code, e_reason);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);
	dcl     e_reason		 char (*);

	xvts_xforum_error_info.name = "xforum_validate_trans_spec_";
	xvts_xforum_error_info.entry = "";
	xvts_xforum_error_info.doing = "";
	xvts_xforum_error_info.code = e_code;
	xvts_xforum_error_info.reason = e_reason;

	call signal_ ("xforum_fatal_error", null (), addr (xvts_xforum_error_info), null ());

     end error;

     end xforum_validate_trans_spec_;





		    xforum_window_mgr.pl1           08/06/87  1025.1rew 08/06/87  1014.6      273375



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


/****^  HISTORY COMMENTS:
  1) change(85-01-08,Davids), approve(86-02-04,MCR7350),
     audit(86-04-24,Gilcrease), install(86-04-24,MR12.0-1048):
     Deleted the function_key_data_ptr and handle_interactive_messages
     input parameters from the get_help entry.  Replaced the parameters
     with internal automatic variables set via calls to the
     xforum_user_profile routine.
     
     85-01-14 Davids: replaced calls to accept_messages and
     defer_messages with calls to xforum_im_mgr$accept_messages and
     defer_messages.
     
     85-04-18 Davids: Added a check to be sure that the user_io window
     width is at least 79 columns wide.  Error list entry #9.
  2) change(87-04-03,LJAdams), approve(87-04-22,MCR7684),
     audit(87-07-24,Blair), install(87-08-06,MR12.1-1065):
     Changed setting up/shutting down msg.
                                                   END HISTORY COMMENTS */


xforum_window_mgr: proc;

/* BEGIN DESCRIPTION

function:
   This module contains entry points for managing the 
   structure of the xforum windows.

description of entry points:
   set_up_xforum_windows: This entry point is used to create the windows used
   by xforum. The video system is invoked if its not already turned on. Xforum 
   builds its windows by carving out pieces of the user_io window, the
   user_io window must start out with at least 19 lines or there will not be
   enough space for all the windows under all circumstances. The entry also
   sets the value of the internal static flag xwm_no_local_menu_display. The
   value of this flag is set to true if the value of "xforum_have_local_menus._"
   in the user's permanent value segment is "yes". Otherwise it is set to
   false. This flag is used to allow a user to bypass the menu display if
   he has some other form of local display capability. Note that the menu
   window is originally created with only 1 line. It is resized as the size of
   the menu to be displayed changes. If the xwm_no_local_menu_display is false
   the menu window is resized to 0 lines. 

   resynch_windows: This entry is used to adjust the current sizes of the
   xforum_windows.menu.iocb window and the user_io (bottom) window so that
   there is enough (and only enough) room for the current menu's requirements.
   All the work is done by calling the resynch_windows_p procedure. 
   Note that if the xwm_no_local_menu_display is false this entry is just a
   no-op since the menu window is not being use.

   check_window_status: This entry checks all the xforum windows to be sure
   that none of them have a window_status_pending flag set. If a window does
   have the flag set a call is made to fix_status which resets the flag. If any
   window had the flag set a call to redisplay is made to redisplay all the
   windows cause we don't know why the flag was set and must assume that the
   screen image has been changed.

   prepare_to_shut_down: This entry is used to start the xforum termination
   process. The user_io window is reset back to its original size. An input
   flag is used to determine if the call is being made in response to a
   normal termination or a cleanup being executed. If its a normal termination
   the user_io window (newly enlarged) is cleared and write_shut_down_message
   is called to tell the user that xforum is shutting down.

   shut_down_xforum_windows: is called to destroy the status, menu, and
   help_line windows. An input flag is used to determine if the call is being
   made in response to a normal termination or a cleanup being executed. If its
   a normal termination the user_io window is cleared, getting rid of the shut
   down message. If the video_system was turned during the
   set_up_xforum_windows call then it is turned off here.

   menu_display: This entry is used to display xforum menus. All xforum static
   menus are displayed via this entry. This entry does nothing if the
   xwm_no_local_menu_display flag is set to false. xforum dynamic menus are
   not displayed using this entry. Dynamic menus must be displayed regardless
   of the value of the xwm_no_local_menu_display flag.

   menu_get_choice: This entry is used to get a menu choice from the user for
   all xforum static menus. If the xwm_no_local_menu_display flag is true
   a call is made to menu_$get_choice. If the flag is false a special protocol
   is used to get the user's response. Two characters are input via
   iox_$get_line. The first character must be a 0 or 1, any other character is
   rejected WITHOUT an error message and a call made to get another character.
   A 1 indicates that the next character identifies a function key while a 0
   indicates that the next character is a menu option choice. Menu choices
   and function keys are identified by number. The number is represented as a
   character, i.e. 5 is the character \005, 12 is \014. This character is then
   appended onto the end of a bit string to produce a fixed bin number. the
   result of this is a function key flag and menu choice - the same as the call
   to menu_$get_choice.

description of internal procedures:

   fix_status: does a call to get_window_status for the input window iocb_ptr.
   The result of this call is to reset the window_status_pending flag for the
   window. The ttp_changed bit of the status structure is also checked. If the
   terminal type has changed then the current width is obtained via a call to
   get_window_info. If the current terminal width is less than the original 
   width an error will be signaled. It would be better to just delete all the
   menus and recreate them as needed but at the moment this would require a 
   massive change. This will at least catch the error.

   create_status_window: Creates the two line status window at the top of
   user_io.

   create_menu_window: Creates a 1 line menu window uder the status window..

   create_bottom_window: Resizes the user_io window so that it starts under the
   menu window and extends to one line above its original last line.

   create_help_line_window: Creates a 1 line help_line window on the line
   following the new last line of the user_io window.

   write_start_up_message: Determines the center line of the original user_io
   window and then writes a message telling the user that Xforum is starting
   up on that line. The message is also centered within the line. After the 
   message is written the cursor is positioned 2 lines below it on the left
   margin. This is done so that any error messages that are output are easier
   to read. A window_$sync is done to force the message to be output.

   write_shut_down_message: Uses the center_line and left margin determined
   in write_start_up_message to write a shut down message. After the 
   message is written the cursor is positioned 2 lines below it on the left
   margin. This is done so that any error messages that are output are easier
   to read. A window_$sync is done to force the message to be output.

   resynch_windows_p: This procedure implements the resynch_windows entry.
   If the input required size is 0 or negative it means that no menu window is 
   needed and the bottom window is to be expanded over the menu window and, if
   the size is negative, into the status window. It is assumed that no output
   will be done to the menu window (and status window) so it (they) is not
   destroyed. A flag is also input to control the clearing of the bottom
   window. In some cases like multics mode you do not want to clear the bottom
   window. In other cases like changing menus you do want to clear it.

   error: this is called when a fatal error has been detected by xforum.
   A fatal error happens when an unexpected error code is returned from
   a system routine, i.e. a non-zero code returned from video_utils, or the
   user's original user_io window is too small. It signals the
   xforum_fatal_error condition. There is a condition handler for this
   in the xforum module.

known bugs:

notes:

history:
  84-06-19 Davids: Written.

  84-06-21 Davids: Added support for the mm_status_window and flag to the
  parameters of resynch_windows to control clearing the bottom window. On
  multics mode we do not want to clear the bottom window.

  84-07-05 Davids: Added local menu display capability. To do this the 
  entries menu_display and menu_get_choice were added. Also the
  resync_windows_p internal proc and changed the resynch_windows entry
  to call it. This was needed so that the resynch_windows entry can be
  a no-op if process has local menu display.

  84-07-06 Davids: Changed the status window to be 3 lines instead of 2 lines.
  This required shifting the menu and bottom windows down by 1. This was done
  so that the menu title can become part of the status window instead of
  part of the menu. This will allow the menu title - which includes the current
  meeting name to be displayed even with local display of the menus.
  Modified the resynch_windows entry to clear the bottom window if local
  display of the menus occurs.

  84-07-24 Davids: Removed the mm_status window and created the help_line
  window.

  84-08-13 Davids: Added the parameter mgc_handle_interactive_messages to
  the menu_get_choice entry and the code to handle messages. If the
  flag is set then before the choice is input messages will be accepted.
  Messages already recieved will be printed in the user_io window and then 
  deleted. After the menu choice is input messages will again be defered.

  84-08-30 Davids: Added the ptsd_ and sdxw_ cleanup_flag to the
  prepare_to_shut_down and shut_down_xforum_windows entrys. These will
  control i/o to the terminal. If cleanup is signaled there should be no
  i/o done.

  84-08-31 Davids: Changed check_window_status to do a position_cursor_rel
  with a 0 change in line and column instead of a position_cursor. This was
  needed so that when the user hits a quit in multics mode the cursor is not
  repositioned. (The quit handler calls the check_window_status entry.)

  84-09-19 Davids: changed references to origin.mbz in the window structures
  to origin.column and set the value to 1 instead of 0. This was needed
  because the system window structure was changed.

  84-09-25 Changed from xforum_have_local_menus to xforum_have_local_menus._

  84-10-04 Davids: Added code to the fix_status procedure to test the
  ttp_changed bit and if on to compare the current terminal width with the
  original terminal width. If the terminal is narrower an error will occur.

  84-10-22 Davids: Changed message handling so that it is the same as
  Xmail's, except for the -brief control arg for print_messages. Xforum
  will not start using the MR11 message system control args until after a
  controlled release tape is cut.

   84-11-07 Davids: Audit changes: 1) Corrected if statement that determined
   the smallest height of the screen. It was checking for 20 when it should
   have been checking for 19. 2) Added calls to iox_$destroy_iocb to destroy
   the window iocbs after destroying the windows. 3) Added the mgc_choice_based
   variable to convert the choice from a character to a fixed bin number
   instead of calling unspec. 4) Cleaned up some messages, added initial
   capitals and periods. 5) Moved the starting up message into a constant
   since it is referenced twice.

   84-11-16 Davids: Added the "-brief" argument to the call to print_messages
   This is needed so that the call does not result in a "You have no messages"
   message being output. print_message was incompatibly changed.
END DESCRIPTION
*/

/* PARAMETERS */

/* GLOBAL */

/* EXTERNAL STATIC */

	dcl     iox_$user_io	 ptr ext static;
	dcl     video_data_$terminal_iocb ptr ext static;
	dcl     video_et_$window_status_pending fixed bin (35) ext static;

/* ENTRIES */

	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     iox_$destroy_iocb	 entry (ptr, fixed bin (35));
	dcl     iox_$find_iocb	 entry (char (*), ptr, fixed bin (35));
	dcl     menu_$display	 entry (ptr, ptr, fixed bin (35));
	dcl     menu_$get_choice	 entry (ptr, ptr, ptr, bit (1) aligned, fixed bin, fixed bin (35));
	dcl     signal_		 entry () options (variable);
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));
	dcl     value_$get		 entry () options (variable);
	dcl     video_utils_$turn_off_login_channel entry (fixed bin (35));
	dcl     video_utils_$turn_on_login_channel entry (fixed bin (35), char (*));
	dcl     window_$clear_window	 entry (ptr, fixed bin (35));
	dcl     window_$create	 entry (ptr, ptr, ptr, fixed bin (35));
	dcl     window_$destroy	 entry (ptr, fixed bin (35));
	dcl     window_$get_one_unechoed_char entry (ptr, char (1) var, bit (1) aligned, fixed bin (35));
	dcl     window_$overwrite_text entry (ptr, char (*), fixed bin (35));
	dcl     window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));
	dcl     window_$position_cursor_rel entry (ptr, fixed bin, fixed bin, fixed bin (35));
	dcl     window_$sync	 entry (ptr, fixed bin (35));
	dcl     xforum_im_mgr$accept_messages entry ();
	dcl     xforum_im_mgr$defer_messages entry ();
	dcl     xforum_redisplay_	 entry options (variable);
	dcl     xforum_user_profile$get_function_key_data_ptr entry () returns (ptr);
	dcl     xforum_user_profile$get_handle_interactive_messages entry () returns (bit (1));

/* CONDITIONS */

/* INTERNAL AUTOMATIC */

/* INTERNAL STATIC */

	dcl     xwm_center_line	 fixed bin internal static;
	dcl     xwm_left_margin	 fixed bin internal static;
	dcl     xwm_no_local_menu_display bit (1) internal static;
	dcl     xwm_video_was_already_on bit (1) internal static;
	dcl     01 xwm_xforum_error_info like xforum_error_info internal static;


/* CONSTANTS */

	dcl     xwm_WAIT_FOR_INPUT	 bit (1) aligned init ("1"b) internal static options (constant);

/* BUILTINS */

	dcl     addr		 builtin;
	dcl     divide		 builtin;
	dcl     length		 builtin;
	dcl     null		 builtin;

/* BASED */

/* INCLUDE FILES */

%include xforum_error_info;
%page;
%include xforum_windows;
%page;
%include window_status;

set_up_xforum_windows: entry;

/* AUTOMATIC */

	dcl     suxw_code		 fixed bin (35);
	dcl     suxw_local_menu_state	 char (3);
	dcl     suxw_reason		 char (512);

	xwm_video_was_already_on = (video_data_$terminal_iocb ^= null);
	if ^xwm_video_was_already_on then do;
	     call video_utils_$turn_on_login_channel (suxw_code, suxw_reason);
	     if suxw_code ^= 0 then
		call error (suxw_code, suxw_reason);
	end;

	call window_$clear_window (iox_$user_io, suxw_code);
	if suxw_code ^= 0 then
	     call error (suxw_code, "Could not clear user_io window");

	xforum_windows.orig_user_io.version = window_position_info_version_1;
	call iox_$control (iox_$user_io, "get_window_info",
	     addr (xforum_windows.orig_user_io.position), suxw_code);
	if suxw_code ^= 0 then
	     call error (suxw_code, "Could not get the user_io window data");

	if xforum_windows.orig_user_io.extent.height < 19
          then call error (0, "The user_io window is to small to run Xforum.^/   The window must be at least 19 lines high.");

          if xforum_windows.orig_user_io.extent.width < 79
          then call error (0, "The user_io window is to narrow to run Xforum.^/   The window must be at least 79 columns wide.");

	call write_start_up_message;

	call create_status_window;

	call create_menu_window;

	call create_bottom_window;

	call create_help_line_window;

	xwm_no_local_menu_display = "1"b;
	call value_$get (null (), "11"b, "xforum_have_local_menus._", suxw_local_menu_state, suxw_code);
	if suxw_code = 0
	then do;
	     if suxw_local_menu_state = "yes"
	     then do;
		xwm_no_local_menu_display = "0"b;
		call resynch_windows_p (0, "0"b);
	     end;
	end;

	return;

resynch_windows: entry (rw_size_needed, rw_clear_bottom_window);

/* PARAMETERS */

	dcl     rw_size_needed	 fixed bin;
	dcl     rw_clear_bottom_window bit (1);


	if xwm_no_local_menu_display
	then call resynch_windows_p (rw_size_needed, rw_clear_bottom_window);
	else call window_$clear_window (xforum_windows.bottom.iocb, (0));

	return;

check_window_status: entry;

/* AUTOMATIC */

	dcl     cws_any_window_status_pending bit (1);
	dcl     cws_code		 fixed bin (35);
	cws_any_window_status_pending = "0"b;

	call window_$position_cursor_rel (xforum_windows.status.iocb, 0, 0, cws_code);
	if cws_code = video_et_$window_status_pending
	then do;
	     call fix_status (xforum_windows.status.iocb);
	     cws_any_window_status_pending = "1"b;
	end;
	else
	     if cws_code ^= 0
	then call error (cws_code, "error in status window");

	call window_$position_cursor_rel (xforum_windows.help_line.iocb, 0, 0, cws_code);
	if cws_code = video_et_$window_status_pending
	then do;
	     call fix_status (xforum_windows.help_line.iocb);
	     cws_any_window_status_pending = "1"b;
	end;
	else
	     if cws_code ^= 0
	then call error (cws_code, "error in help line window");

	call window_$position_cursor_rel (xforum_windows.menu.iocb, 0, 0, cws_code);
	if cws_code = video_et_$window_status_pending
	then do;
	     call fix_status (xforum_windows.menu.iocb);
	     cws_any_window_status_pending = "1"b;
	end;
	else
	     if cws_code ^= 0
	then call error (cws_code, "error in menu window");

	call window_$position_cursor_rel (xforum_windows.bottom.iocb, 0, 0, cws_code);
	if cws_code = video_et_$window_status_pending
	then do;
	     call fix_status (xforum_windows.bottom.iocb);
	     cws_any_window_status_pending = "1"b;
	end;
	else
	     if cws_code ^= 0
	then call error (cws_code, "error in bottom window");

	if cws_any_window_status_pending then call xforum_redisplay_ ();

	return;

prepare_to_shut_down: entry (ptsd_cleanup_flag);

/* PARAMETERS */

	dcl     ptsd_cleanup_flag	 bit (1);

/* AUTOMATIC */

	dcl     ptsd_code		 fixed bin (35);


	call iox_$control (iox_$user_io, "set_window_info", addr (xforum_windows.orig_user_io.position), ptsd_code);

	if ^ptsd_cleanup_flag
	then do;
	     call window_$clear_window (iox_$user_io, ptsd_code);
	     call write_shut_down_message;
	end;

	return;

shut_down_xforum_windows: entry (sdxw_cleanup_flag);

/* PARAMETERS */

	dcl     sdxw_cleanup_flag	 bit (1);

/* AUTOMATIC */

	dcl     sdxw_code		 fixed bin (35);

	if xforum_windows.status.iocb ^= null ()
	then do;
	     call window_$destroy (xforum_windows.status.iocb, sdxw_code);
	     call iox_$destroy_iocb (xforum_windows.status.iocb, sdxw_code);
	end;

	if xforum_windows.help_line.iocb ^= null ()
	then do;
	     call window_$destroy (xforum_windows.help_line.iocb, sdxw_code);
	     call iox_$destroy_iocb (xforum_windows.help_line.iocb, sdxw_code);
	end;

	if xforum_windows.menu.iocb ^= null ()
	then do;
	     call window_$destroy (xforum_windows.menu.iocb, sdxw_code);
	     call iox_$destroy_iocb (xforum_windows.menu.iocb, sdxw_code);
	end;

	if ^sdxw_cleanup_flag
	then call window_$clear_window (iox_$user_io, sdxw_code);

	if ^xwm_video_was_already_on
	then call video_utils_$turn_off_login_channel (sdxw_code);

	return;

menu_display: entry (md_menu_ptr);

/* PARAMETERS */

	dcl     md_menu_ptr		 ptr;

/* AUTOMATIC */

	dcl     md_code		 fixed bin (35);




	if xwm_no_local_menu_display
	then do;
	     call menu_$display (xforum_windows.menu.iocb, md_menu_ptr, md_code);
	     if md_code ^= 0
	     then call error (md_code, "Could not display menu");
	end;

	return;

menu_get_choice: entry (mgc_menu_ptr, mgc_function_key_flag, mgc_choice);

/* PARAMETERS */

	dcl     mgc_menu_ptr	 ptr;
	dcl     mgc_function_key_flag	 bit (1) aligned;
	dcl     mgc_choice		 fixed bin;

/* AUTOMATIC */

	dcl     mgc_choice_char_v	 char (1) varying;
	dcl     mgc_code		 fixed bin (35);
	dcl     mgc_function_key_char_flag char (1) varying;
	dcl     mgc_function_key_data_ptr ptr;
	dcl     mgc_handle_interactive_messages bit (1);

/* BASED */

	dcl     01 mgc_choice_based	 based (addr (mgc_choice)),
		02 pad		 bit (27) unal,
		02 choice		 char (1) unal;

	mgc_handle_interactive_messages = xforum_user_profile$get_handle_interactive_messages ();
	mgc_function_key_data_ptr = xforum_user_profile$get_function_key_data_ptr ();

	if mgc_handle_interactive_messages
	then call xforum_im_mgr$accept_messages;

	if xwm_no_local_menu_display
	then do;
	     call menu_$get_choice (xforum_windows.menu.iocb, mgc_menu_ptr, mgc_function_key_data_ptr, mgc_function_key_flag, mgc_choice, mgc_code);
	     if mgc_code ^= 0
	     then call error (mgc_code, "Could not get menu choice from menu software");
	end;
	else do;
	     mgc_function_key_char_flag = "";
	     do while (mgc_function_key_char_flag ^= "0" & mgc_function_key_char_flag ^= "1");
		call window_$get_one_unechoed_char (iox_$user_io, mgc_function_key_char_flag, xwm_WAIT_FOR_INPUT, mgc_code);
		if mgc_code ^= 0
		then call error (mgc_code, "Could not get the function key flag character");
	     end;
	     call window_$get_one_unechoed_char (iox_$user_io, mgc_choice_char_v, xwm_WAIT_FOR_INPUT, mgc_code);
	     if mgc_code ^= 0
	     then call error (mgc_code, "Could not get the choice character");

	     if mgc_function_key_char_flag = "0"
	     then mgc_function_key_flag = "0"b;
	     else mgc_function_key_flag = "1"b;

	     mgc_choice_based.pad = "0"b;
	     mgc_choice_based.choice = mgc_choice_char_v;
	end;

	if mgc_handle_interactive_messages
	then call xforum_im_mgr$defer_messages;

	return;

fix_status: proc (fs_iocb_ptr);

/* PARAMETERS */

	dcl     fs_iocb_ptr		 ptr parameter;

/* AUTOMATIC */

	dcl     fs_code		 fixed bin (35);
	dcl     01 fs_window_info	 like window_position_info;
	dcl     01 fs_window_status_info like window_status_info;

/* BASED */

	dcl     01 fs_window_status_string like window_status based;

	fs_window_status_info.version = window_status_version;
	call iox_$control (fs_iocb_ptr, "get_window_status", addr (fs_window_status_info), fs_code);
	if fs_code ^= 0
	then call error (fs_code, "Could not get status window");

	if addr (fs_window_status_info.status_string) -> fs_window_status_string.ttp_change
	then do;
	     fs_window_info.version = window_position_info_version;
	     call iox_$control (iox_$user_io, "get_window_info", addr (fs_window_info), fs_code);
	     if fs_code ^= 0
	     then call error (fs_code, "Could not determine the new terminal width.");
	     if fs_window_info.extent.width < xforum_windows.orig_user_io.extent.width
	     then call error (0, "Your new terminal is narrower than your last terminal - you must reinvoke Executive Forum.");
	end;

	return;

     end fix_status;

create_status_window: proc;

/* AUTOMATIC */

	dcl     csw_code		 fixed bin (35);

	xforum_windows.status.position.version = window_position_info_version_1;
	xforum_windows.status.position.origin.column = 1;
	xforum_windows.status.position.origin.line = xforum_windows.orig_user_io.position.origin.line;
	xforum_windows.status.position.extent.width = xforum_windows.orig_user_io.position.extent.width;
	xforum_windows.status.position.extent.height = 2;

	call iox_$find_iocb ("xforum_status" || unique_chars_ ("0"b), xforum_windows.status.iocb, csw_code);
	if csw_code ^= 0
	then call error (csw_code, "Could not create status window iocb");

	call window_$create (video_data_$terminal_iocb, addr (xforum_windows.status.position), xforum_windows.status.iocb, csw_code);
	if csw_code ^= 0
	then call error (csw_code, "Could not create status window");

	return;

     end create_status_window;

create_menu_window: proc;

/* AUTOMATIC */

	dcl     cmw_code		 fixed bin (35);

	xforum_windows.menu.position.version = window_position_info_version_1;
	xforum_windows.menu.position.origin.column = 1;
	xforum_windows.menu.position.origin.line = xforum_windows.orig_user_io.position.origin.line + 2;
	xforum_windows.menu.position.extent.width = xforum_windows.orig_user_io.position.extent.width;
	xforum_windows.menu.position.extent.height = 1;

	call iox_$find_iocb ("xforum_menu" || unique_chars_ ("0"b), xforum_windows.menu.iocb, cmw_code);
	if cmw_code ^= 0
	then call error (cmw_code, "Could not create menu window iocb");

	call window_$create (video_data_$terminal_iocb, addr (xforum_windows.menu.position), xforum_windows.menu.iocb, cmw_code);
	if cmw_code ^= 0
	then call error (cmw_code, "Could not create menu window");

	return;

     end create_menu_window;

create_bottom_window: proc;

/* AUTOMATIC */

	dcl     cbw_code		 fixed bin (35);

	xforum_windows.bottom.position.version = window_position_info_version_1;
	xforum_windows.bottom.position.origin.column = 1;
	xforum_windows.bottom.position.origin.line = xforum_windows.orig_user_io.position.origin.line + 3;
	xforum_windows.bottom.position.extent.width = xforum_windows.orig_user_io.position.extent.width;
	xforum_windows.bottom.position.extent.height = xforum_windows.orig_user_io.position.extent.height - 4;

	xforum_windows.bottom.iocb = iox_$user_io;

	call iox_$control (xforum_windows.bottom.iocb, "set_window_info",
	     addr (xforum_windows.bottom.position), cbw_code);
	if cbw_code ^= 0
	then call error (cbw_code, "Could not resize user_io for the bottom window");

	return;

     end create_bottom_window;

create_help_line_window: proc;

/* AUTOMATIC */

	dcl     chlw_code		 fixed bin (35);

	xforum_windows.help_line.position.version = window_position_info_version_1;
	xforum_windows.help_line.position.origin.column = 1;
	xforum_windows.help_line.position.origin.line = xforum_windows.orig_user_io.position.origin.line
	     + xforum_windows.orig_user_io.position.extent.height - 1;
	xforum_windows.help_line.position.extent.width = xforum_windows.orig_user_io.position.extent.width;
	xforum_windows.help_line.position.extent.height = 1;

	call iox_$find_iocb ("xforum_help_line" || unique_chars_ ("0"b), xforum_windows.help_line.iocb, chlw_code);
	if chlw_code ^= 0
	then call error (chlw_code, "Could not create help line window iocb");

	call window_$create (video_data_$terminal_iocb, addr (xforum_windows.help_line.position), xforum_windows.help_line.iocb, chlw_code);
	if chlw_code ^= 0
	then call error (chlw_code, "Could not resize user_io for the help line window.");

	return;

     end create_help_line_window;

write_start_up_message: proc;

/* AUTOMATIC */

	dcl     wsum_code		 fixed bin (35);

/* CONSTANTS */

	dcl     wsum_MESSAGE	 char (61) init ("Executive Forum is setting up.  Please wait for menu display.");



	xwm_center_line = divide (xforum_windows.orig_user_io.position.extent.height, 2, 17, 0);
	xwm_left_margin =
	     divide (xforum_windows.orig_user_io.position.extent.width
	     - length (wsum_MESSAGE), 2, 17, 0);
	call window_$position_cursor (iox_$user_io, xwm_center_line,
	     xwm_left_margin, wsum_code);
	if wsum_code ^= 0 then
	     call error (wsum_code, "Could not position to write start up message.");
	call window_$overwrite_text (iox_$user_io, wsum_MESSAGE, wsum_code);
	if wsum_code ^= 0 then
	     call error (wsum_code, "Could not write start up message.");
	call window_$position_cursor (iox_$user_io, xwm_center_line + 2, 1,
	     wsum_code);
	if wsum_code ^= 0 then
	     call error (wsum_code, "Could not position after writting start up message.");
	call window_$sync (iox_$user_io, wsum_code);
	if wsum_code ^= 0 then
	     call error (wsum_code, "Could not do a window sync.");

	return;

     end write_start_up_message;

write_shut_down_message: proc;

/* AUTOMATIC */

	dcl     wsdm_code		 fixed bin (35);


	call window_$position_cursor (iox_$user_io, xwm_center_line, xwm_left_margin,
	     wsdm_code);
	if wsdm_code ^= 0 then goto exit_write_shut_down_message;

	call window_$overwrite_text (iox_$user_io,
	     "Executive Forum is shutting down.", wsdm_code);
	if wsdm_code ^= 0 then goto exit_write_shut_down_message;

	call window_$position_cursor (iox_$user_io, xwm_center_line + 2, 1,
	     wsdm_code);
	if wsdm_code ^= 0 then goto exit_write_shut_down_message;

	call window_$sync (iox_$user_io, wsdm_code);

exit_write_shut_down_message:
	return;

     end write_shut_down_message;

resynch_windows_p: proc (rwp_size_needed, rwp_clear_bottom_window);

/* PARAMETERS */

	dcl     rwp_size_needed	 fixed bin;
	dcl     rwp_clear_bottom_window bit (1);

/* AUTOMATIC */

	dcl     rwp_code		 fixed bin (35);
	dcl     rwp_difference	 fixed bin;


	if rwp_clear_bottom_window
	then call window_$clear_window (xforum_windows.bottom.iocb, (0));

	if xforum_windows.menu.position.extent.height ^= rwp_size_needed
	then do;
	     rwp_difference = rwp_size_needed - xforum_windows.menu.position.extent.height;
	     xforum_windows.menu.position.extent.height =
		xforum_windows.menu.position.extent.height + rwp_difference;
	     if xforum_windows.menu.position.extent.height > 0
	     then do;
		call iox_$control (xforum_windows.menu.iocb, "set_window_info",
		     addr (xforum_windows.menu.position), rwp_code);
		if rwp_code ^= 0 then
		     call error (rwp_code, "Unable to alter size of menu window.");
	     end;

	     xforum_windows.bottom.position.line =
		xforum_windows.bottom.position.line + rwp_difference;
	     xforum_windows.bottom.position.height =
		xforum_windows.bottom.position.height - rwp_difference;
	     call iox_$control (xforum_windows.bottom.iocb,
		"set_window_info", addr (xforum_windows.bottom.position),
		rwp_code);
	     if rwp_code ^= 0 then
		call error (rwp_code, "Unable to alter user_io window size.");

	     if rwp_clear_bottom_window
	     then call window_$clear_window (xforum_windows.bottom.iocb, (0));
	end;


	return;

     end resynch_windows_p;

error: proc (e_code, e_reason);

/* PARAMETERS */

	dcl     e_code		 fixed bin (35);
	dcl     e_reason		 char (512);

	xwm_xforum_error_info.name = "xforum_window_mgr";
	xwm_xforum_error_info.entry = "";
	xwm_xforum_error_info.doing = "";
	xwm_xforum_error_info.code = e_code;
	xwm_xforum_error_info.reason = e_reason;

	call signal_ ("xforum_fatal_error", null (), addr (xwm_xforum_error_info), null ());

     end error;

     end xforum_window_mgr;




		    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
