[SWEXA.WRK]MENU.COM_SRC

$       sav_vfy = 'f$verify(0)'
$ !++
$ !
$ !  DCL command procedure:
$ !     MENU
$ !
$ !  Purpose:
$ !     Application MENU command procedure which is executed when
$ !     the application is selected from the by the APPUSR menu.
$ !
$ !  Parameters:
$ !     P1 = Remaining selection arguments from previous menu system
$ !
$ !  Appends:
$ !     %APPEND SWRK_SFT_DIR:SWRK_APPL_MENU_FUNCTIONS.COM_APP
$ !
$ !  Copyright:
$ !     Copyright © 1987 - 1999 Corpita Pty Ltd
$ !     15 Bedford Street, Collingwood 3066, Australia
$ !
$ !  History:
$ !     11-Dec-1999 by SLJ
$ !         Use UTLTOOLS FETCH LOGIN
$ !     01-Aug-1992 by SLJ
$ !         Include appends
$ !     10-May-1990 by Simon L. Jackson
$ !         New version
$ !
$ !--
$
$       if f$trnlnm("vue$input") .nes. "" then vue$popup_progress_box 10
$       goto swrk_sub_menu_handler
$
$ handle_selection_callback:
$       goto handle_'sel_code'
$
$ gen_done:
$       msg_lin = ""
$       goto swrk_sub_display_message_line_wait
$
$ gen_error: !! 'f$verify(0)
$       ret_sts = $status
$       if dsp_tsk_flg then msg_lin = "Error detected"
$       goto swrk_sub_display_message_line_wait
$
$ gen_eof:
$       ret_sts = %x1001827a
$       return

$ !
$ !  Construct and display the menu
$ !
$
$ display_menu_callback:
$       sel_list = ".ADD.MODIFY.REMOVE.SHOW.DCL.FILES.PRINT."
$       sel_max = 7
$
$       if dsp_mnu_flg
$         then
$           hdr_lin = "Application ''cur_app' menu"
$           gosub swrk_sub_display_heading
$           type sys$input

     1  ADD         Add a widget
     2  MODIFY      Modify an existing widget
     3  REMOVE      Remove an existing widget
     4  REPORT      Generate a report about widgets
     5  DCL         Enter DCL commands
     6  FILES       File Control Menu
     7  PRINT       Print a file
$         endif
$
$       utltools fetch login/context
$
$       if flg_cur_app_mgr
$         then
$           sel_code := manage
$           sel_list = sel_list + sel_code + "."
$           sel_max = sel_max + 1
$           mnu_say (mnu_fao,sel_max,sel_code,"Manage widgets")
$         endif
$
$       return

$ !
$ !  Add a widget
$ !
$
$ handle_add:
$       on error then goto gen_error
$       hdr_lin = "Add a widget"
$       if dsp_tsk_flg then gosub swrk_sub_display_heading
$
$       gosub get_widget_name
$       if .not. ret_sts then return
$
$       gosub get_widget_owner
$       if .not. ret_sts then return
$
$       gosub get_widget_type
$       if .not. ret_sts then return
$
$       say "Adding new widget..."
$
$       goto gen_done

$ !
$ !  Enter DCL commands
$ !
$
$ handle_dcl:
$       on error then goto gen_error
$       hdr_lin = "Enter DCL commands"
$       if dsp_tsk_flg then gosub swrk_sub_display_heading
$
$       define/user sys$input sys$command
$       'sel_args'
$       @sys$command
$
$       goto gen_done

$ !
$ !  Call file control menu
$ !
$
$ handle_files:
$       mnu_prc := swadm_sft_dir:swadm_manage_files
$       goto swrk_sub_menu_call

$ !
$ !  Call manage widget menu
$ !
$
$ handle_manage:
$       mnu_prc = "''cur_app'_sft_dir:''cur_app'_''sel_code'_menu"
$       goto swrk_sub_menu_call

$ !
$ !  Modify an existing widget
$ !
$
$ handle_modify:
$       on error then goto gen_error
$       hdr_lin = "Modify an existing widget"
$       if dsp_tsk_flg then gosub swrk_sub_display_heading
$
$       gosub get_widget_name
$       if .not. ret_sts then return
$
$       gosub get_widget_owner
$       if .not. ret_sts then return
$
$       gosub get_widget_type
$       if .not. ret_sts then return
$
$       say "Modifying existing widget..."
$
$       goto gen_done

$ !
$ !  Print a file
$ !
$
$ handle_print:
$       mnu_prc := swadm_sft_dir:swadm_manage_files
$       sel_args = "print " + sel_args
$       goto swrk_sub_menu_call

$ !
$ !  Remove an existing widget
$ !
$
$ handle_remove:
$       on error then goto gen_error
$       hdr_lin = "Remove an existing widget"
$       if dsp_tsk_flg then gosub swrk_sub_display_heading
$
$       gosub get_widget_name
$       if .not. ret_sts then return
$
$       say "Removing existing widget..."
$
$       goto gen_done

$ !
$ !  Generate a report about widgets
$ !
$
$ handle_report:
$       on error then goto gen_error
$       hdr_lin = "Generate a report about widgets"
$       if dsp_tsk_flg then gosub swrk_sub_display_heading
$
$       gosub swrk_sub_get_output
$       if .not. ret_sts then return
$
$       goto gen_done

$ !
$ !  Subroutine:
$ !     GET_WIDGET_NAME
$ !
$ !  Purpose:
$ !     Gets a widget name which must not be blank, has
$ !     no default, and is not validated.
$ !
$
$ get_widget_name:
$       run swrk_sft_dir:swrk_get_arg
$       wgt_nam = arg
$       if wgt_nam .eqs. "\" then wgt_nam = ""
$       if wgt_nam .nes. "" then goto gwn_got_wgt_nam
$
$ gwn_get_wgt_nam:
$       accept wgt_nam -
            /convert-
            /prompt="Widget name: "-
            /terminator=sel_term-
            /uppercase
$       if sel_term .eqs. "CTRLZ" then goto gen_eof
$       wgt_nam = f$edit(wgt_nam,"compress,trim,upcase")
$       if wgt_nam .eqs. "" then goto gwn_get_wgt_nam
$
$ gwn_got_wgt_nam:
$       return

$ !
$ !  Subroutine:
$ !     GET_WIDGET_OWNER
$ !
$ !  Purpose:
$ !     Gets the widget owner which must not be blank, has
$ !     a default, but is not validated.
$ !
$
$ get_widget_owner:
$       wgt_own_def = "Fred"
$       run swrk_sft_dir:swrk_get_arg
$       wgt_own = arg
$       if wgt_own .eqs. "\" then wgt_own = wgt_own_def
$       if wgt_own .nes. "" then goto gwo_got_wgt_own
$
$ gwo_get_wgt_own:
$       accept wgt_own -
            /convert-
            /prompt="Widget owner [''wgt_own_def']: "-
            /terminator=sel_term
$       if sel_term .eqs. "CTRLZ" then goto gen_eof
$       wgt_own = f$edit(wgt_own,"compress,trim,upcase")
$       if wgt_own .eqs. "" then wgt_own = wgt_own_def
$
$ gwo_got_wgt_own:
$       return

$ !
$ !  Subroutine:
$ !     GET_WIDGET_TYPE
$ !
$ !  Purpose:
$ !     Gets a widget type which must not be blank, has
$ !     a default, and is validated.
$ !
$
$ get_widget_type:
$       wgt_typ_def = "Australian"
$       wgt_typ_lst = "|AMERICAN|AUSTRALIAN|ENGLISH|GREEK|ITALIAN|"
$       wgt_typ_lst_len = f$length(wgt_typ_lst)
$       wgt_typ_pmt = "American/Australian/English/Greek/Italian"
$       run swrk_sft_dir:swrk_get_arg
$       wgt_typ = arg
$       if wgt_typ .eqs. "\" then wgt_typ = wgt_typ_def
$
$ gwt_get_wgt_typ:
$       wgt_typ = f$edit(wgt_typ,"compress,trim,upcase")
$       if wgt_typ .nes. ""
$         then
$           z1 = "|''wgt_typ'"
$           z2 = f$locate(z1,wgt_typ_lst)
$           if z2 .eqs. wgt_typ_lst_len
$             then
$               say "Invalid widget type - Please re-enter"
$               wgt_typ = ""
$             else
$               z3 = f$extract(z2+1,-1,wgt_typ_lst)
$               if f$locate(z1,z3) .ne. f$length(z3)
$                 then
$                   say "Ambiguous widget type - Please re-enter"
$                   wgt_typ = ""
$                 else
$                   wgt_typ = f$element(1,"|",z3)
$                 endif
$             endif
$         endif
$       if wgt_typ .nes. "" then goto gwt_got_wgt_typ
$       accept wgt_typ -
            /convert-
            /prompt="Widget type (''WGT_TYP_PMT') [''WGT_TYP_DEF']: "-
            /terminator=sel_term-
            /uppercase
$       if sel_term .eqs. "CTRLZ" then goto gen_eof
$       if wgt_typ .eqs. "" then wgt_typ = wgt_typ_def
$       goto gwt_get_wgt_typ
$
$ gwt_got_wgt_typ:
$       return