The Developer Connection - Device Driver Kit for OS/2 3

home *** CD-ROM | disk | FTP | other *** search

/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / dfhelp_a.src < prev next >

Wrap

Text File | 1993-05-19 | 66.0 KB | 1,834 lines

// dfhelp_a.src (secondary help maintenance program [A]) // July 25, 1991 // LS use dfhelp_a // secondary help maintenance program [A] header package function is_critical for (class(error_info_object.obj)) integer error_number returns integer function_return 0 end_function ////////////////////////////////// ////////////////////////////////// global variables ////////////////////////////////// string cmd_option // option passed on cmd line (via chain wait) move EMPTY_STRING to cmd_option string current_grp current_sbj current_xrf current_ctx current_pth move EMPTY_STRING to current_grp // names of currently open help data files move EMPTY_STRING to current_sbj // passed on cmd line (via chain wait) move EMPTY_STRING to current_xrf move EMPTY_STRING to current_ctx move EMPTY_STRING to current_pth ////////////////////////////////// ////////////////////////////////// global procedures ////////////////////////////////// procedure deactivate_area for desktop send deactivate AREA_TYPE end_procedure procedure insert_cb for desktop string val integer itm local integer flag get insert_mode of clipboard to flag set insert_mode of clipboard to true send goto_line to clipboard itm set right_margin of clipboard to 56 send key to clipboard kenter set value of clipboard item itm to val set insert_mode of clipboard to flag end_procedure function next_cmd_arg for desktop returns string local string arg cmdline arg if arg le EMPTY_STRING begin error 57 ("Command line argument not specified") send insert_cb FAIL_REPLY 0 abort end if arg eq EMPTY_REPL_STRING function_return EMPTY_STRING else function_return arg end_function procedure init_program for desktop // retrieve option passed on command line to determine which objects to use cmdline cmd_option if cmd_option le EMPTY_STRING begin error 57 ("Option not specified for program") send insert_cb FAIL_REPLY 0 abort end left cmd_option to cmd_option 1 uppercase cmd_option if not cmd_option in VALID_OPTIONS begin error 57 ("Invalid option passed to program: " + cmd_option) send insert_cb FAIL_REPLY 0 abort end if cmd_option ne PATH_OPTION begin get next_cmd_arg to current_grp get next_cmd_arg to current_sbj get next_cmd_arg to current_xrf get next_cmd_arg to current_ctx get next_cmd_arg to current_pth end end_procedure procedure exit_program for desktop send insert_cb ABORT_REPLY 0 send exit_application end_procedure send init_program ////////////////////////////////// ////////////////////////////////// augmentation to help_object class to ////////////////////////////////// override default help access ////////////////////////////////// procedure request_help for (class(help_object.obj)) integer msg_id integer arg local integer orig_grp orig_sbj orig_xrf orig_ctx local string old_grp_filename old_sbj_filename old_xrf_filename old_ctx_filename local string cur_grp_filename cur_sbj_filename cur_xrf_filename cur_ctx_filename move current_pth to cur_grp_filename append cur_grp_filename current_grp move current_pth to cur_sbj_filename append cur_sbj_filename current_sbj move current_pth to cur_xrf_filename append cur_xrf_filename current_xrf move current_pth to cur_ctx_filename append cur_ctx_filename current_ctx if cur_grp_filename gt EMPTY_STRING begin move grp.recnum to orig_grp close grp end if cur_sbj_filename gt EMPTY_STRING begin move sbj.recnum to orig_sbj close sbj end if cur_xrf_filename gt EMPTY_STRING begin move xrf.recnum to orig_xrf close xrf end if cur_ctx_filename gt EMPTY_STRING begin move ctx.recnum to orig_ctx close ctx end if num_arguments gt 1 send msg_id arg else send msg_id if cur_grp_filename gt EMPTY_STRING begin open cur_grp_filename as grp clear grp if orig_grp ne 0 begin move orig_grp to grp.recnum find eq grp.recnum end end if cur_sbj_filename gt EMPTY_STRING begin open cur_sbj_filename as sbj clear sbj if orig_sbj ne 0 begin move orig_sbj to sbj.recnum find eq sbj.recnum end end if cur_xrf_filename gt EMPTY_STRING begin open cur_xrf_filename as xrf clear xrf if orig_xrf ne 0 begin move orig_xrf to xrf.recnum find eq xrf.recnum end end if cur_ctx_filename gt EMPTY_STRING begin open cur_ctx_filename as ctx clear ctx if orig_ctx ne 0 begin move orig_ctx to ctx.recnum find eq ctx.recnum end end end_procedure ////////////////////////////////// ////////////////////////////////// classes ////////////////////////////////// class data_file_client is a client procedure construct_object integer img forward send construct_object img property string grp_file public HELP_GRP_FILENAME property string sbj_file public HELP_SBJ_FILENAME property string xrf_file public HELP_XRF_FILENAME property string ctx_file public HELP_CTX_FILENAME property string file_path public EMPTY_STRING property string original_grp_name public EMPTY_STRING property string original_sbj_name public EMPTY_STRING property string original_xrf_name public EMPTY_STRING property string original_ctx_name public EMPTY_STRING property string original_path_name public EMPTY_STRING property integer new_state public 0 property integer open_state public 0 property integer erase_state public 0 property integer import_state public 0 end_procedure function help_name returns string local string help_str forward get help_name to help_str if (new_state(current_object)) function_return (help_str + ".NEW") if (open_state(current_object)) function_return (help_str + ".OPEN") if (erase_state(current_object)) function_return (help_str + ".ERASE") if (import_state(current_object)) function_return (help_str + ".IMPORT") end_function end_class ////////////////////////////////// ////////////////////////////////// main object definitions ////////////////////////////////// if cmd_option eq IMP_MAINT_OPTION begin class display_window is an edit register_function initial_highlight_color returns integer procedure construct_object forward send construct_object property integer highlight_color public (initial_highlight_color(current_object)) property integer normal_colors public (object_color(current_object)) end_procedure function initial_highlight_color returns integer local integer obj chk_obj pal ret_val move current_object to obj repeat move obj to chk_obj get class_palette (class(chk_obj)) to pal if pal eq 0 get parent of chk_obj to obj until (pal <> 0 or chk_obj = desktop) get palette_color pal POINTED_CURSOR_TYPE to ret_val function_return ret_val end_function procedure entering returns integer local integer ret_val forward get msg_entering to ret_val if not ret_val set object_color to ; (highlight_color(current_object)) (low(normal_colors(current_object))) end_procedure procedure exiting integer obj returns integer local integer ret_val clrs forward get msg_exiting obj to ret_val if not ret_val begin get normal_colors to clrs set object_color to (hi(clrs)) (low(clrs)) end end_procedure procedure release_focus local integer ret_val clrs forward send release_focus get normal_colors to clrs set object_color to (hi(clrs)) (low(clrs)) end_procedure set class_colors to u_!$ 0 0 // set colors for current class to inherit end_class class auto_reset_checkbox is a checkbox procedure select_toggling integer itm integer flag forward send select_toggling itm flag delegate send reset_mode end_procedure end_class /import_data_img ╔════════════════════════════════════════════════════════════════╗ ║________________________________________________________________║ ║ ║ ║ ___________________ ______________________________ ║ ║ ___________________ ______________________________ ║ ║ ║ ║ ┌─ Import data matching: ────────────────────────────────────┐ ║ ║ │ │ ║ ║ │ Group name: _________________________________ │ ║ ║ │ │ ║ ║ │ Subject name: _________________________________ │ ║ ║ │ │ ║ ║ │ Application name: ________________________________________ │ ║ ║ │ Module name: _______________ │ ║ ║ │ Help name: _______________ │ ║ ║ │ │ ║ ║ └────────────────────────────────────────────────────────────┘ ║ ║ __________ _____________________ _______________ ║ ║ __________ ___________ _________ ║ ╚════════════════════════════════════════════════════════════════╝ /* // ( ) Import matching ( ) Import topics and contexts // ( ) Import all ( ) Import topics only // // <F2=Begin> <Alt+F2=Display only> <F4=Import One> // <F5=Clear> <Esc=Close> <F1=Help> // sub_page import_data_match_img from import_data_img 2 4 sub_page import_data_xrf_ctx_img from import_data_img 3 5 sub_page import_data_xrf_match_img from import_data_img 6 7 sub_page import_data_ctx_match_img from import_data_img 8 9 10 sub_page import_data_btns_img from import_data_img 11 12 13 14 15 16 object import_data is a client import_data_img set location to 2 7 relative set popup_state to true integer last_xrf move 0 to last_xrf object sbj_list is an array end_object object alt_sbj_list is a set end_object set center_state item 0 to true set value item 0 to "Import data" object match_type is an auto_reset_checkbox import_data_match_img set select_mode to auto_select item_list on_item "Import matching" send next set select_state to true on_item "Import all" send next end_item_list on_key kcancel send request_cancel private on_key kclear send request_clear private on_key key_alt+key_f2 send display_only private on_key kprompt send import_one private on_key ksave_record send request_begin private end_object object xrfs_and_ctxs is an auto_reset_checkbox import_data_xrf_ctx_img set select_mode to auto_select item_list on_item "Import topics and contexts" send next set select_state to true on_item "Import topics only" send next end_item_list on_key kcancel send request_cancel private on_key kprompt send import_one private on_key key_alt+key_f2 send display_only private on_key kclear send request_clear private on_key ksave_record send request_begin private end_object object xrf_match is a form import_data_xrf_match_img item_list on_item EMPTY_STRING send next on_item EMPTY_STRING send next end_item_list on_key kenter send next private on_key kcancel send request_cancel private on_key kprompt send import_one private on_key key_alt+key_f2 send display_only private on_key kclear send request_clear private on_key ksave_record send request_begin private end_object object ctx_match is a form import_data_ctx_match_img item_list on_item EMPTY_STRING send next // app_name on_item EMPTY_STRING send next // mod_name on_item EMPTY_STRING send next // hlp_name end_item_list on_key kenter send next private on_key kcancel send request_cancel private on_key kprompt send import_one private on_key key_alt+key_f2 send display_only private on_key kclear send request_clear private on_key ksave_record send request_begin private end_object object buttons is a button import_data_btns_img item_list on_item "<F2=Begin>" send request_begin on_item "<Alt+F2=Display only>" send display_only on_item "<F4=Import one>" send import_one on_item "<F5=Clear>" send request_clear on_item "<Esc=Close>" send request_cancel on_item F1_HELP_TEXT send help end_item_list on_key kcancel send request_cancel private on_key kprompt send import_one private on_key key_alt+key_f2 send display_only private on_key kclear send request_clear private on_key ksave_record send request_begin private end_object /import_process_img ╔══════════════════════════════════════════════════╗ ║ ║ ║ ┌ Scanning: ───────┐ ┌─ Importing: ─────┐ ║ ║ │ │ │ │ ║ ║ │ Groups: ______ │ │ │ ║ ║ │ Subjects: ______ │ │ Topics: ______ │ ║ ║ │ Links: ______ │ │ Contexts: ______ │ ║ ║ │ Contexts: ______ │ │ │ ║ ║ │ │ │ │ ║ ║ └──────────────────┘ └──────────────────┘ ║ ║ ║ ║ ____________ ║ ║ ║ ╚══════════════════════════════════════════════════╝ /* // <Esc=Cancel> sub_page import_process_cancel_btn_img from import_process_img 7 object process is a client import_process_img set popup_state to true set location to 5 7 relative object button is a button import_process_cancel_btn_img item_list on_item ESC_CANCEL_TEXT send none end_item_list /import_interrupt_img ╔═══════════════════════════════════════════════════════╗ ║ Import interrupted. ║ ║ ║ ║ _____________ ___________ ║ ╚═══════════════════════════════════════════════════════╝ /* object interrupt is a button import_interrupt_img set block_mouse_state to true set location to 9 -2 relative set popup_state to true set scope_state to true item_list on_item "<F2=Continue>" send ok on_item "<Esc=Abort>" send cancel end_item_list on_key ksave_record send ok on_key kcancel send cancel end_object function check_interrupt returns integer local string trash local integer wloc mloc ret_val inkey trash if (termchar eq kexit_application or ; termchar eq kcancel or ; termchar eq kmouse) begin if (termchar eq kmouse) begin get window_location item 1 to wloc move (wloc + location(current_object)) to wloc get absolute_mouse_location to mloc if not (mloc >= wloc and mloc < (wloc + length(value(current_object,0)))) ; function_return 0 end set kbd_input_mode to 1 set highlight_state to false ui_accept (interrupt(current_object)) to ret_val if ret_val ne msg_ok function_return 1 set highlight_state to true set kbd_input_mode to 2 end function_return 0 end_function end_object function scan integer itm returns integer local integer ret_val set value item itm to (value(current_object,itm) + 1) get check_interrupt of (button(current_object)) to ret_val function_return ret_val end_function end_object /import_display_list_img ╔═══════════════════════════════════════════╗ ║___________________________________________║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ║ ╚═══════════════════════════════════════════╝ /import_display_list_btn_img _______ _________ /* // <F2=OK> <F1=Help> object display_list is a client import_display_list_img integer last_displayed_xrf move 0 to last_displayed_xrf set block_mouse_state to true set center_state item 0 to true set location to 0 10 relative set popup_state to true set scope_state to true set value item 0 to "Topics and Contexts to be imported" object button is a button import_display_list_btn_img set location to 11 1 relative item_list on_item F2_OK_TEXT send request_ok on_item F1_HELP_TEXT send help end_item_list on_key ksave_record send request_ok private end_object // button before list places focus on button during default activate of client object list is a display_window set size to 8 42 set location to 3 1 relative set read_only_state to true on_key ksave_record send request_ok private end_object procedure request_ok send deactivate_area send delete_data to (list(current_object)) delegate send restart end_procedure procedure delete_data send delete_data to (list(current_object)) end_procedure procedure insert_line string txt local string newline local integer obj move (list(current_object)) to obj set read_only_state of obj to false send insert to obj txt send process_key to obj kenter set read_only_state of obj to true end_procedure procedure show_xrf send insert_line "TOPIC:" send insert_line (trim(grp2.grp_name)) send insert_line (trim(sbj2.sbj_name)) end_procedure procedure show_ctx send insert_line "CONTEXT:" send insert_line (trim(ctx2.app_name)) send insert_line (trim(ctx2.mod_name)) send insert_line (trim(ctx2.hlp_name)) end_procedure end_object /import_done_img ╔═══════════════════════════════════════════════════════╗ ║ Import complete. ║ ║ ║ ║ ____ ______ ║ ╚═══════════════════════════════════════════════════════╝ /* object done is a button import_done_img set block_mouse_state to true set location to 13 4 relative set popup_state to true set scope_state to true item_list on_item "<OK>" send request_display_ok on_item "<Help>" send help end_item_list end_object /import_one_img ╔═══════════════════════════════════════════════════════╗ ║_______________________________________________________║ ║ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ _________________________________ ║ ║ ║ ║ ____________ _________ ║ ╚═══════════════════════════════════════════════════════╝ /* // <Esc=Cancel> <F1=Help> sub_page import_one_list_img from import_one_img vertical 2 9 sub_page import_one_keys_img from import_one_img 11 12 object import_one is a client import_one_img integer import_action_msg set block_mouse_state to true set location to 3 4 relative set popup_state to true set scope_state to true set center_state item 0 to true object grp_set is a data_set no_image main_file grp2 set focus_mode to no_activate object xrf_set is a data_set no_image main_file xrf2 set focus_mode to no_activate end_object end_object object list is a selection_list import_one_list_img set local_rotate_state to false set ordering to index.1 begin_row entry_item grp2.grp_name end_row on_key kcancel send request_cancel private on_key kenter send choose_topic private end_object object keys is a key_button import_one_keys_img item_list on_item ESC_CANCEL_TEXT send request_cancel on_item F1_HELP_TEXT send help end_item_list end_object procedure accept_list integer msg move msg to import_action_msg send popup end_procedure procedure choose_topic local integer obj rec_id get prior_level to obj get current_record of (list(current_object)) to rec_id send deactivate send import_action_msg to obj rec_id end_procedure procedure delete_data send delete_data to (list(current_object)) end_procedure procedure pick_group integer msg local integer itm lst clear grp2 find ge grp2.grp_name [ found ] begin move (list(current_object)) to lst set main_file of lst to grp2.file_number set server of lst to (grp_set(current_object)) set data_file of (element(lst)) item 0 to grp2.file_number send prepare_list "Import Topic from Group" grp2.file_number ; (grp_set(current_object)) grp2.file_number send accept_list msg end end_procedure procedure pick_subject integer grp_num string ttl integer msg local integer itm lst clear xrf2 move grp_num to xrf2.grp_recnum find ge xrf2.grp_recnum [ found ] indicate found as xrf2.grp_recnum eq grp_num [ found ] begin send prepare_list ("Subjects for Group " + ttl) xrf2.file_number ; (xrf_set(grp_set(current_object))) sbj2.file_number send accept_list msg end end_procedure procedure prepare_list string ttl integer mfil integer svr integer ffil local integer lst set value item 0 to ttl move (list(current_object)) to lst set main_file of lst to mfil set server of lst to svr set data_file of (element(lst)) item 0 to ffil send rebuild_constraints to svr send delete_data end_procedure procedure request_cancel send deactivate_area end_procedure end_object object sbj_text is an edit set focus_mode to no_activate set size to 1 56 end_object function match_only returns integer local integer ret_val get select_state of (match_type(current_object)) item 0 to ret_val function_return ret_val end_function function include_ctx returns integer local integer ret_val get select_state of (xrfs_and_ctxs(current_object)) item 0 to ret_val function_return ret_val end_function procedure reset_mode local integer mobj cobj flag1 flag2 itm move (xrf_match(current_object)) to mobj move (ctx_match(current_object)) to cobj get match_only to flag1 move (not(flag1)) to flag1 set shadow_state of mobj item 0 to flag1 set shadow_state of mobj item 1 to flag1 get include_ctx to flag2 if flag1 move 0 to flag2 // don't edit ctx names if not match type move (not(flag2)) to flag2 set shadow_state of cobj item 0 to flag2 set shadow_state of cobj item 1 to flag2 set shadow_state of cobj item 2 to flag2 end_procedure function no_wildcard string val returns string local integer ps pos "?" in val to ps if ps eq 0 pos "*" in val to ps if ps function_return (left(val,ps-1)) else function_return val end_function procedure restart set kbd_input_mode to 1 send deactivate to (process(current_object)) send deactivate to (display_list(current_object)) send activate to (match_type(current_object)) end_procedure procedure request_clear set current_item of (match_type(current_object)) to 0 set current_item of (xrfs_and_ctxs(current_object)) to 0 send delete_data to (xrf_match(current_object)) send delete_data to (ctx_match(current_object)) send activate to (match_type(current_object)) end_procedure procedure init_process integer live local integer obj if not live begin move 0 to last_xrf set max_lines of (list(display_list(current_object))) to MAX_LINES_ALLOWED send delete_data to (display_list(current_object)) send popup to (display_list(current_object)) end move (process(current_object)) to obj send delete_data to obj send popup to obj set highlight_state of (button(obj)) to true set kbd_input_mode to 2 end_procedure procedure process_complete integer live set kbd_input_mode to 1 set highlight_state of (button(process(current_object))) to false if live send popup to (done(current_object)) else begin set max_lines of (list(display_list(current_object))) to (line_count(list(display_list(current_object))) + 1) send deactivate to (process(current_object)) end end_procedure procedure request_begin send request_import true end_procedure procedure display_only send request_import false end_procedure procedure request_display_ok send deactivate_area to (done(current_object)) send restart end_procedure procedure request_import integer live local integer grp_typ sbj_typ app_typ mod_typ hlp_typ local integer incl_ctx obj ret_val local string grp_test sbj_test app_test mod_test hlp_test send init_process live if not (match_only(current_object)) begin send delete_data to (xrf_match(current_object)) send delete_data to (ctx_match(current_object)) end move 0 to grp_typ move 0 to sbj_typ move 0 to app_typ move 0 to mod_typ move 0 to hlp_typ move (xrf_match(current_object)) to obj get value of obj item 0 to grp_test get value of obj item 1 to sbj_test if grp_test gt EMPTY_STRING move 1 to grp_typ if sbj_test gt EMPTY_STRING move 1 to sbj_typ get include_ctx to incl_ctx if incl_ctx begin move (ctx_match(current_object)) to obj uppercase (value(obj,0)) to app_test uppercase (value(obj,1)) to mod_test uppercase (value(obj,2)) to hlp_test if app_test gt EMPTY_STRING move 1 to app_typ if mod_test gt EMPTY_STRING move 1 to mod_typ if hlp_test gt EMPTY_STRING move 1 to hlp_typ end // search files based on match criteria: // loop through grps that match, // loop through xrfs that match (test sbj for match), // loop through ctxs that match. clear grp2 get no_wildcard grp_test to grp2.grp_name find ge grp2.grp_name [found] repeat if (scan(current_object,GRP_SCAN_TYPE)) begin send restart procedure_return end indicate found as grp_typ [found] indicate found as grp_test match (trim(grp2.grp_name)) [not found] indicate found as (not(grp_typ)) [found] begin clear xrf2 move grp2.recnum to xrf2.grp_recnum find ge xrf2.grp_recnum [found] indicate found as xrf2.grp_recnum eq grp2.recnum [found] repeat if (scan(current_object,XRF_SCAN_TYPE)) begin send restart procedure_return end clear sbj2 move xrf2.sbj_recnum to sbj2.recnum find eq sbj2.recnum if (scan(current_object,SBJ_SCAN_TYPE)) begin send restart procedure_return end [found] if sbj_typ indicate found as ; sbj_test match (trim(sbj2.sbj_name)) [found] begin if incl_ctx begin clear ctx2 move xrf2.recnum to ctx2.xrf_recnum find ge ctx2.xrf_recnum [found] indicate found as ; ctx2.xrf_recnum eq xrf2.recnum if [found] begin [found] repeat if (scan(current_object,CTX_SCAN_TYPE)) begin send restart procedure_return end if app_typ indicate found as ; app_test match (trim(uppercase(ctx2.app_name))) [found] if mod_typ indicate found as ; mod_test match (trim(uppercase(ctx2.mod_name))) [found] if hlp_typ indicate found as ; hlp_test match (trim(uppercase(ctx2.hlp_name))) [found] begin if live get import_records true to ret_val else get show_import_ctx to ret_val // match! if ret_val begin send restart procedure_return end end find gt ctx2.xrf_recnum [found] indicate found as ; ctx2.xrf_recnum eq xrf2.recnum [found] loop end else begin if (not(app_typ) and not(mod_typ) and not(hlp_typ)) begin if live get import_records false to ret_val else get show_import_xrf to ret_val // fnd ctx diff xrf if ret_val begin send restart procedure_return end end end end else begin if live get import_records false to ret_val else get show_import_xrf to ret_val // skip ctx's if ret_val begin send restart procedure_return end end end find gt xrf2.grp_recnum [found] indicate found as xrf2.grp_recnum eq grp2.recnum [found] loop end find gt grp2.grp_name [found] if grp_typ indicate found as (no_wildcard(current_object,grp_test) + "*") match grp2.grp_name [found] loop send process_complete live end_procedure function scan integer itm returns integer function_return (scan(process(current_object),itm)) end_function function show_import_ctx returns integer local integer ret_val if xrf2.recnum ne last_xrf get show_import_xrf to ret_val else move 0 to ret_val if ret_val function_return ret_val move xrf2.recnum to last_xrf clear ctx move ctx2.app_name to ctx.app_name move ctx2.mod_name to ctx.mod_name move ctx2.hlp_name to ctx.hlp_name find eq ctx.hlp_name [not found] begin send show_ctx to (display_list(current_object)) function_return (scan(current_object,CTX_SAVE_TYPE)) end end_function function show_import_xrf returns integer clear xrf move grp.recnum to xrf.grp_recnum move sbj.recnum to xrf.sbj_recnum find eq xrf.grp_recnum [not found] begin send show_xrf to (display_list(current_object)) function_return (scan(current_object,XRF_SAVE_TYPE)) end end_function function import_records integer do_ctx returns integer local integer itm obj alt_obj rec old_xrf_state old_ctx_state LOCK if grp.grp_name ne grp2.grp_name begin clear grp move grp2.grp_name to grp.grp_name find eq grp.grp_name [not found] begin clear grp move grp2.grp_name to grp.grp_name saverecord grp end end move (sbj_list(current_object)) to obj move (alt_sbj_list(current_object)) to alt_obj get find_element of alt_obj sbj2.recnum to itm if itm eq -1 begin clear sbj move sbj2.sbj_name to sbj.sbj_name send delete_data to (sbj_text(current_object)) send read_dbms to (sbj_text(current_object)) sbj2.sbj_text send write_dbms to (sbj_text(current_object)) sbj.sbj_text saverecord sbj send add_element to alt_obj sbj2.recnum get find_element of alt_obj sbj2.recnum to itm set array_value of obj item itm to sbj.recnum end else begin get value of obj item itm to rec if sbj.recnum ne rec begin clear sbj move rec to sbj.recnum find eq sbj.recnum end end clear xrf move grp.recnum to xrf.grp_recnum move sbj.recnum to xrf.sbj_recnum find eq xrf.grp_recnum move 0 to old_xrf_state [found] move 1 to old_xrf_state [not found] begin clear xrf move grp.recnum to xrf.grp_recnum move sbj.recnum to xrf.sbj_recnum saverecord xrf end if do_ctx begin clear ctx move ctx2.app_name to ctx.app_name move ctx2.mod_name to ctx.mod_name move ctx2.hlp_name to ctx.hlp_name find eq ctx.hlp_name move 0 to old_ctx_state [found] move 1 to old_ctx_state [not found] begin clear ctx move ctx2.app_name to ctx.app_name move ctx2.mod_name to ctx.mod_name move ctx2.hlp_name to ctx.hlp_name move xrf.recnum to ctx.xrf_recnum saverecord ctx end end UNLOCK if not old_xrf_state if (scan(current_object,XRF_SAVE_TYPE)) function_return 1 if (do_ctx and not(old_ctx_state)) if (scan(current_object,CTX_SAVE_TYPE)) function_return 1 function_return 0 end_function procedure request_cancel send deactivate_area send insert_cb SUCCESS_REPLY 0 end_procedure procedure import_topic integer xrf_num local integer ret_val send init_process true if (scan(current_object,GRP_SCAN_TYPE)) begin send restart procedure_return end if (scan(current_object,SBJ_SCAN_TYPE)) begin send restart procedure_return end if (scan(current_object,XRF_SCAN_TYPE)) begin send restart procedure_return end clear xrf2 move xrf_num to xrf2.recnum find eq xrf2.recnum if [found] begin clear grp2 move xrf2.grp_recnum to grp2.recnum find eq grp2.recnum clear sbj2 move xrf2.sbj_recnum to sbj2.recnum find eq sbj2.recnum if (include_ctx(current_object)) begin clear ctx2 move xrf2.recnum to ctx2.xrf_recnum find ge ctx2.xrf_recnum [found] indicate found as ; ctx2.xrf_recnum eq xrf2.recnum if [found] begin [found] repeat if (scan(current_object,CTX_SCAN_TYPE)) begin send restart procedure_return end [found] begin get import_records true to ret_val // match! if ret_val begin send restart procedure_return end end find gt ctx2.xrf_recnum [found] indicate found as ; ctx2.xrf_recnum eq xrf2.recnum [found] loop end else begin get import_records false to ret_val // fnd ctx diff xrf if ret_val begin send restart procedure_return end end end else begin get import_records false to ret_val // skip ctx's if ret_val begin send restart procedure_return end end end send process_complete true end_procedure procedure pick_topic_subject integer grp_num clear grp2 move grp_num to grp2.recnum find eq grp2.recnum send pick_subject to (import_one(current_object)) grp_num (trim( grp2.grp_name )) ; msg_import_topic end_procedure procedure import_one send pick_group to (import_one(current_object)) msg_pick_topic_subject end_procedure end_object end if cmd_option in (PATH_OPTION + NEW_FILE_OPTION + OPEN_FILE_OPTION + ; IMP_MAINT_OPTION + ERS_MAINT_OPTION) begin /help_files_img ╔════════════════════════════════════════════════╗ ║________________________________________________║ ║ ║ ║ Prefix: _____ ║ ║ ║ ║ Group: ___ ________ ║ ║ Subject: ___ ________ ║ ║ Link: ___ ________ ║ ║ Context: ___ ________ ║ ║ ║ ║ Path: _______________________________ ║ ║ ║ ║ _______ __________ ____________ _________ ║ ╚════════════════════════════════════════════════╝ /* sub_page help_files_prefix_img from help_files_img 2 sub_page help_files_check_img from help_files_img vertical 3 4 sub_page help_files_file_img from help_files_img vertical 4 4 sub_page help_files_path_img from help_files_img 11 sub_page help_files_btns_img from help_files_img 12 13 14 15 object help_files is a data_file_client help_files_img set block_mouse_state to true set location to 6 15 relative set popup_state to true set scope_state to true set center_state item 0 to true set value item 0 to EMPTY_STRING object prefix is a form help_files_prefix_img string original_prefix_name set entry_msg to store_original_prefix set exit_msg to initialize_for_prefix item_list on_item EMPTY_STRING send next set autoclear_state to true end_item_list procedure store_original_prefix get value item 0 to original_prefix_name end_procedure procedure initialize_for_prefix local string prf get value item 0 to prf if (prf > EMPTY_STRING and prf <> original_prefix_name) begin delegate set grp_name to (prf + "GRP") delegate set sbj_name to (prf + "SBJ") delegate set xrf_name to (prf + "XRF") delegate set ctx_name to (prf + "CTX") send store_original_prefix end end_procedure procedure shadow_prefix_option integer flag set shadow_state item 0 to flag // prefix item in form if not flag set focus_mode to focusable else set focus_mode to nonfocusable end_procedure function prefix_shadowed returns integer function_return (shadow_state(current_object,0)) // prefix item in form end_function end_object object erase_checks is a checkbox help_files_check_img set local_rotate_state to true item_list on_item EMPTY_STRING send next on_item EMPTY_STRING send next on_item EMPTY_STRING send next on_item EMPTY_STRING send next end_item_list end_object object file is a form help_files_file_img item_list repeat_item 4 times EMPTY_STRING send next end_item_list end_object object path is a form help_files_path_img item_list on_item EMPTY_STRING send next set autoclear_state to true end_item_list end_object object buttons is a button help_files_btns_img item_list on_item F2_OK_TEXT send request_ok on_item "<F5=Clear>" send clear on_item ESC_CANCEL_TEXT send request_cancel on_item F1_HELP_TEXT send help end_item_list end_object /creating_img ╔════════════════════════════════════════════════╗ ║ ║ ║ Creating new help data files. Please wait. ║ ║ ║ ╚════════════════════════════════════════════════╝ /opening_img ╔════════════════════════════════════════════════╗ ║ ║ ║ Opening help data files. Please wait. ║ ║ ║ ╚════════════════════════════════════════════════╝ /erasing_img ╔════════════════════════════════════════════════╗ ║ ║ ║ Erasing data in help data files. Please wait. ║ ║ ║ ╚════════════════════════════════════════════════╝ /* object creating is a message creating_img set location to 4 0 relative set focus_mode to no_activate end_object object opening is a message opening_img set location to 4 0 relative set focus_mode to no_activate end_object object erasing is a message erasing_img set location to 4 0 relative set focus_mode to no_activate end_object on_key kcancel send request_cancel on_key kclear send clear on_key ksave_record send request_ok procedure use_checkboxes integer flag local integer count tot_items obj move (erase_checks(current_object)) to obj if flag set focus_mode of obj to focusable else set focus_mode of obj to nonfocusable move (item_count(obj) - 1) to tot_items for count from 0 to tot_items set checkbox_item_state of obj item count to flag set select_state of obj item count to flag loop end_procedure procedure init_files_and_path local string fname set grp_file to current_grp set sbj_file to current_sbj set xrf_file to current_xrf set ctx_file to current_ctx set file_path to current_pth end_procedure procedure new set value item 0 to "New files" send use_checkboxes false send clear set new_state to true send shadow_prefix_option false send focus_name_objects true send popup end_procedure procedure import set value item 0 to "Import from files" send use_checkboxes false send clear set import_state to true send shadow_prefix_option false send focus_name_objects true send popup end_procedure procedure pre_open set value item 0 to "Open files" send use_checkboxes false send load_file_names send load_path_name set open_state to true send shadow_prefix_option false send focus_name_objects true end_procedure procedure open send init_files_and_path if current_grp le EMPTY_STRING set grp_file to HELP_GRP_FILENAME if current_sbj le EMPTY_STRING set sbj_file to HELP_SBJ_FILENAME if current_xrf le EMPTY_STRING set xrf_file to HELP_XRF_FILENAME if current_ctx le EMPTY_STRING set ctx_file to HELP_CTX_FILENAME send pre_open send popup end_procedure procedure erase send init_files_and_path set value item 0 to "Erase data" send use_checkboxes true send load_file_names send load_path_name set erase_state to true send shadow_prefix_option true send focus_name_objects false send popup end_procedure procedure request_cancel send insert_cb FAIL_REPLY 0 send deactivate_area send reset_states end_procedure procedure clear if (erase_state(current_object)) ; set select_count of (erase_checks(current_object)) to 0 else begin send delete_data to (prefix(current_object)) send delete_data to (file(current_object)) send delete_data to (path(current_object)) end send activate // goto first focusable object in client end_procedure procedure shadow_prefix_option integer flag send shadow_prefix_option to (prefix(current_object)) flag end_procedure procedure focus_name_objects integer flag local integer mod itm obj f2 if flag move focusable to mod else move nonfocusable to mod move (file(current_object)) to obj set focus_mode of obj mod move (not(flag)) to f2 for itm from 0 to 3 set shadow_state of obj item itm to f2 loop move (path(current_object)) to obj set focus_mode of obj to mod set shadow_state of obj item 0 to f2 end_procedure procedure insert_cb_file_specs local string curpth send insert_cb (grp_file(current_object)) 1 send insert_cb (sbj_file(current_object)) 2 send insert_cb (xrf_file(current_object)) 3 send insert_cb (ctx_file(current_object)) 4 trim (file_path(current_object)) to curpth if curpth le EMPTY_STRING move EMPTY_REPL_STRING to curpth send insert_cb curpth 5 end_procedure procedure request_ok local integer ret_val local string pth if (erase_state(current_object)) begin if (select_count(erase_checks(current_object))) gt 0 begin send page_object to (erasing(current_object)) true get zero_files to ret_val send page_object to (erasing(current_object)) false if ret_val begin send insert_cb SUCCESS_REPLY 0 send insert_cb_file_specs end else send insert_cb FAIL_REPLY 0 end else send insert_cb FAIL_REPLY 0 send deactivate_area send reset_states procedure_return end send initialize_for_prefix to (prefix(current_object)) get path_name to pth if pth gt EMPTY_STRING if not (right(pth,1)) in ':\/' begin append pth '\' set path_name to pth end if (new_state(current_object)) ; send page_object to (creating(current_object)) true if (open_state(current_object) or import_state(current_object)) ; send page_object to (opening(current_object)) true if (import_state(current_object)) begin send push_original_names send close_alt_files end else send close_files if (new_state(current_object)) begin get check_file_specs pth to ret_val if not ret_val begin send page_object to (creating(current_object)) false error 32 "New files cannot be created" end end else move 1 to ret_val if ret_val begin send reset_names move (open_state(current_object) or import_state(current_object)) to ret_val if (new_state(current_object)) begin get make_files pth to ret_val if ret_val send delete_defs_and_fds pth send page_object to (creating(current_object)) false if ret_val send page_object to (opening(current_object)) true end if ret_val begin if (import_state(current_object)) get open_alt_files to ret_val else get open_files to ret_val send page_object to (opening(current_object)) false if ret_val begin if (active_state(current_object)) send deactivate_area if (import_state(current_object)) send popup to import_data else begin send insert_cb SUCCESS_REPLY 0 send insert_cb_file_specs end end end end if not ret_val begin if not (active_state(current_object)) send popup send activate to (file(current_object)) set current_item of (file(current_object)) to 0 if (import_state(current_object)) begin send close_alt_files send pop_original_names end else send close_files send reopen_help_files end else send reset_states end_procedure procedure push_original_names set original_grp_name to (grp_file(current_object)) set original_sbj_name to (sbj_file(current_object)) set original_xrf_name to (xrf_file(current_object)) set original_ctx_name to (ctx_file(current_object)) set original_path_name to (file_path(current_object)) end_procedure procedure pop_original_names set grp_file to (original_grp_name(current_object)) set sbj_file to (original_sbj_name(current_object)) set xrf_file to (original_xrf_name(current_object)) set ctx_file to (original_ctx_name(current_object)) set file_path to (original_path_name(current_object)) end_procedure function parse_path string path integer typ returns string local integer loc xloc local string pth move path to pth length pth to loc move 0 to xloc while loc gt 0 pos (mid(pth,1,loc)) in ":\/" to xloc if xloc gt 0 begin move loc to xloc move 0 to loc end else decrement loc end if xloc ne 0 begin if typ eq 0 function_return (mid(pth,255,xloc+1)) else function_return (left(pth,xloc)) end else begin if typ eq 0 function_return pth else function_return EMPTY_STRING end end_function procedure init_open local integer ret_val local string prf new_prefix new_path get next_cmd_arg to prf get parse_path prf 0 to new_prefix get parse_path prf 1 to new_path set file_path to new_path set grp_file to (new_prefix + "GRP") set sbj_file to (new_prefix + "SBJ") set xrf_file to (new_prefix + "XRF") set ctx_file to (new_prefix + "CTX") send pre_open send request_ok end_procedure procedure load_file_names local integer obj move (file(current_object)) to obj set value of obj item 0 to (grp_file(current_object)) set value of obj item 1 to (sbj_file(current_object)) set value of obj item 2 to (xrf_file(current_object)) set value of obj item 3 to (ctx_file(current_object)) end_procedure procedure load_path_name set value of (path(current_object)) item 0 to (file_path(current_object)) end_procedure function grp_name returns string function_return (value(file(current_object), 0)) end_function procedure set grp_name string new_val set value of (file(current_object)) item 0 to (uppercase(new_val)) end_procedure function sbj_name returns string function_return (value(file(current_object), 1)) end_function procedure set sbj_name string new_val set value of (file(current_object)) item 1 to (uppercase(new_val)) end_procedure function xrf_name returns string function_return (value(file(current_object), 2)) end_function procedure set xrf_name string new_val set value of (file(current_object)) item 2 to (uppercase(new_val)) end_procedure function ctx_name returns string function_return (value(file(current_object), 3)) end_function procedure set ctx_name string new_val set value of (file(current_object)) item 3 to (uppercase(new_val)) end_procedure function path_name returns string function_return (value(path(current_object), 0)) end_function procedure set path_name string new_val set value of (path(current_object)) item 0 to new_val end_procedure function make_files string pth returns integer indicate err false move 255 to filenumber make_file (pth + grp_file(current_object) + DEF_EXT_TEXT) [ not err ] make_file (pth + sbj_file(current_object) + DEF_EXT_TEXT) [ not err ] make_file (pth + xrf_file(current_object) + DEF_EXT_TEXT) [ not err ] make_file (pth + ctx_file(current_object) + DEF_EXT_TEXT) [ not err ] function_return 1 end_function function open_files returns integer local string pth get file_path to pth indicate err false open (pth + grp_file(current_object)) as grp [not err] open (pth + sbj_file(current_object)) as sbj [not err] open (pth + xrf_file(current_object)) as xrf [not err] open (pth + ctx_file(current_object)) as ctx [not err] function_return 1 end_function procedure reopen_help_files indicate err false if current_grp gt EMPTY_STRING open (current_pth + current_grp) as grp [not err] if current_sbj gt EMPTY_STRING ; open (current_pth + current_sbj) as sbj [not err] if current_xrf gt EMPTY_STRING ; open (current_pth + current_xrf) as xrf [not err] if current_ctx gt EMPTY_STRING ; open (current_pth + current_ctx) as ctx end_procedure function open_alt_files returns integer local string pth get file_path to pth indicate err false open (pth + grp_file(current_object)) as grp2 [not err] open (pth + sbj_file(current_object)) as sbj2 [not err] open (pth + xrf_file(current_object)) as xrf2 [not err] open (pth + ctx_file(current_object)) as ctx2 [not err] set_relate xrf2.grp_recnum to grp2.recnum [not err] set_relate xrf2.sbj_recnum to sbj2.recnum [not err] set_relate ctx2.xrf_recnum to xrf2.recnum [not err] function_return 1 end_function procedure close_files close grp close sbj close xrf close ctx end_procedure procedure close_alt_files close grp2 close sbj2 close xrf2 close ctx2 end_procedure function zero_files returns integer indicate err false if (select_state(erase_checks(current_object),0)) zerofile grp [not err] if (select_state(erase_checks(current_object),1)) zerofile sbj [not err] if (select_state(erase_checks(current_object),2)) zerofile xrf [not err] if (select_state(erase_checks(current_object),3)) zerofile ctx function_return 1 end_function procedure reset_names set file_path to (path_name(current_object)) set grp_file to (grp_name(current_object)) set sbj_file to (sbj_name(current_object)) set xrf_file to (xrf_name(current_object)) set ctx_file to (ctx_name(current_object)) end_procedure procedure delete_defs_and_fds string pth erasefile (pth + grp_name(current_object) + DEF_EXT_TEXT) erasefile (pth + sbj_name(current_object) + DEF_EXT_TEXT) erasefile (pth + xrf_name(current_object) + DEF_EXT_TEXT) erasefile (pth + ctx_name(current_object) + DEF_EXT_TEXT) end_procedure function check_file string pth string fil_nam integer img returns integer local integer ret_val cur_img direct_output (pth + fil_nam + DEF_EXT_TEXT) [ seqeof ] move 0 to ret_val [ not seqeof ] move 1 to ret_val if not ret_val close_output else begin move (img - helpgrp_def_top_img.n) to windowindex print (pth + fil_nam) to helpgrp_def_top_img.1& move current_image to cur_img move img to current_image output // top move (img + 4) to current_image output // bottom move cur_img to current_image close_output direct_input (pth + fil_nam + DEF_EXT_TEXT) [ seqeof ] move 0 to ret_val [ not seqeof ] move 1 to ret_val close_input end function_return ret_val end_function function check_file_specs string pth returns integer local integer ret_val bad_itm mode get check_file pth (grp_name(current_object)) ; helpgrp_def_top_img.n to ret_val if ret_val get check_file pth (sbj_name(current_object)) ; helpsbj_def_top_img.n to ret_val if ret_val get check_file pth (xrf_name(current_object)) ; helpxrf_def_top_img.n to ret_val if ret_val get check_file pth (ctx_name(current_object)) ; helpctx_def_top_img.n to ret_val function_return ret_val end_function procedure reset_states set new_state to false set open_state to false set erase_state to false set import_state to false end_procedure end_object // help_files end on_key kexit_application send exit_program ////////////////////////////////// ////////////////////////////////// main logic ////////////////////////////////// if cmd_option eq PATH_OPTION send init_open to help_files else if cmd_option eq NEW_FILE_OPTION send new to help_files else if cmd_option eq OPEN_FILE_OPTION send open to help_files else if cmd_option eq IMP_MAINT_OPTION send import to help_files else if cmd_option eq ERS_MAINT_OPTION send erase to help_files start_ui abort