[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