Piper's Pit BBS/FTP: ibm 0010

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

/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / ME494-6.ZIP / USERIN.SRC < prev next >

Wrap

Text File | 1990-06-14 | 147.5 KB | 5,347 lines

$MACRO_FILE USERIN; {*******************************MULTI-EDIT MACRO******************************* Name: USERIN Description: Most of the general purpose user input routines. TOPMENU - Macro to create a top level menu SUBMENU - Creates a sub level menu XMENU - Replaces the V_Menu and Bar_Menu macro commands QUERYBOX - A general purpose boxed string input prompt CHECKFILE - A verify for files. VERIFY - Are you sure? MAINHELP - Accesses the main ME help screen DATA_IN - A general purpose Boxed Data entry menu DVMENU - A variable-length menu generator SPECCHAR - Changes untypeable character into the |xx convention VALCHAR - Changes the |xx back to a character STRSRC - Formats strings to be used in macro source code generators like install DBLPAREN - Takes occurances of ( and changes them to (( for menus CHNGPARM - Changes a single slash type parameter(/) in a global string. USERSTR - Replaces the macro command STRING_IN GLOBALVARLIST - Creates a list of global array elements DELETEITEM - Shuffles global variable arrays WMENU - Low level scrolling menu routine. Is called by DVMENU CHECKEVENTS - Mouse and Key event handler DB - General purpose Database manager. EDITWINDOW - File editing/examining macro. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} $MACRO TOPMENU FROM ALL; {*******************************MULTI-EDIT MACRO******************************* Name: TOPMENU Description: Creates the top bar menu. Parameters: /#=nn The number of menu selections. /S=nn The starting menu selection number. /G=str The prefix used to find the global strings containing the individual menu selection parameters. /M=str The prefix used to find the actual menu name strings. If this parameter is used then TOPMENU assumes that the menu item names will be contained in seperate globals instead of being part of the selection parameters. /X=nn The starting column. /Y=nn The starting row. /L=str The label for the menu /B=nn 0 = Create a box for the menu 1 = Don't create the box. /GCLR=1 Clear all globals on exit; The individual menu items are passed via global strings defined as the string passed via /G= plus the number of the menu item. If "/G=MSTR" then menu item one would be "MSTR1", item two would be "MSTR2" and so on. Each menu item parametr string may contain the following: /N=str The name of the menu item. Use only if /M (above) is NOT used. /S=nn 0 = The item has a sub-menu. 1 = The item does not have a sub-menu, but do not delete this menu and return to this menu with the following action according to Return_Int Return_Int = 0 - Return to this menu and process the last keystroke. In this case, right and left arrow keys will cause the choice to the left or right of the current choice to be selected, and <ESC> will cause an exit from this menu. Return_Int = -1 - Return to this menu only. Do not Process the last keystroke. Return_Int > 1 - Immediately after returning to this menu, exit this menu. 2 = The item does not have a sub-menu. Delete this menu from the screen, execute the macro, do not return to this menu. /H=str Help index string for this menu item. /M=str Macro to run upon selection of this menu item. This must be the last parameter in the menu string because everything after the /M= is passed to the macro as its parameters. /X=, /Y= and /BC= are also passed to the macro. /BC= is the box number above which all boxes are to be removed. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str( Mstr, Label_Str[80] ); Def_Str( GStr[20], gstr2[20] ); Def_Int(x1,y1,jx,start,bc, t_ex, t_box_count, res, first_time, old_x, old_y ); Def_Int( menu_type, sub_col ); Def_Int( start_box_count, select_stat, select_mode, Count, cur_item ); old_x := wherex; old_y := wherey; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); menu_type := 1; gstr2 := Parse_Str('/M=', mparm_str); if gstr2 = '' then gstr2 := '@#$X' + str( global_int('MENU_LEVEL') ); menu_type := 0; end; refresh := false; gstr := Parse_Str('/G=', mparm_str ); label_str := parse_str('/L=', mparm_str); x1 := Parse_Int('/X=',MPARM_STR); y1 := Parse_Int('/Y=',MPARM_STR); if x1 = 0 then x1 := 2; end; if y1 = 0 then y1 := 2; end; if (y1 + 4) > (screen_length) then y1 := (screen_length - 4); end; if y1 <= 0 then y1 := 2; end; bc := (Parse_Int('/B=',MPARM_STR) = 0); count := Parse_Int('/#=', MParm_Str ); Start := Parse_Int('/S=',MPARM_STR); if start < 1 then start := 1; end; start_box_count := box_count; Select_Stat := 0; if menu_type = 0 then JX := 0; While jx < Count do ++jx; create_global_str( gstr2 + str(jx), parse_str('/N=', Global_Str(gstr + str(jx))) ); end; end; t_box_count := box_count; cur_item := Start; cur_item := 0; while cur_item < count do ++cur_item; call draw_item; end; cur_item := start; first_time := 0; update_status_line; main_loop: xmenu(gstr2, count,x1 + first_time, y1 + first_time, (bc shl 4) or (first_time shl 8), bc - first_time , label_str, cur_item, res, sub_col ); set_global_str( gstr + '0', str(cur_item) ); t_box_count := box_count; first_time := bc; call draw_item; select_mode := Parse_int('/S=',mstr); if res = -4 then IF (Mou_Last_Y = Fkey_Row) THEN RM( 'MOUSE^MouseFkey' ); ELSE push_key(key1,key2); return_int := 0; goto exit; END; elsif res = -2 then if key1 = 0 then if key2 = 59 then Jx := Cur_Item; SEEK_HELP: IF ((Jx > 1) and (parse_str('/H=',Global_Str(gstr + str(Jx))) = '')) THEN --Jx; Goto SEEK_HELP; END; help( parse_str('/H=', Global_Str(gstr + str(Jx))) ); end; end; elsif res = 0 then return_int := 0; goto exit; end; if res > 0 then select_stat := true; if select_mode then goto do_select; end; end; if select_stat and not(select_mode) then do_select: if (select_mode = 2) then hmenu_stat := FALSE; if bc then kill_box; end; end; mstr := Global_Str(gstr + str(cur_item)); jx := Xpos('/M=', mstr, 1); if jx = 0 then goto nomstr; end; mstr := copy(mstr,jx + 3, 200); if mstr <> '' then RM( mstr + ' /BC=' + str(start_box_count) + '/X=' + str(sub_col) + '/Y=' + str(y1 + 2 - (bc = 0))); update_status_line; else nomstr: return_int := cur_item; end; hmenu_stat := FALSE; if select_mode = 2 then goto exit; end; while box_count > t_box_count do kill_box; end; if return_int = -2 then select_stat := 0; elsif return_int = -1 then select_stat := 0; goto exit; elsif return_int = 0 then select_stat := 1; push_key( key1, key2 ); elsif return_int > 0 then goto exit; end; end; goto main_loop; draw_item: mstr := Global_Str(gstr + str(cur_item)); ret; exit: hmenu_stat := FALSE; while box_count > t_box_count do kill_box; end; if bc then if box_count = t_box_count then kill_box; end; end; jx := 0; while jx < count do ++jx; set_global_str(gstr + str(jx), ''); set_global_str(gstr2 + str(jx), ''); end; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); if mode <> edit then gotoxy( old_x, old_y); end; exitx: END_MACRO; $MACRO SUBMENU FROM ALL; {*******************************MULTI-EDIT MACRO******************************* Name: SUBMENU Description: Creates a boxed vertical menu. Used by DATA_IN. Returns: Return_Int = -1 if <ESC> was pressed. 0 if the <LEFT> or <RIGHT> keys were pressed. >0 if an item was selected. Parameters: /#=nn The number of menu selections. /S=nn The starting menu selection number. /G=str The prefix used to find the global strings containing the individual menu selections. /M=str The prefix used to find the actual menu name strings. If this parameter is used then SUBMENU assumes that the menu item names will be contained in seperate globals instead of being part of the selection parameters. /X=nn The starting column. /Y=nn The starting row. /L=str The label for the menu /A=nn 0 = Exit if the left or right arrow keys are pressed. 1 = Ignore left and right arrow keys. /B=nn 0 = Create a box for the menu 1 = Don't create the box. /BC=nn The Box number above which all boxes will be removed if a menu item with /S=2 (as a parameter) is selected. 0 if all boxes are to be removed. /GCLR=1 Clear all globals on exit; /BO= Box offset. Normally used with /B=1. Will offset The menu as though a box was there. Good for multiple calls without kill the box in between. The individual menu items are passed via global strings defined as the string passed via /G= plus the number of the menu item. If "/G=MSTR" then menu item one would be "MSTR1", item two would be "MSTR2" and so on. Each menu item may contain the following: /N=str The name of the menu item. Use only if /M (above) is NOT used. /S=nn 0 = The item has a sub-menu. 1 = The item does not have a sub-menu, but do not delete this menu and return to this menu selection if the macro returns 0. 2 = The item does not have a sub-menu. Delete this menu from the screen, execute the macro, do not return to this menu. 3 = Run the sub-menu. Exit this menu with return_int equal to the menu selection. Don't kill box. /H=str Help index string for this menu item. /M=str Macro to run upon selection of this menu item. This must be the last parameter in the menu string because everything after the /M= is passed to the macro as its parameters. /X=, /Y= and /BC= are also passed to the macro. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str( Mstr, Label_Str[80] ); Def_Str( gstr[20], gstr2[20] ); def_int( first_time, res, sub_col ); Def_Int( bc, t_box_count, kill_count, arrow_stat ); Def_Int( x1,y1,jx,start, select_mode); Def_Int( Count, cur_item, menu_type, bo, old_x, old_y ); old_x := wherex; old_y := wherey; menu_type := 1; gstr2 := Parse_Str('/M=', mparm_str); if gstr2 = '' then gstr2 := '@#$Z' + str( global_int('MENU_LEVEL') ); menu_type := 0; end; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); gstr := Parse_Str('/G=', mparm_str ); label_str := Parse_Str('/L=', mparm_str ); x1 := Parse_Int('/X=',MPARM_STR); y1 := Parse_Int('/Y=',MPARM_STR); if x1 = 0 then x1 := 2; end; if y1 = 0 then y1 := 2; end; count := Parse_Int('/#=', MParm_Str ); Start := Parse_Int('/S=',MPARM_STR); bo := parse_int('/BO=', mparm_str); if start < 1 then start := 1; end; kill_count := parse_int('/BC=', mparm_str ); bc := (Parse_Int('/B=', mparm_str) = 0); arrow_stat := Parse_Int('/A=', mparm_str); if menu_type = 0 then JX := 0; While jx < Count do ++jx; create_global_str( gstr2 + str(jx), parse_str('/N=', Global_Str(gstr + str(jx))) ); end; end; if (y1 + count + 2) > (screen_length) then y1 := (screen_length - count - 3); end; if y1 <= 0 then y1 := 2; end; cur_item := start; first_time := 0; main_loop: update_status_line; xmenu(gstr2, count,x1 + first_time + bo, y1 + first_time + bo,((bc AND $01) shl 4) + 1 , bc - first_time , label_str, cur_item, res, sub_col ); set_global_str( gstr + '0', str(cur_item) ); t_box_count := box_count; first_time := bc; select_mode := Parse_Int('/S=', Global_Str(gstr + str(cur_item))); if res = -4 then IF (Mou_Last_Y = Fkey_Row) THEN RM( 'MOUSE^MouseFkey' ); ELSE push_key(key1,key2); if bc then kill_box; end; return_int := -2; goto exit; END; elsif res = -2 then if key1 = 0 then if key2 = 59 then Jx := Cur_Item; mstr := parse_str('/H=', Global_Str(gstr + str(Jx)) ); IF mstr = '' THEN mstr := parse_str('/H=', mparm_str); IF mstr = '' THEN SEEK_HELP: IF ((Jx > 1) and (parse_str('/H=',Global_Str(gstr + str(Jx))) = '')) THEN --Jx; Goto SEEK_HELP; END; mstr := parse_str('/H=', Global_Str(gstr + str(Jx)) ); END; END; help( mstr ); goto main_loop; end; end; if arrow_stat = 0 then if bc then kill_box; end; return_int := 0; goto exit; end; goto main_loop; elsif res = 0 then return_int := -1; if bc then kill_box; end; goto exit; end; if res > 0 then goto do_select; end; goto main_loop; do_select: if select_mode = 2 then while box_count > kill_count do kill_box; end; end; mstr := Global_Str(gstr + str(cur_item)); jx := Xpos('/M=', mstr, 1); if jx = 0 then return_int := cur_item; goto exit; end; mstr := copy(mstr,jx + 3, 200); RM( mstr + ' /BC=' + str(kill_count) + '/X=' + str(x1 + 1) + '/Y=' + str(y1 + 1 + count)); if (select_mode = 2) or (select_mode = 3) then return_int := cur_item; goto exit; end; if return_int > 0 then while box_count > t_box_count do kill_box; end; if bc then if box_count = t_box_count then kill_box; end; end; if not(select_mode) then while box_count > kill_count do kill_box; end; end; return_int := res; goto exit; end; goto main_loop; exit: if (parse_int('/GCLR=', mparm_str) = true) or (menu_type = 0) then jx := 0; while jx < count do ++jx; set_global_str(gstr + str(jx), ''); set_global_str(gstr2 + str(jx), ''); end; end; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); if mode <> edit then gotoxy( old_x, old_y); end; END_MACRO; $MACRO XMENU FROM ALL; {*******************************MULTI-EDIT MACRO****************************** Name: XMENU Description: Generates a vertical or horizontal menu. Meant to be a replacement for the macro functions V_MENU and BAR_MENU. Returns: Return_Int = 0 if <ESC> was pressed > 0 then return_int is the number of the select menu item. Parameters: /X=nn Starting column coordinate /Y=nn Starting row coordinate /B=nn 0 = No box 1 = Create box. /T=nn 0 = Horizontal menu 1 = Vertical menu /S=nn Start menu item. /L=str Label for box /M=str The menu string. The format is as follows: Off(INDENT)Auto()Smart() Menu titles are seperated by ()'s Inside the ()'s are the help indexes If the help index is the same for all menu options you can just specify the first. Must be the LAST parameter passed. /M1= - M3= The names of global strings to be added to /M= in case you need more menu choices than will fit on the 254 character macro command line. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} def_str( gstr[20], bstr[4] ); def_int( start,x1,y1,box,jx, jx2, jy, count ); def_str( mstr, tstr[40] ); x1 := parse_int( '/X=', mparm_str ); y1 := parse_int( '/Y=', mparm_str ); box := parse_int( '/B=', mparm_str ); if box then bstr := ''; else bstr := '/B=1'; end; start := parse_int( '/S=', mparm_str ); set_global_int('MENU_LEVEL', global_int('MENU_LEVEL') + 1); gstr := Str(global_int('MENU_LEVEL')) + 'MSTR_'; jx := xpos( '/M=', mparm_str , 1); mstr := copy( mparm_str, jx + 3, 254 ); count := 0; call get_menus; mstr := global_str( parse_str( '/M1=', mparm_str ) ); call get_menus; mstr := copy(mstr, jx2, 254) + global_str( parse_str( '/M2=', mparm_str ) ); call get_menus; mstr := copy(mstr, jx2, 254) + global_str( parse_str( '/M3=', mparm_str ) ); call get_menus; goto do_menu; get_menus: jx := 1; jx2 := 1; loop: jx := xpos( '(', mstr, jx + 1 ); if jx <> 0 then if copy(mstr, jx + 1, 1) = '(' then mstr := str_del( mstr, jx, 1); goto loop; end; ++count; jy := xpos( ')', mstr, jx + 1); create_global_str( gstr + str(count), '/S=2/H=' + copy( mstr, jx + 1, jy - jx - 1 )); create_global_str( gstr + 'X' + str(count), copy( mstr, jx2, jx - jx2 )); jx2 := jy + 1; goto loop; end; ret; do_menu: if parse_int('/T=',mparm_str) = 0 then RM('TOPMENU /GCLR=1/X=' + str(x1) + '/Y=' + str(y1) + '/M=' + gstr + 'X' + '/#=' + str(count) + '/S=' + str(start) + '/G=' + gstr + bstr + '/BC=' + str(box_count) + '/L=' + parse_str('/L=', mparm_str) ); else RM('SUBMENU /GCLR=1/A=1/X=' + str(x1) + '/Y=' + str(y1) + '/#=' + str(count) + '/M=' + gstr + 'X' + '/S=' + str(start) + '/G=' + gstr + bstr + '/BC=' + str(box_count) + '/L=' + parse_str('/L=', mparm_str) ); end; IF (Return_Int < 0) THEN Return_Int := 0; END; set_global_int('MENU_LEVEL', global_int('MENU_LEVEL') - 1); END_MACRO; $MACRO QUERYBOX FROM ALL; {*******************************MULTI-EDIT MACRO******************************* Name: QUERYBOX /C=n /L=n /W=n /T=str /H=str Description: Creates a simple text input box. Parameters: Return_Str is initialized the default input string value. /C=n The column position /L=n The line number /W=n The maximum width of the string in the box /ML=n The maximum length of the string. /T=str The box title /H=str The help index /F2=str F2 label if one is desired. If this parm is passed, and F2 is pressed, Return_Int will return -1; /N=1 Numeric input. If Numeric input then Return_Int should be initialized to the default value. /P=str Prompt. /NK=n 1 = don't kill the box when exiting. 0 = normal. /NB=n 1 = don't make a box. 0 = normal. Offsets for prompt position will still be in effect even if a box is not made. This facilitates reentering the macro without redrawing the box after not killing the box. /MIN=n For numeric only. n = minimum legal response value. /MAX=n For numeric only. n = maximum legal response value. /HISTORY= The history global name. Returns: If NOT Numeric input then Return_Int = 1 if <ENTER> was pressed to accept the input. Return_Int = 0 if <ESC> was pressed. Return_Str = the inputted string. Unchanged if Return_Int = 0. ELSE Return_Str = 'TRUE' if <ENTER> was pressed. Return_Str = 'FALSE' if <ESC> was pressed. Return_Int = The numeric result. Unchanged if Return_Str = false. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Int( texp, x, y, jx, numeric, Tint, tbc, old_refresh, box ); Def_Str( Temp_Str, f2[20] ); Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); old_refresh := refresh; texp := explosions; explosions := false; refresh := false; x := Parse_Int('/C=',MParm_Str); y := Parse_Int('/L=',MParm_Str); f2 := Parse_Str('/F2=',MParm_Str); numeric := Parse_Int('/N=', MParm_Str); if f2 <> '' THEN f2 := '/F2=' + f2; end; IF (Parse_Str('/F5=',MParm_Str) <> '') THEN f2 := f2 + '/F5=' + Parse_Str('/F5=',MParm_Str); END; box := (Parse_Int('/NB=', MParm_Str) <> 1); Temp_Str := Return_Str; If Numeric Then Temp_Str := Str(Return_Int); Tint := Return_Int; END; tbc := box_count; ql1: while box_count > tbc do kill_box; END; Return_Str := Temp_Str; RM( 'USERSTR ' + f2 + '/NK=1/B=' + Str(box) + '/BL=' + Parse_Str('/T=',MParm_Str) + '/P=' + Parse_Str('/P=',MParm_Str) + '/W=' + Parse_Str('/W=',MParm_Str) + '/L=' + parse_str('/ML=', mparm_str) + '/X=' + str( x + (box = 0)) + '/Y=' + str( y + (box = 0)) + '/H=' +Parse_Str('/H=',MParm_Str) + '/HISTORY=' + parse_str('/HISTORY=' , mparm_str) ); Temp_Str := Return_Str; If Return_Int then If Numeric THEN If VAL(jx,temp_str) <> 0 THEN error_level := 1006; RM('MEERROR'); error_level := 0; Goto QL1; END; IF (Parse_Str('/MIN=', MParm_Str) <> '') THEN IF (Jx < Parse_Int('/MIN=', MParm_Str)) THEN RM('MEERROR^Beeps /C=1'); Goto QL1; END; END; IF (Parse_Str('/MAX=', MParm_Str) <> '') THEN IF (Jx > Parse_Int('/MAX=', MParm_Str)) THEN RM('MEERROR^Beeps /C=1'); Goto QL1; END; END; Return_Str := 'TRUE'; Return_Int := jx; END; ELSE If Numeric THEN Return_Str := 'FALSE'; Return_Int := Tint; END; END; IF parse_int('/NK=', mparm_str) = 0 THEN while box_count > tbc do kill_box; END; END; refresh := old_refresh; explosions := texp; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); END_MACRO; $MACRO VERIFY FROM ALL; {*******************************MULTI-EDIT MACRO****************************** Name: VERIFY Description: Creats a simple CONFIRM YES/NO box. Parameters: /C=nn column number to put box. /L=nn line number to put box. /H=str help string. /T=str convirm message /BL=str Box label /S=nn default selection 1 or 2. Defaults to 1. Returns: RETURN_INT = True if YES was selected, False if NO was selected or ESC was pressed. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Int(x,y,w,s); Def_Str(Temp_Str[132], ts2[80] ); x := Parse_Int('/C=',MParm_Str); y := Parse_Int('/L=',MParm_Str); if x = 0 then x := 2; end; if y = 0 then y := 4; end; s := Parse_Int('/S=',MParm_Str); IF ((s > 2) or (S < 1)) THEN S := 1; END; ts2 := parse_str('/BL=',mparm_str); if ts2 = '' THEN ts2 := 'CONFIRM'; END; Temp_Str := Parse_Str('/T=',MParm_Str); w := svl(temp_str); IF w < svl( ts2 ) THEN w := svl(ts2); END; Put_Box(x,y,x+w+11,y+3,0,m_b_Color,ts2,True); Write(Temp_Str,x+1,y+1,0,m_s_Color); RM('USERIN^XMENU /T=0 /X=' + str(x+3+Length(Temp_Str)) + '/Y=' + str(y+1) + '/S=' + Str(S) + '/M=' + 'No('+Parse_Str('/H=',MParm_Str) + ')Yes(' + Parse_Str('/H=',MParm_Str) + ')'); Return_Int := Return_Int > 1; Kill_Box; END_MACRO; $MACRO CHECKFILE; {*******************************MULTI-EDIT MACRO****************************** Name: CHECKFILE Description: Checks to see if a file has been saved and prompts the user if he wants to save before the window gets erased or deleted. Will save the file, if he so chooses. Parameters: /X= The X coordinate for the prompt box /Y= The Y coordinate for the prompt box Returns: Return_Int 0 - Don't destroy the data. 1 - O.K. to blast it. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Int(w); Def_Str(Temp_Str[20]); If (File_Changed) and (link_stat = 0) then temp_str := parse_str('/H=', mparm_str); RM('USERIN^XMENU /T=0/B=1/L=CURRENT FILE NOT SAVED - CONTINUE?/X=' + Parse_Str('/X=',MParm_Str) + '/Y=' + Parse_Str('/Y=',MParm_Str) + '/S=1/M=' + 'No('+temp_str + ')Yes-((abandon changes)(' + temp_str + ')Save-file-and-continue(' + temp_str + ')'); If return_int = 3 then Error_Level := 0; save_file; return_int := 1; if error_level <> 0 then RM('MEERROR'); return_int := 0; end; else return_int := (return_int > 1); end; else return_int := 1; end; END_MACRO; $MACRO MAINHELP FROM ALL; {*******************************MULTI-EDIT MACRO****************************** Name: MAINHELP Description: Brings up the main help screen ME.HLP or ME.HLC. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} RM('MEHELP /F=ME/LK=*/CX=' + str(mode = EDIT)); END_MACRO; $MACRO DATA_IN FROM ALL; {****************************************************************************** MULTI-EDIT MACRO Name: DATA_IN Description: Builds a screen of editable fields. Each field has its own column and line setting, as well as its own help and type attributes. Will build a box around the fields if /X and /Y are specified. If the height (/H) or the width (/W) are not specified then they will be calculated. Parameters: /#=count {the number of fields} /S=start_field {the starting field number} /PRE=str {The prefix to use for the global var names} /X=nn {The Upper Right hand column, or x coordinate} /Y=nn {The Upper Right hand row, or y coordinate} /H=str {help string} /HT=nn {The height of the box, automatically calculated if not present} /W=nn {The width of the box, automatically calculated as above} /T=title {The title of the box} /A=nn Accept type. 0 = Accept no matter what. 1 = Accept no matter what. 2 = Accept no matter what. 3 = Use ACCEPT field defined by type 6 or via /GO=1 in IPARM_x. /NC=nn 1 = NO Cleanup. Don't erase global variables when done. Returns: RETURN_INT = 0 if the <ESC> key was pressed. Else RETURN_INT = Then item that <ENTER> was pressed on. Global Vars: ISTR_1 .. ISTR_x {field string, x = count} IPARM_1 .. IPARM_x {parmaeter string,x = count} /C= column /L= line /W= displayable width of field /ML= max length if max length is 0 then max length = width. /H= help_link. /T= Field title /GO= If <enter> pressed on this field, treat like accept field. /HISTORY= name of history_list globals /PROTECT= 1 prevents a field from being changed. /MIN= Minimum numeric value if a numeric type /MAX= Maximum numeric value if a numeric type /TP= type type of 0 = string (default) 1 = integer 2 = real number 3 = Multiple Choice with vertical menu. ISTR_x contains the menu. IINT_x contains the choice number. 4 = Hex - same as integer, except display and user input in hex. 5 = toggle true or false. ISTR_x = '/T=YES/F=NO' IINT_x = boolean value. 6 = Accept field. 7 = Run macro, return integer. IPARM=x /M=macro (must be last parameter) The following parameters get passed to the macro: /X=nn /Y=nn /STR=str (the string in ISTR_x) 8 = Run macro, return string(or return global, see below). IPARM=x /M=macro (must be last parameter) /X=nn /Y=nn /INT=nn (the integer in IINT_x) /RGS= Return global string. Used only with /TP=8. Due to the 255 character limit on Return_Str, if you specify the name of a global string, it will use that instead. 9 = Keycode field. It is stored in IINT as an integer lower byte is primary scan code, upper byte is extended scan code. Field will be displayed as in the example below: SET_GLOBAL_INT('IINT_1',7181); Displays <ENTER> User will be prompted for a keystroke when he presses <ENTER> a type 9 field. IINT_x = value for integer or multiple choice. IHELP1 the help string when no field is being edited. IHELP1 = '/C=column/L=Line/H=help_str' IHELP2 the help string when a field is being edited. IHELP2 = '/C=column/L=Line/H=help_str' Note that if an X and Y coordinate was specified in the parameter line then, the column and line numbers will be offsets from the X and Y coordinates. Example: {Setup multi-file search} Set_Global_Str('IHELP1','/C=13/L=8/H= to select, <ESC> to exit, <F3> to edit.'); Set_Global_Str('IHELP2','/C=13/L=8/H=<ENTER> to accept input, <ESC> to abort input.'); Set_Global_Str('ISTR_1',filespec); Set_Global_Str('IPARM_1','/T=Filespec:/C=1/W=60/ML=80/H=SR/L=1'); Set_Global_Str('ISTR_2',Search_Str); Set_Global_Str('IPARM_2','/T=Search For:/C=1/W=63/ML=128/H=SR/L=2'); Set_Global_Str('IPARM_3','/T=>>>>/C=1/H=SR/L=3/TP=6/W=17'); Set_Global_Str('ISTR_3','START FILE SEARCH'); Set_Global_Int('IINT_4',search_dirs); Set_Global_Str('ISTR_4','/T=YES/F=NO'); Set_Global_Str('IPARM_4','/T=Search Subdirectories..../C=1/W=3/H=SR/L=4/TP=5'); Set_Global_Str('ISTR_5',global_str('FSEARCH_PATH')); Set_Global_Str('IPARM_5','/T=Starting path............/C=1/W=40/H=SR/L=5'); Set_Global_Int('IINT_6',case_sensitive); Set_Global_Str('ISTR_6','/T=YES/F=NO'); Set_Global_Str('IPARM_6','/T=Case Sensitivity........./C=1/W=3/H=SR/L=6/TP=5'); Set_Global_Int('IINT_7',use_reg_exp); Set_Global_Str('ISTR_7','/T=YES/F=NO'); Set_Global_Str('IPARM_7','/T=Use Regular Expressions../C=1/W=3/H=SR/L=7/TP=5'); RM('UserIn^Data_In /S=1/A=3/#=7/X=1/T=SEARCH FILES/Y=' + str(y1)); (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str( MStr, Prefix[10], iint[20], iparm[20], istr[20], Label_Str[132], c_str1[20], c_str2[20], history_str[20], event_str[20], tstr[80], RGS[20] ); {General purpose string} Def_Int( tcp, t_refresh, field_count, {The number of fields} fc, bc, {Foreground and background colors} X1, Y1, Height, Width, jx, jy, jz, old_x, old_y, c_choice, tc, tl, tw,tt, {Temp col, line, and width, type} ll, {Temp label length} protect, {field protect status} hc, hl, {Help line and column} C_Parm, {The parm string being worked on} old_c, old_l, {The old cursor position} accept_mode, history_stat, min_num, tmw, full_write, mouse_result, event_count, count, Edit_Enable, go_accept, t_parm ); t_refresh := refresh; refresh := false; working; Edit_Enable := False; RGS := Parse_Str('/RGS=',MParm_Str); go_accept := False; old_c := WhereX; {Save the cursor position for later restoration} Old_l := WhereY; Return_Int := False; field_count := 0; Push_Labels; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); {Get the count of the fields} field_count := Parse_Int('/#=', MParm_Str); X1 := Parse_Int('/X=', MParm_Str); Y1 := Parse_Int('/Y=', MParm_Str); prefix := parse_str( '/PRE=', mparm_str ); iint := prefix + 'IINT_'; istr := prefix + 'ISTR_'; iparm := prefix + 'IPARM_'; Height := Parse_Int('/HT=', MParm_Str); Width := Parse_Int('/W=', MParm_Str); accept_mode := Parse_Int('/A=', MParm_Str); min_num := 1; full_write := false; {If no height or width then calculate then by going through the entire list of fields and determining the maximun column and row needed.} IF (X1 <> 0) and ((Height = 0) or (Width = 0)) THEN C_Parm := min_num; While (C_Parm <= field_count) DO MStr := Global_Str( iparm + Str( C_Parm ) ); jx := length( Parse_Str('/T=',MStr) ); Jx := Jx + Parse_Int('/C=',MStr) + Parse_Int('/W=',MStr) + 1; tt := parse_int( '/TP=', mstr ); IF (tt = 3) OR (TT > 4) THEN ++jx; ++jx; END; If Jx > Width THEN Width := JX; END; jx := Parse_Int('/L=',MStr); if jx = 0 then jx := height + 1; mstr := '/L=' + str(jx) + mstr; set_global_str( iparm + str(c_parm), mstr); end; If jx > Height THEN Height := JX; END; ++C_Parm; END; Height := Height + 2; Width := Width + 2; END; if (x1 + width) > screen_width then x1 := (screen_width - width) - 1; end; IF X1 <= 0 THEN X1 := 1; END; if (y1 + height) > (screen_length - (fkey_row <> 0)) then y1 := (screen_length - (fkey_row <> 0)) - height; end; IF Y1 <= 0 THEN Y1 := 3; END; event_count := 0; event_str := '@EV' + Str(Global_Int( 'MENU_LEVEL' )) + '#'; If (field_count < min_num) THEN GOTO EXIT2; END; set_virtual_display; {If an x coordinate was specified then build a box} If X1 <> 0 THEN Put_Box(X1,Y1,X1+Width,Y1+Height,0,m_b_color, Parse_Str('/T=',MParm_Str),true); event_count := 2; IF accept_mode = 3 THEN mstr := 'Cancel'; ELSE mstr := 'Done'; END; Set_Global_Str(event_str + '1', '/T=' + mstr + '/KC=<ESC>/K1=27/K2=1/R=0'); Set_Global_Str(event_str + '2', '/T=Next/KC=<TAB>/W=9/K1=9/K2=15/R=1'); RM('CheckEvents /M=4/G=' + event_str + '/#=' + str(event_count) + '/X=' + str(x1) + '/Y=' + str(y1 + height - 1) + '/W=' + str(width - 2)); RM('CheckEvents /M=2/G=' + event_str + '/#=' + str(event_count)); END; {Write all of the fields on the screen} IF (Global_Str(prefix + 'IHELP3') <> '') THEN Call HELP_LINE3; END; call draw_all_fields; full_write := true; {Put up the Function key labels} FLabel('Help',1,$FF); Flabel('Edit',3,$FF); C_Parm := Parse_Int('/S=',MParm_Str); {Get the starting field number} If (C_Parm < min_num) THEN C_Parm := min_num; END; update_status_line; update_virtual_display; reset_virtual_display; Main_Loop: IF (Go_accept) THEN Return_Int := T_Parm; Goto Exit; END; Call Help_Line1; If C_Parm < min_num then C_Parm := field_count; END; If C_Parm > field_count then C_Parm := min_num; END; T_Parm := C_Parm; Call Mark_Item; if svl(history_str) <> 0 then flabel('List', 4, -1); else flabel('', 4, -1); end; old_x := 0; old_y := 0; WHILE NOT(Check_Key) DO Mou_Check_Status; IF ((Mou_Last_Status AND 1) <> 0) AND ((old_x <> Mou_Last_X) OR (old_y <> Mou_last_Y)) THEN old_x := Mou_Last_X; old_y := Mou_Last_Y; call find_mouse; END; END; jx := INQ_KEY( key1, key2, 5, tstr ); IF jx = 1 THEN RM( tstr ); goto main_loop; end; If Key1 = 0 THEN {don't allow the F2 key} If (Key2 = 60) THEN Goto Main_Loop; {If F1 then run help} ELSIf (Key2 = 59) THEN mstr := Parse_Str('/H=',Global_Str( iparm + Str( C_Parm ) )); IF mstr = '' THEN mstr := parse_str('/H=', mparm_str); END; help(mstr); Goto Main_Loop; ELSif (key2 = 62) then if svl(history_str) <> 0 then goto input_data; end; goto main_loop; {If Up arrow key or up mouse then move bar up} ELSIf (key2 = 242) then goto main_loop; ELSIf (key2 = 243) then goto main_loop; ELSIf (key2 = 244) then goto go_cr; ELSIf (key2 = 245) then goto go_esc; ELSIF (key2 = 250) THEN IF (Mou_Last_Y = Fkey_Row) THEN RM( 'MOUSE^MouseFkey' ); Goto Main_Loop; ELSIF (Mou_Last_X < x1) OR (Mou_Last_X > (x1 + width)) OR (Mou_Last_Y < y1) OR (Mou_Last_Y > (y1 + height + 1)) THEN Push_Key( 0, 250 ); Goto go_esc; END; RM('CheckEvents /M=1/G=' + event_str + '/#=' + str(event_count)); RM('CheckEvents /M=2/G=' + event_str + '/#=' + str(event_count)); IF RETURN_INT <> 0 THEN Return_Int := Parse_Int('/R=', return_str); IF return_int = 1 THEN goto go_right; ELSE goto go_esc; END; END; call find_mouse; IF (mouse_result <> 0) AND (tt > 2) AND (tt <> 4) THEN goto go_cr; ELSE Goto Main_Loop; END; ELSIf (Key2 = 71) then Call UnMark_Item; C_Parm := min_num; goto main_loop; ELSIf (Key2 = 79) then Call UnMark_Item; C_Parm := field_count; goto main_loop; ELSIf (Key2 = 72) or (Key2 = 240) THEN Call UnMark_Item; Call Find_Up; Goto Main_Loop; ELSIf {(key2 = 77) or} (key2 = 243) THEN go_right: Call UnMark_Item; ++C_Parm; Goto Main_Loop; ELSIf (key2 = 242) or (key2 = 15) THEN Call UnMark_Item; --C_Parm; Goto Main_Loop; ELSIf (Key2 = 80) or (Key2 = 241) THEN Call UnMark_Item; Call Find_Down; Goto Main_Loop; END; END; {If <ESC> or the right mouse button the exit with false} IF (Key1 = 27) THEN go_esc: if accept_mode = 3 then Return_Int := False; else return_int := 1; end; Goto Exit; END; If (Key1 = 9) THEN Goto Go_Right; END; IF (Key1 = 13) THEN go_cr: IF (Accept_Mode = 0) or (C_Parm = 0) THEN Return_Int := C_Parm; If Accept_Mode = 1 then Return_Int := 1; end; Goto Exit; ELSE IF (TT = 7) THEN Return_Int := XPos('/M=',Global_Str(iparm + Str( C_Parm )),1); IF (Return_Int) THEN Return_Str := Copy(Global_Str(iparm + Str( C_Parm )),Return_Int + 3, 255); IF (XPos(' ',Return_Str,1) = 0) THEN Return_Str := Return_Str + ' '; END; return_int := Global_Int(iint + Str( C_Parm )); RM(Return_Str + '/X=' + Str(X1) + '/Y=' + Str(Y1) + '/INT=' + Str(Global_Int(iint + Str( C_Parm ))) + '/PRE=' + prefix); Set_Global_Int(iint + Str( C_Parm ),Return_Int); END; call draw_all_Fields; END; IF (TT = 8) THEN Return_Int := XPos('/M=',Global_Str(iparm + Str( C_Parm )),1); IF (Return_Int) THEN {Check to see if command line parameters already exist in the macro name. If so, don't add a space between macro name and the params we are adding} MStr := Copy(Global_Str(iparm + Str( C_Parm )),Return_Int + 3, 255); IF (XPos(' ',MStr,1) = 0) THEN MStr := MStr + ' '; END; Return_Str := Global_Str(istr + str( c_parm ) ); IF (RGS <> '') THEN Set_Global_Str(RGS,Global_Str(istr + str( c_parm ))); END; RM(MStr + '/X=' + Str(X1) + '/Y=' + Str(Y1) + '/STR=' + Global_Str(istr + Str( C_Parm )) + '/PRE=' + prefix); IF return_int > 0 THEN Set_Global_Str(istr + Str( C_Parm ),return_str); IF (RGS <> '') THEN Set_Global_Str(istr + Str( C_Parm ),Global_str(RGS)); END; END; call draw_all_Fields; END; END; IF (TT = 9) THEN Put_Box(X1,Y1,X1 + 25,Y1 + 3,0,M_B_Color,'EDIT QUICKSTROKE',true); Write('Press the desired key.',X1 + 1,Y1 + 1,0,M_B_Color); Read_Key; Kill_Box; Set_Global_Int(iint + Str( C_Parm ), (key2 * 256) + key1); END; If (tt = 6) then Return_Int := c_parm; goto exit; end; If (C_Parm > 0) and (Accept_Mode <> 0) and (TT = 3) THEN RM('USERIN^XMENU /T=1/B=1/X=' + Str(X1 + 2) + '/Y=' + Str(Y1 + 2) + '/L=' + Shorten_Str(Label_Str) + '/S=' + Str(C_Choice) + '/M=' + Global_Str(istr + Str( C_Parm ) )); If Return_Int > 0 THEN Set_Global_Int(iint + Str( C_Parm ), Return_Int); END; Call UnMark_Item; ++C_Parm; ELSE If tt = 5 then Set_Global_Int(iint + str(c_parm), NOT(Global_Int(iint + str(c_parm)))); else Call UnMark_Item; ++C_Parm; end; END; END; go_accept := parse_int('/GO=', Global_Str( iparm + str(t_parm) )); Goto Main_Loop; END; IF (tt = 5) THEN {Force true or false using T for true and F for false} IF ((Key1 = 84) or (Key1 = 116)) THEN Set_Global_Int(iint + str(c_parm),True); END; IF ((Key1 = 70) or (Key1 = 102)) THEN Set_Global_Int(iint + str(c_parm),False); END; go_accept := parse_int('/GO=', Global_Str( iparm + str(t_parm) )); Goto MAIN_LOOP; END; IF (accept_mode = 1) and (C_Parm = 0) THEN Goto Main_Loop; END; If ((tt <> 3) and ((tt < 5) or (TT > 9))) AND NOT(protect) then input_data: Push_Key(key1,key2); Call Help_Line2; loopb: Mstr := Global_Str(istr + Str(C_PARM)); IF TT = 1 THEN MStr := Str(Global_Int(iint + Str( C_Parm ))); END; if tmw = 0 then tmw := tw; end; Return_Str := Mstr; RM('USERSTR /A=1/X=' + str(x1 + tc + ll + 1) + '/Y=' + str(y1 + tl) + '/W=' + str(tw) + '/L=' + str(tmw) + '/H=' + Parse_Str('/H=',Global_Str( iparm + Str( C_Parm ) )) + '/HISTORY=' + Parse_Str('/HISTORY=',Global_Str( iparm + Str( C_Parm ) )) ); Mstr := Return_Str; If (return_int > 0) or (return_int = -2) then IF TT = 1 THEN IF Val( jx, MStr) <> 0 THEN error_level := 1006; RM('MEERROR'); error_level := 0; goto loopb; END; IF xpos( '/MIN=', Global_Str( iparm + str(c_parm) ),1) <> 0 THEN jy := parse_int('/MIN=', Global_Str( iparm + str(c_parm) )); IF jx < jy THEN error_level := 1006; RM('MEERROR'); error_level := 0; goto loopb; END; END; IF xpos( '/MAX=', Global_Str( iparm + str(c_parm) ),1) <> 0 THEN jy := parse_int('/MAX=', Global_Str( iparm + str(c_parm) )); IF jx > jy THEN error_level := 1006; RM('MEERROR'); error_level := 0; goto loopb; END; END; Set_Global_Int(iint + Str(C_Parm),jx); ELSE IF (TT = 4) THEN {Process hex input} MStr := Caps(MStr); Jy := svl(MStr); if val(jx, '$' + mstr) <> 0 then RM('MEERROR^Beeps /C=1'); goto loopb; end; Set_Global_Int(iint + Str(C_Parm),jx); ELSE Set_Global_Str(istr + Str(C_Parm),MStr); END; END; Call UnMark_Item; if return_int = -2 then push_key(key1,key2); else ++C_Parm; end; END; END; go_accept := parse_int('/GO=', Global_Str( iparm + str(t_parm) )); Goto Main_Loop; draw_all_fields: tcp := c_parm; C_Parm := min_num - 1; fc := m_s_Color; bc := 0; While (C_Parm < field_count) DO ++C_Parm; Call Write_ISTR; END; c_parm := tcp; ret; Mark_Item: fc := m_h_color; bc := 0; Call Write_ISTR; GotoXy(X1 + TC + LL + 1,Y1 + TL); Ret; UnMark_Item: fc := m_s_Color; bc := 0; Call Write_ISTR; Ret; def_int( xx, yy ); Write_ISTR: c_str1 := str(c_parm); MStr := Global_Str( iparm + c_str1 ); c_str2 := istr + c_str1; c_str1 := iint + c_str1; TC := Parse_Int('/C=',Mstr); TL := Parse_Int('/L=',Mstr); TW := Parse_Int('/W=',Mstr); TMW := Parse_Int('/ML=',Mstr); TT := Parse_Int('/TP=',MSTR); PROTECT := Parse_Int( '/PROTECT=', mstr ); history_str := parse_str( '/HISTORY=', mstr ); Label_Str := Parse_Str('/T=',MStr); LL := svl( Label_Str ); xx := tc + x1; yy := tl + y1; Write( Label_Str, xx, yy, 0, m_t_Color); xx := xx + ll; IF (tt = 3) OR (TT > 4) THEN ++xx; draw_char( 91, xx, yy, m_t_color, 1 ); ++xx; draw_char( 93, xx + tw, yy, m_t_color, 1 ); ELSE ++xx; END; If (TT = 1) or (TT = 7) THEN MStr := Str(Global_Int(c_str1)); goto gowrite; ELSIF (TT = 9) THEN RM('SETUP^MAKEKEY /K1=' + Str(Global_Int(c_str1) and $FF) + '/K2=' + Str((Global_Int(c_str1) shr 8) and $FF)); MStr := Return_Str; goto gowrite; END; MStr := Global_Str(c_str2); if tt = 0 then goto gowrite; Elsif tt = 5 then if Global_Int(c_str1) = 0 then mstr := parse_str('/F=', mstr ); else mstr := parse_str('/T=', mstr ); end; goto gowrite; ELSIF (TT = 4) THEN {Process HEX} Mstr := Hex_Str( Global_Int(c_str1) ); IF (svl(mstr) mod 2) <> 0 then mstr := '0' + mstr; end; ELSIF TT = 3 THEN {Process Menu} c_choice := Global_Int(c_str1); IF (C_Choice < 1) THEN C_Choice := 1; END; Count := 0; jx := 1; jz := 1; Menu_loop: jx := xpos( '(', mstr, jx + 1 ); if jx <> 0 then if copy(mstr, jx + 1, 1) = '(' then mstr := str_del( mstr, jx, 1); goto MENU_loop; end; ++count; jy := xpos( ')', mstr, jx + 1); IF (Count < C_Choice) THEN jz := jy + 1; goto MENU_loop; END; end; MStr := copy( mstr, jz, jx - jz ); END; gowrite: if full_write then Draw_char(32, xx, yy,fc,tw); end; if tw = 0 then tw := svl(mstr); end; IF svl(mstr) > TW THEN Write(copy(MStr, 1, tw),xx, Yy,BC,FC); ELSE Write(mstr, xx, yy, bc, fc ); END; Ret; Help_Line1: MStr := Global_Str( prefix + 'IHELP1' ); Help_Parse: HC := Parse_Int('/C=',MStr); HL := Parse_Int('/L=',MStr); if hl = 0 then hl := height - 1; end; MStr := Parse_Str('/H=',MStr); Write(MStr,X1+HC,Y1+HL,0,M_B_Color); Ret; Help_Line2: MStr := Global_Str( prefix + 'IHELP2' ); Goto Help_Parse; Help_Line3: MStr := Global_Str( prefix + 'IHELP3' ); Goto Help_Parse; Find_Down: jx := c_parm; jy := tl; while (jx < field_count) do ++jx; mstr := global_str(iparm + str(jx)); jy := Parse_Int('/L=', mstr); if (jy - tl) > 1 then goto fd_exit; end; if jy > tl and (Parse_Int('/C=', mstr) = tc) then c_parm := jx; ret; end; end; fd_exit: ++c_parm ret; Find_Up: jx := c_parm; jy := tl; while (jx > min_num) do --jx; mstr := global_str(iparm + str(jx)); jy := Parse_Int('/L=', mstr); if (tl - jy) > 1 then goto fu_exit; end; if (jy < tl) and (Parse_Int('/C=', mstr) = tc) then c_parm := jx; ret; end; end; fu_exit: --c_parm ret; def_int( fjx ); find_mouse: mouse_result := FALSE; jx := min_num; while (jx <= field_count) do mstr := global_str(iparm + str(jx)); TC := Parse_Int('/C=',Mstr); TL := Parse_Int('/L=',Mstr); TW := Parse_Int('/W=',Mstr); IF tw = 0 THEN tw := LENGTH( global_str( istr+str(jx))); END; Label_Str := Parse_Str('/T=',MStr); LL := svl( Label_Str ); xx := x1 + tc + ll; tt := parse_int('/TP=', mstr ); IF (tt = 3) OR (TT > 4) THEN ++xx; END; IF ((tl + y1) = Mou_Last_Y) AND (Mou_Last_X >= (xx)) AND (Mou_Last_X <= (xx + tw)) THEN IF c_parm <> jx THEN fjx := jx; call UnMark_Item; c_parm := fjx; Call Mark_Item; END; jx := field_count; mouse_result := true; end; ++jx; end; ret; EXIT: If X1 <> 0 THEN Kill_Box; END; EXIT2: Pop_Labels; GotoXY(Old_c,Old_l); {free up as much garbage as possible} if parse_int('/NC=', mparm_str) = 0 then Tc := 0; While (Tc < field_count) Do ++Tc; Set_Global_Str(iparm + Str(TC),''); END; Set_Global_Str(prefix + 'IHELP1',''); Set_Global_Str(prefix + 'IHELP2',''); Set_Global_Str(prefix + 'IHELP3',''); end; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); RM('CheckEvents /M=3/G=' + event_str + '/#=' + str(event_count)); refresh := t_refresh; END_MACRO; $MACRO DVMENU FROM ALL; {****************************************************************************** MULTI-EDIT MACRO NAME: DVMENU (Dynamic Vertical Menu) DESCRIPTION: This is a general purpose vertical menu generator that creates a box just the right size to fit the menu, and returns both the number of the menu element that was picked, and the string of the menu element in Return_Int and Return_Str respectively. The menu is scrollable if the menu is larger than will fit on the screen. You must initialize global variables with the menu strings. If one global will not hold the entire menu, use as many as you wish. The format for the global variable names is: Name1 Name2 Name3 etc. Where name is any name you wish, which is supplied to the program via a parameter called Menu_Prefix. The amount of globals is supplied via the /#= parameter. Although, for the sake of compatibility, the format of each menu string is identical to that expected for V_MENU and H_MENU, the 2 character help strings are not actually used. Instead you must provide the 2 character help string via the /H= parameter. This menu does not have the "Press the highlighted character to select" feature, however, there is an incremental search feature which, if an alphanumeric character is pressed, it will invoke and all subsequent characters will be appended to the search expression. Pressing the backspace will right-truncate the search expression. Parameters expected: /P= Menu_Prefix string the "prefix" of the 3 global variables defining the 3 menu strings for the vertical menu /H= Help_Str string the 2 character help string for prompts /T= Title string the title of the box /S= Choice_Str string the string of the defualt selection /SN= integer instead of using /S= for default, use this. /X= Menu_X integer the upper left X coordinate of the box /Y= Menu_Y integer the upper left Y coordinate of the box /B= Make_Box integer 1=create a box 0=don't /K= Box_Kill integer 1=kill the box before exiting 0=don't /O= Menu_Modify integer 1=display modify choice 0=don't /C= Menu_Create integer 1=display create choice 0=don't /CT= Create_Title string If present, will replace the defalult title on the create box prompt. /D= Menu_Delete integer 1=display delete choice 0=don't /MH= Menu Height override /#= Menu_Index integer The number of globals used for menu /W= Max_Width integer The maximum allowable string length for when a user adds a menu item. /F1 - 10= Support for function key labels 1 - 10 /PRE= char This one was created primarily for the macro EXTENS. If present, and the user creates a new menu item, the item he enters MUST be preceeded by the defined character. In EXTENS, the extension menu items must be preceeded by a period(.). /U= integer 1=Force upper case on menu item additions. 0= Normal. /EC= integer 1=exit this macro upon addition of a new menu item. Primarily intended for situations where processing other than merely adding to the menu it'self is neccesary. /ED= integer 1=exit this macro upon deletion of a menu item. Primarily intended for situations where processing other than merely deleting from the menu it'self is neccesary. /ND= string A series of strings, separated by spaces, that tell DVMENU to disallow deletion of the contained strings. Only valid and neccesary if /D=1 /NM= string A series of strings, separated by spaces, that tell DVMENU to disallow modification of the contained strings. Only valid and neccesary if /O=1 /NR= integer No rebuild. If 1, then DVMENU will not alter the global menu strings in the event of a create or delete. /I= string A string expression to preceed the incremental search string. Under normal circumstances, it should be % to match the beginning of line. /WIN=nn The window # to use if we do NOT want a window created. /WW=nn window width Desired width only active when using /WIN. If not present, /W will be used instead. /OCPG= One Choice Per Global - When adding or deleting from a menu, there will be only one menu choice per global string and the help index will not be appended to each choice. /ROW= Init_Row This one is currently only used for KEYMAP. Used to pass a row number to highlite on recursive calls to DVMENU so that the menu doesn't shift positions. Returns Return_Int 0 = Escape was pressed. 1 = Return was pressed. 2 = A menu item was added(only if /EC=1). 3 = A menu item was deleted(only if /ED=1). 4 = Modify item was selected. 5 = Add item was selected. Return_Str If Return_Int = 0, = /S=. If Return_Int = 1, = The selected item. If Return_Int = 2, = The added item. If Return_Int = 3, = The deleted item. If Return_Int = 4, = The selected item. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str(Menu_Prefix[19],Choice_Str[77],Temp_String,Help_Str[40],Create_Title[77], Event_Str[20]); Def_Int(Temp_Integer,jx,jy,Make_Box,Menu_X,Menu_Y,Choice_Int,Temp_Choice, Active_Window,Menu_Window,Temp_Refresh,Temp_Ignore_Case,Temp_Messages, Temp_Reg_Exp_Stat,Temp_Explosions,Menu_Index,Menu_Mode,Menu_Width, Skip_Count,Temp_Insert_Mode,Menu_Changed,skip_win,temp_mode, Extra_Index,OCPG,No_Choices,Ev_Count); Def_Char(Temp_Char); Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); Temp_Refresh := Refresh; Refresh := False; Push_Labels; Menu_Changed := False; No_Choices := False; Temp_Messages := Messages; Temp_Insert_Mode := Insert_Mode; Insert_Mode := True; Temp_Explosions := Explosions; Explosions := False; Menu_Prefix := Parse_Str('/P=',MParm_Str); Help_Str := Parse_Str('/H=',MParm_Str); Choice_Str := Parse_Str('/S=',MParm_Str); OCPG := Parse_Int('/OCPG=',MParm_Str); Menu_X := Parse_Int('/X=',MParm_Str); Menu_Y := Parse_Int('/Y=',MParm_Str); menu_width := Parse_Int('/WW=',MParm_Str); Make_Box := Parse_Int('/B=',MParm_Str); Active_Window := Cur_Window; Menu_Window := 0; temp_mode := mode; mode := edit; Temp_Ignore_Case := Ignore_Case; Ignore_Case := True; Temp_Reg_Exp_Stat := Reg_Exp_Stat; Reg_Exp_Stat := True; Menu_Index := Parse_Int('/#=',MParm_Str) + 1; IF (Menu_Index < 1) THEN Menu_Index := 4; END; Menu_Mode := 0; temp_integer := 0; while temp_integer < 10 do ++temp_integer; temp_string := parse_str('/F' + str(temp_integer) + '=', mparm_str); jx := temp_integer; if jx < 11 then if (jx = 1) and (temp_string = '') then temp_string := 'Help'; end; if temp_string <> '' then flabel( temp_string,jx, -1); end; end; end; {if a window is already defined then skip the build process} skip_win := false; if parse_int( '/WIN=', mparm_str) <> 0 then skip_win := true; menu_window := parse_int( '/WIN=', mparm_str); switch_window( menu_window ); eof; if c_col <> 1 then down; end; else Switch_Window(Window_Count); Create_Window; end; window_attr := window_attr or $86; Menu_Window := Cur_Window; Extra_Index := 0; Temp_Integer := 0; {create the additional menu choices as outlined in the passed parameter string} IF (Parse_Int('/C=',MParm_Str)) THEN ++ Extra_Index; Temp_Integer := 15; END; IF (Parse_Int('/D=',MParm_Str)) THEN ++ Extra_Index; Temp_Integer := 15; END; IF (Parse_Int('/O=',MParm_Str)) THEN ++ Extra_Index; IF (Temp_Integer < 9) THEN Temp_Integer := 9; END; END; IF (Extra_Index) THEN ++Extra_Index; END; {set the minmum width according to the presence or absence of the "extras"} if (menu_width = 0) then IF (Extra_Index) THEN Menu_Width := Temp_Integer; ELSE Menu_Width := 7; END; end; {If the width of the title is more than the current width of the menu, make it bigger so it will fit} IF (Length(Parse_Str('/T=',MParm_Str)) > Menu_Width) THEN Menu_Width := Length(Parse_Str('/T=',MParm_Str)); END; Temp_Integer := 1; Choice_Int := 1; Temp_Choice := Parse_Int('/SN=',MParm_Str); if skip_win then if (temp_choice = 0) and (choice_str <> '') then reg_exp_stat := false; tof; if search_fwd( choice_str , 0 ) then temp_choice := c_line; end; reg_exp_stat := true; eof; end; goto skip_build; end; {Determing how long the menu will be to determine box size} While (Temp_Integer < Menu_Index) Do Jx := 1; Temp_String := Global_Str(Menu_Prefix + Str(Temp_Integer)); BUILD_MENU: Jy := XPos('(',Temp_String,Jx); IF (Jy = 0) THEN Jy := Svl(Temp_String) + 1; END; If (Jy) Then DOUBLE_PARENS: IF (XPos('((',Temp_String,Jy) = Jy) THEN Temp_String := Str_Del(Temp_String,Jy,1); Jy := XPos('(',Temp_String,JY + 1); IF (Jy = 0) THEN Jy := Svl(Temp_String) + 1; END; Goto DOUBLE_PARENS; END; Put_Line(Copy(Temp_String,Jx,Jy - Jx)); IF (Get_Line = Choice_Str) THEN Temp_Choice := C_Line; END; IF (Get_Line <> '') THEN Down; END; IF (((Jy - Jx) > Menu_Width) and (Parse_Int('/WW=',MParm_Str) = 0)) THEN Menu_Width := Jy - Jx; END; {Move pointer beyond closing paren} Jx := XPos(')',Temp_String,Jy + 1); IF (Jx < SVL(Temp_String) and (Jx > 0)) THEN ++Jx Goto BUILD_MENU; END; End; ++Temp_Integer; End; skip_build: if (menu_width + menu_x) > (screen_width - 3) then menu_width := (screen_width - 3 - menu_x); end; eof; skiploop: eol; if (c_col = 1) and (c_line > 1) then up; goto skiploop; end; File_Changed := False; REDO_MENU: Tof; IF (At_Eof) THEN {If this menu is empty, alert the user.} No_Choices := True; IF (Menu_Width < 23) THEN Menu_Width := 23; END; Put_Line('No choices in this menu'); END; CHOICE_LOOP: Ev_Count := 2; event_str := '@EV' + Str(Global_Int( 'MENU_LEVEL' )) + '#'; Set_Global_Str(Event_Str + '1', '/T=Select/K1=13/K2=28/R=1/LL=1'); Set_Global_Str(Event_Str + '2', '/T=Cancel/K1=27/K2=1/R=0/LL=1'); IF (Extra_Index > 1) THEN ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/T=Create/K1=0/K2=82/R=2'); END; IF (Extra_Index > 2) THEN ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/T=Delete/K1=0/K2=83/R=3'); END; IF (Extra_Index > 3) THEN ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/T=Modify/K1=0/K2=61/R=4'); END; ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/K1=0/K2=75/R=100/ND=1'); ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/K1=0/K2=77/R=100/ND=1'); IF temp_choice = 0 THEN temp_choice := 1; END; RM('WMENU /DBL=1/X=' + Str(Menu_X) + '/Y=' + Str(Menu_Y) + '/S=' + Str(Temp_Choice) + '/MH=' + parse_str('/MH=',mparm_str) + '/NK=1/OR=5/EV=' + event_str + '/EV#=' + Str(Ev_Count) + '/T=' + Parse_Str('/T=',MParm_Str) + '/W=' + Str(Menu_Width) + '/SP=' + Parse_Str('/I=',MParm_Str) + '/NB=' + Str(Not(Make_Box))); { Make_Message('[' + Str(Return_Int) + ']'); Read_Key; } if ((Return_Int = 0) or (Return_Int = 1)) then Set_Global_Int('DVINT',C_Line); IF (Return_Int = 1) THEN Return_Str := Get_Line; END; Refresh := True; IF ((Return_Int = 0) and (Menu_Mode = 0)) THEN Return_Str := Choice_Str; Return_Int := 0; Goto SPECIAL_EXIT; END; IF (Menu_Mode = 0) THEN Goto CHOICE_MADE; END; Menu_Mode := 0; Goto CHOICE_MADE; end; IF (Return_Int = 2) THEN Call ADD_TO_MENU; IF (Return_Int) THEN Menu_Mode := 1; IF (Parse_Int('/EC=',MParm_Str) = 1) THEN Goto CHOICE_MADE; END; refresh := false; Kill_Box; Goto REDO_MENU; ELSE Goto CHOICE_LOOP; END; END; IF (Return_Int = 3) THEN Menu_Mode := 2; Refresh := False; Call CHECK_DELETE; IF (Return_Int) THEN Goto SKIP_DELETE; END; RM('VERIFY /T=Are you sure you want to delete this menu item?/C=1/L=' + Str(Menu_Y + Extra_Index + 1)); IF (Return_Int = 0) THEN SKIP_DELETE: Menu_Mode := 0; Goto CHOICE_LOOP; END; Return_Str := Get_Line; Set_Global_Int('DVINT',C_Line); Del_Line; Up; Menu_Changed := True; IF (Parse_Int('/ED=',MParm_Str) = 1) THEN Goto CHOICE_DELETED; END; {If we deleted the default menu choice, we must change it to something else just in case the user presses <ESC>. The obvious choice is item above} IF (Return_Str = Choice_Str) THEN Choice_Str := Get_Line; END; Kill_Box; Goto REDO_MENU; END; IF (Return_Int = 4) THEN Call CHECK_MODIFY; IF (Return_Int) THEN Goto CHOICE_LOOP; END; Menu_Mode := 3; Return_Str := Get_Line; Goto CHOICE_MADE; END; GOTO CHOICE_LOOP; CHOICE_MADE: {Put the menu choice integer into a global, so the calling macro can retrieve it} Set_Global_Int('DVINT',C_Line); CHOICE_DELETED: Refresh := False; {This is a very special case for the macro EXTENS} Jx := C_Line; Jy := C_Row; IF (C_Line > 1) THEN Up; Call SKIP_SEEK_UP; Goto GET_BACK; ELSE GET_BACK: Set_Global_Str('DVSTR',Get_Line); WHILE (C_Row < Jy) DO Down; END; Goto_Line(Jx); END; Return_Int := Menu_Mode + 1; SPECIAL_EXIT: ERROR_EXIT: Refresh := False; if skip_win = false then IF ((Parse_Int('/NR=',MParm_Str) = 0) and (Menu_Changed = True)) THEN Call REBUILD_MENU; END; Delete_Window; end; Switch_Window(Active_Window); GOTO EXIT; {********************************** SUBROUTINES ******************************} SKIP_SEEK_UP: Skip_Count := 1; IF (XPos('|254',Get_Line,1) = Length(Get_Line)) THEN IF (C_Line > 1) THEN ++Skip_Count; Up; ELSE WHILE (Skip_Count) DO Down; --Skip_Count; END; Ret; END; Goto SKIP_SEEK_UP; END; RET; ADD_TO_MENU: {Querybox is a general purpose "boxed" prompt.} Create_Title := Parse_Str('/CT=',MParm_Str); IF (Create_Title = '') THEN Create_Title := 'CREATE NEW MENU ITEM'; END; Return_Str := ''; RM('QUERYBOX /H=IN/C=' + Str(Menu_X) + '/L=' + Str(Menu_Y + Extra_Index + 1) + '/W=' + str( Parse_int('/W=',MParm_Str) - length(Parse_Str('/PRE=',MParm_Str))) + '/T=' + Create_Title + '/P=' + Parse_Str('/PRE=',MParm_Str)); IF (Return_Int = True) and (Return_Str <> '') THEN return_str := Parse_Str('/PRE=',MParm_Str) + return_str; IF (Parse_Int('/U=',MParm_Str) = 1) THEN Return_Str := Caps(Return_Str); END; {First, see if the new addition already exists, if so, prevent redundant entries by assuming the user merely wants to select this menu choice} Temp_Integer := C_Line; Refresh := False; Tof; IF (Search_Fwd('%' + Return_Str + '$',0)) THEN Return_Int := 0; RET; ELSE Goto_Line(Temp_Integer); END; IF (No_Choices = False) THEN Eol; Cr; Goto_Col(1); END; Put_Line(Return_Str); Menu_Changed := True; No_Choices := False; ELSE Return_Int := 0; END; RET; REBUILD_MENU: Temp_String := Return_Str; Refresh := False; Tof; Menu_Index := 1; Set_Global_Str(Menu_Prefix + '1',''); WHILE (Not(At_Eof)) DO RM('DBLPAREN ' + Get_Line); IF (OCPG) THEN Set_Global_Str(Menu_Prefix + Str(Menu_Index),Return_Str); ++Menu_Index; ELSE IF ((Length(Global_Str(Menu_Prefix + Str(Menu_Index))) + Length(Return_Str)) > 196) THEN ++ Menu_Index; Set_Global_Str(Menu_Prefix + Str(Menu_Index),''); END; Set_Global_Str(Menu_Prefix + Str(Menu_Index),Global_Str(Menu_Prefix + Str(Menu_Index)) + Return_Str + '(' + Help_Str + ')'); END; Down; END; Temp_Integer := Menu_Index; {If there are globals beyond the current index, deallocate them} WHILE (Temp_Integer < Parse_Int('/#=',MParm_Str)) DO ++Temp_Integer; Set_Global_Str(Menu_Prefix + Str(Temp_Integer),''); END; ++Menu_Index; Return_Str := Temp_String; RET; CHECK_DELETE: Return_Int := 0; IF (Parse_Str('/ND=',MParm_Str) <> '') THEN IF (XPos( ' ' + Get_Line + ' ',' ' + Parse_Str('/ND=',MParm_Str) + ' ',1)) THEN RM('MEERROR^Beeps /C=1'); Return_Int := 1; END; END; RET; CHECK_MODIFY: Return_Int := 0; IF (Parse_Str('/NM=',MParm_Str) <> '') THEN IF (XPos(Get_Line,Parse_Str('/NM=',MParm_Str),1)) THEN RM('MEERROR^Beeps /C=1'); Return_Int := 1; END; END; RET; {*****************************************************************************} EXIT: If ((Make_Box > 0) and (Parse_Int('/K=',MParm_Str) > 0)) Then Kill_Box; End; mode := temp_mode; Refresh := Temp_Refresh; Ignore_Case := Temp_Ignore_Case; Reg_Exp_Stat := Temp_Reg_Exp_Stat; Explosions := Temp_Explosions; Insert_Mode := Temp_Insert_Mode; Messages := Temp_Messages; pop_labels; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); { RM('MEERROR^Beeps /C=1'); Make_Message('[' + Str(Global_Int('DVINT')) + '][' + Return_Str + ']'); Read_Key; } END_MACRO; $MACRO SPECCHAR FROM ALL; {****************************************************************************** MULTI-EDIT MACRO NAME: SPECCHAR DESCRIPTION: This is a general purpose string manipulator that changes certain "unprintable" characters to the Multi-Edit macro language ASCII Character representation for the purpose of displaying them in prompts. The string is passed to this macro via the standard ME parameter passing convention, and the result is returned in Return_Str (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str(TStr, TChars[40]); Def_Char(TChar); Def_Int(JX,Jy); Tchars := '|26|0|9|255|13|27'; TStr := MParm_Str; Jy := 1; While (Jy < 7) Do jx := 1; While (Jx > 0) Do jx := XPOS(Copy(TChars,Jy,1),TStr,jx); IF jx <> 0 THEN TStr := Str_Del(TStr,jx,1); TStr := Str_Ins('||' + Str(Ascii(Copy(TChars,Jy,1))),TStr,jx); jx := jx + 3 + (Jy = 4) - (Jy = 2); {Special instance of numeric characters following altered string} SPECIAL_CASE: IF (Length(Tstr) >= Jx) THEN TChar := Copy(TStr,Jx,1); IF (XPos(TChar,'0123456789',1)) THEN TStr := Str_Del(TStr,jx,1); TStr := Str_Ins('||' + Str(Ascii(Tchar)),TStr,Jx); Jx := Jx + 3; Goto SPECIAL_CASE; END; END; END; End; ++Jy; End; Return_Str := Tstr; END_MACRO; $MACRO VALCHAR FROM ALL; {****************************************************************************** MULTI-EDIT MACRO NAME: VALCHAR DESCRIPTION: This is a general purpose string manipulator that changes any occurance of the '|' character, indicating the presence of a numeric representation of an ASCII character and converting it to that character. The string is passed to this macro via the standard ME parameter passing convention, and the result is returned in Return_Str (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str(Tstr,Tstr2[60]); Def_Int(JX,Jy); Def_Char( TChar ); TStr := MParm_Str; {Get bar characters} JX := 1; CHECKQ2: jx := XPOS('||',TStr,jx); IF jx <> 0 THEN IF (JX < Length(TStr)) and (XPOS(Copy(TStr,jx+1,1),'0123456789',1) <> 0) THEN jy := jx + 1; TStr2 := ''; Next_Char: TChar := Copy(Tstr,jy,1); If XPOS(TChar,'0123456789',1) THEN TStr2 := TStr2 + TChar; ++jy; Goto Next_Char; END; If VAL(jy,Tstr2) = 0 THEN TStr := Str_Del(TStr,jx,Length(Tstr2) + 1); TStr := Str_Ins(Char(Jy),TStr,jx); END; ++jx; ELSE jx := jx + 2; END; goto CHECKQ2; END; Return_Str := TStr; END_MACRO; $MACRO STRSRC FROM ALL; {****************************************************************************** MULTI-EDIT MACRO NAME: STRSRC DESCRIPTION: This is a general purpose string manipulator that changes any occurance of a "|" or a "'" character, which was entered by a user in a prompt, so that the part of the setup that saves the settings by generating macro source code will be able to generate string literals properly. The string is passed to this macro via the standard ME parameter passing convention, and the result is returned in Return_Str (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str(Tstr); Def_Int(JX,Jy); TStr := MParm_Str; jx := 1; CHECKQ: jx := XPOS('''',TStr,jx); IF jx <> 0 THEN TStr := Str_Ins('''',TStr,jx); jx := jx + 2; goto CHECKQ; END; {Create double bars} jx := 1; CHECKQ2: jx := XPOS('||',TStr,jx); IF jx <> 0 THEN IF (JX = Length(TStr)) or (XPOS(Copy(TStr,jx+1,1),'0123456789|',1) = 0) THEN TStr := Str_Ins('||',TStr,jx); END; jx := jx + 2; goto CHECKQ2; END; Return_Str := Tstr; RM('SPECCHAR '+ Return_Str); END_MACRO; $MACRO DBLPAREN FROM ALL; {****************************************************************************** MULTI-EDIT MACRO NAME: DBLPAREN DESCRIPTION: This is a general purpose string manipulator that changes any occurance of a "(" to "((", which was entered by a user in a prompt, so that it may be used to create a menu without screwing up. The string is passed to this macro via the standard ME parameter passing convention, and the result is returned in Return_Str (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str(Tstr); Def_Int(JX); TStr := MParm_Str; jx := 1; CHECKQ: jx := XPOS('(',TStr,jx); IF jx <> 0 THEN TStr := Str_Ins('(',TStr,jx); jx := jx + 2; goto CHECKQ; END; Return_Str := Tstr; END_MACRO; $MACRO CHNGPARM; {****************************************************************************** MULTI-EDIT MACRO DESCRIPTION: This macro is designed to change any "/X=" type parameter in any global string. It should work for any parameter delimiters. If the parameter does not exist in the string, it will add it to the end of the string. /G= The global string name Return_Str The parameter syntax(Because this is a "/x=" type of parameter, it cannot be a part of MParm_Str(it would be impossible to parse out unless we used different parameter delimiters, which would be inconsistent) /P= The new parameter Example: Set_Global_Str('TEST','/X=1/Y=2/Z=3'); Return_Str := '/Y='; RM('CHNGPARM /G=TEST/P=10'); Global_Str('TEST') will now be: '/X=1/Y=10/Z=3' As this macro is not particularly efficient, it should only be used in cases of extremely long strings of parameters where only one parameter is being changed and complete rebuilding of the string would take longer. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Return_Int := XPos(Return_Str,Global_Str(Parse_Str('/G=',MParm_Str)),1); IF (Return_Int = 0) THEN Return_Int := Length(Global_Str(Parse_Str('/G=',MParm_Str))) + 1; Set_Global_Str(Parse_Str('/G=',MParm_Str), Global_Str(Parse_Str('/G=',MParm_Str)) + Return_Str); END; Set_Global_Str(Parse_Str('/G=',MParm_Str),Copy(Global_Str(Parse_Str('/G=', MParm_Str)),1,Length(Return_Str) + Return_Int - 1) + Parse_Str('/P=', MParm_Str) + Copy(Global_Str(Parse_Str('/G=',MParm_Str)),Return_Int + Length(Parse_Str(Return_Str,Global_Str(Parse_Str('/G=',MParm_Str)))) + Length(Return_Str),254)); END_MACRO; $MACRO USERSTR FROM ALL; {****************************************************************************** MULTI-EDIT MACRO NAME: USERSTR DESCRIPTION: This macro creates a scrollable prompt. Functionally equivalent to the macro function String_In, except allows scrolling. Allows user inputs of up to 254 characters. System variables and parameters: Return_Str - Returns user input if enter is pressed, or default if ESC is pressed. Return_Int - Returns 1 if enter is pressed, 0 if ESC is pressed, -1 if a enabled function key was press. Names of parameters are similar to arguments for String_In. /P= Prompt string. If omitted, same as above. /F1 - F12 =str Enables F2. Assigns str as the label; Now works for F1 - F12 /L= Length. Maximum length of input. /X= Col. Left Column of prompt. /Y= Row. Row of Prompt. /H= Help string. 2 character index for help system. /W= Input Width. Width of visable portion of input. /B= 1 = Create Box; /BL= Box Label; /NK= 1 = don't kill box when done. /A= 1 = Exit on use of up or down arrow keys with return_int = 1 and push the key back on the keyboard stack. /HISTORY= Name of history list globals /EV= Name of mouse event globals /EV#= Number of mouse event globals (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Int(Active_Window,Temp_Refresh,Input_Width,Len,Col,Row, t_mode, t_display_tabs, Temp_Message_Row, t_undo_stat, first_time, t_trunc,t_tab_expand, history_stat, jx, Temp_Integer, Box, box_width, ps_width, T_EOL_CHAR, arrow_stat, texp, event_count,Center_Offset); Def_Str( fstr[100], t_page_str[20], history_str[20], event_str[20] ); {We are using a window to create the input field, therefore, we have to turn all status lines off in order to take advantage of the windows natural refreshing, yet not screw up the display} Temp_Refresh := Refresh; Refresh := False; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); texp := explosions; explosions := false; t_mode := mode; t_tab_expand := tab_expand; T_trunc := truncate_spaces; T_Undo_Stat := Undo_Stat; t_eol_char := eol_char; t_page_str := page_str; t_display_tabs := display_tabs; eol_char := 177; Temp_Message_Row := Message_Row; Push_Labels; IF (Mparm_Str = '') THEN RM('MEERROR^Beeps /C=1'); Goto EXIT; END; event_str := '@EV' + Str(Global_Int( 'MENU_LEVEL' )) + '#'; event_count := 0; display_tabs := true; tab_expand := true; truncate_spaces := false; Undo_Stat := false; first_time := true; page_str := ''; temp_integer := 0; history_stat := 0; history_str := parse_str('/HISTORY=', mparm_str); if history_str <> '' then history_stat := 1; flabel( 'List', 4, -1 ); end; flabel( 'Edit', 3, -1 ); while temp_integer < 10 do ++temp_integer; fstr := parse_str('/F' + str(temp_integer) + '=', mparm_str); jx := temp_integer; if jx < 11 then if (jx = 1) and (fstr = '') then fstr := 'Help'; end; if fstr <> '' then flabel( fstr,jx, -1); end; end; end; Message_Row := 0; Col := Parse_Int('/X=',MParm_Str){ + Length(Parse_Str('/P=',MParm_Str))}; if col <= 0 then col := 2; end; Row := Parse_Int('/Y=',MParm_Str); if row <= 0 then row := 3; end; Len := Parse_Int('/L=',MParm_Str); Box := (Parse_Int('/B=',MParm_Str) <> 0); arrow_stat := parse_int( '/A=', mparm_str ); Input_Width := Parse_Int('/W=',MParm_Str); IF (row + (box * 3)) >= screen_length THEN row := screen_length - (box * 3) - 1; END; if len = 0 then len := input_width; end; IF (Input_Width > Len) THEN Input_Width := Len; END; ps_width := Length(Parse_Str('/P=',MParm_Str)); {If the Left X coordinate is too far to the right to accommodate the prompt and data field, move it over to the left} if (col + ps_width + input_width) > screen_width then Col := (screen_width - ps_width - Input_Width - 2); end; IF (Col < 1) THEN Col := 1; END; {If it still won't fit, shorten the visable field width} if (col + ps_width + input_width) > screen_width then input_width := (screen_width - ps_width - col - 2); end; set_virtual_display; if box then box_width := ps_width + input_width + 3; if box_width < length(parse_str('/BL=',MParm_Str)) then box_width := length(parse_str('/BL=', mparm_str)); end; if box_width < 25 THEN box_width := 25; END; put_box(col, row, col + box_width, row + 3, 0, m_b_color, parse_str('/BL=', mparm_str), true); IF Parse_Int('/EV#=', mparm_str) = 0 THEN event_count := 2; temp_integer := 0; Set_Global_Str(event_str + '1', '/T=OK/KC=<ENTER>/W=9/K1=13/K2=28/R=1'); Set_Global_Str(event_str + '2', '/T=Cancel/KC=<ESC>/W=11/K1=27/K2=1/R=0'); END; end; IF Parse_Int('/EV#=', mparm_str) <> 0 THEN event_count := Parse_Int('/EV#=', mparm_str); event_str := Parse_Str('/EV=', mparm_str); END; RM('CheckEvents /M=4/G=' + event_str + '/#=' + str(event_count) + '/X=' + str(col) + '/Y=' + str(row + 2) + '/W=' + str( box_width - 1)); RM('CheckEvents /M=2/G=' + event_str + '/#=' + str(event_count)); Set_Global_Str('@UIDEFAULT@', return_str ); Active_Window := Window_Id; {Create the window for user input} switch_window(window_count); Create_Window; t_color := m_h_color; c_color := m_h_color; eof_color := m_h_color and $F0; Window_Attr := $86; { This is some stuff I'm playing with to try create automatic centering of the prompt inside the box. Write('[' + Str(input_width) + '][' + Str(Box_width) + ']',2,2,0,M_T_Color); Read_Key; Center_Offset := 0; IF (Box) THEN IF (Parse_Int('',)) THEN END; IF (Box_Width > (Input_Width + 3)) THEN Center_Offset := (Box_Width - (Input_Width + 3)) / 2; END; END; Size_Window(Col - 1 + ps_width + box + Center_Offset,Row - 1 + box,Col + ps_width + Input_Width + Box + Center_Offset,Row + 1 + box); } Size_Window(Col - 1 + ps_width + box,Row - 1 + box,Col + ps_width + Input_Width + Box,Row + 1 + box); Put_Line( return_str ); mode := edit; Refresh := True; Redraw; IF (Parse_Str ('/P=',MParm_Str) <> '') THEN Write(Parse_Str('/P=',MParm_Str),Col + box, Row + box, 0,m_t_color); END; update_virtual_display; reset_virtual_display; Goto Read_Key_Loop2; READ_KEY_LOOP: first_time := false; READ_KEY_LOOP2: Read_Key; jx := INQ_KEY( key1, key2, 5, fstr ); if jx = 1 then RM(fstr); goto read_key_loop2; end; {We will allow entry of the escape character via ALT keypad which returns key2 as 0, but catch pressing the escape key as a user abort} IF ((Key1 = 13) and (Key2 <> 0) and (key2 <> 56)) then {13/0 on XT for ALT13} CR_EXIT: {13/56 on AT for ALT13} if history_stat then call add_to_history; end; Return_Int := 1; Goto EXIT; end; IF ((Key1 = 27) and (Key2 <> 0) and (key2 <> 56)) THEN ESC_EXIT: Return_Int := 0; Goto EXIT; END; If (Key1 = 8) and (key2 = 14 ) Then if first_time then put_line(''); redraw; else IF ((C_Col = Len) and (Not(At_Eol))) THEN Del_Char; ELSE Back_Space; END; end; Goto READ_KEY_LOOP; End; If (Key1 = 0) Then IF (key2 = 250) THEN {Mouse event} RM('MOUSE^MouseInWindow'); IF RETURN_INT = 0 THEN IF (Mou_Last_Y = Fkey_Row) THEN RM( 'MOUSE^MouseFkey' ); ELSE RM('CheckEvents /M=1/G=' + event_str + '/#=' + str(event_count)); IF RETURN_INT <> 0 THEN Return_Int := Parse_Int('/R=', return_str); IF (Return_Int = 1) THEN {We jump to CR_EXIT so the history list is added to} Goto CR_EXIT; END; Goto EXIT; ELSE IF ((Mou_Last_X < col) OR (Mou_Last_X > (col + box_width)) OR (Mou_Last_Y < row) OR (Mou_Last_Y > (row + 3))) THEN return_int := 0; Push_Key(0,250); Goto EXIT; ELSIF ((return_int = 0) AND NOT(BOX)) THEN Push_Key( 0,250 ); Return_Int := 1; Goto EXIT; END; END; END; END; END; IF (Key2 = 244) THEN Goto CR_EXIT; END; IF (Key2 = 245) THEN Goto ESC_EXIT; END; IF (Key2 = 3) THEN {This is <CTRL@> which is a synonym for the null character. This, unlike String_In, will allow entry of null chars via this method} Goto INSERT_NULL; END; IF (Key2 = 75) Then Left; END; IF (Key2 = 77) Then IF (C_Col < Len) THEN Right; END; END; IF (Key2 = 71) Then Home; END; IF (Key2 = 79) Then {END key} IF (Length(Get_Line) < Len) THEN eol; ELSE Goto_Col(Len); Redraw; END; END; IF (Key2 = 82) Then Insert_Mode := Not(Insert_Mode); END; IF NOT(At_EOL) and (Key2 = 83) Then {Del key} Del_Char; END; IF (key2 = 116) and (c_col < len) and NOT(at_eol) then word_right; END; IF (key2 = 115) and (c_col > 1) then word_left; END; IF ((key2 = 80) or (key2 = 72)) and (arrow_stat) then return_int := - 2; return_str := get_line; goto exit; END; IF (key2 >= 59) and (key2 <= 68) then if parse_str('/F' + str(key2 - 58) + '=', mparm_str) <> '' then freturn: return_int := -1; return_str := get_line; goto exit; end; END; IF (key2 = 59) then help(parse_str('/H=', mparm_str)); END; IF (key2 = 62) and (history_stat) then call list_history; goto read_key_loop2; end; ELSE INSERT_NULL: IF (C_Col <= Len) THEN if first_time then put_line(''); redraw; end; IF (C_Col = Len) THEN Put_Line(Copy(Get_Line,1,Len - 1) + char(key1) ); Redraw; ELSE text( char(key1) ); put_line( copy(get_line,1, len) ); END; END; End; Goto READ_KEY_LOOP; list_history: eol_char := t_eol_char; RM('GlobalVarList /REV=1/G=' + history_str + '/X=' + str(col) + '/Y=' + str(row + 1) + '/S=1/T=HISTORY/H=XX/#=' + parse_str( '/#=' , global_str(history_str)) ); eol_char := 177; if return_int = 1 then put_line(return_str); end; redraw; ret; add_to_history: IF (History_Str = 'FILE_HISTORY') THEN return_str := caps(get_line); else return_str := Get_Line; end; IF return_str <> '' THEN jx := parse_int('/#=', global_str(history_str)); temp_integer := 0; while temp_integer < jx do ++temp_integer; if global_str( history_str + str(temp_integer) ) = return_str then return_int := temp_integer; RM('deleteitem /G=' + history_str + '/#=' + str(jx)); --jx; temp_integer := jx; end; end; if jx > 15 then return_int := 0; RM('deleteitem /G=' + history_str + '/#=' + str(jx)); else ++jx; end; set_global_str( history_str + str(jx), return_str); set_global_str( history_str, '/#=' + str(jx)); END; ret; EXIT: {Restore all altered system variables and clean up} IF return_int <> 0 THEN Return_Str := Get_Line; ELSE Return_Str := Global_Str('@UIDEFAULT@'); END; Set_Global_Str('@UIDEFAULT@',''); if box then if parse_int('/NK=', mparm_str) = 0 then kill_box; end; end; Refresh := False; page_str := t_page_str; mode := t_mode; eol_char := t_eol_char; truncate_spaces := t_trunc; tab_expand := t_tab_expand; display_tabs := t_display_tabs; Message_Row := Temp_Message_Row; Delete_Window; Switch_Win_Id(Active_Window); Undo_Stat := T_Undo_Stat; Pop_Labels; explosions := texp; RM('CheckEvents /M=3/G=' + event_str + '/#=' + str(event_count)); Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); Refresh := Temp_Refresh; END_MACRO; $MACRO GLOBALVARLIST; {****************************************************************************** MULTI-EDIT MACRO NAME: GLOBALVARLIST DESCRIPTION: Creates a menu of global string "array elements". This is assuming the use of globals as pseudo arrays by having the last part of the global name numeric characters and therefore can be referenced sequentially using a counter. Example: Global_Str('TEST1'); Global_Str('TEST2'); Global_Str('TEST3'); In the above example, "TEST" would be considered the base, and 1, 2, and 3 would be the value of the index to reference each element. PARAMETERS: /G= The base name of the globals /#= The amount of elements (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} def_int( old_win, jx, old_refresh, count, reverse ); def_str( gstr[20], event_str[20] ); old_win := window_id; old_refresh := refresh; refresh := FALSE; switch_window( window_count ); create_window; window_attr := $80; count := parse_int('/#=', mparm_str); gstr := parse_str('/G=',mparm_str); reverse := parse_int('/REV=', mparm_str); IF reverse THEN jx := count; ELSE jx := 1; END; WHILE c_line <= count DO put_line( global_str( gstr + str(jx) ) ); IF reverse THEN --jx; ELSE ++jx; END; down; END; tof; event_str := '@GLEV' + Str(Global_Int( 'MENU_LEVEL' )) + '#'; Set_Global_Str(Event_Str + '1', '/T=Select/K1=13/K2=28/R=1/LL=1'); Set_Global_Str(Event_Str + '2', '/T=Cancel/K1=27/K2=1/R=0/LL=1'); RM('WMENU /EV#=2/EV=' + event_str + mparm_str ); refresh := false; return_str := get_line; delete_window; switch_win_id( old_win ); refresh := old_refresh; END_MACRO; $MACRO DELETEITEM; {****************************************************************************** MULTI-EDIT MACRO NAME: DELETEITEM DESCRIPTION: Performs a "shuffle" of global variables used as arrays to fill in the gap caused by the deletion of a single element. PARAMETERS: /G= The name of the "base" of the global variable. /#= The total amount of array elements. /T= The type of global 0=string 1=integer. Return_Int the starting point to begin shuffling. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} def_int( jx, count, type ); def_str( gstr[20] ); gstr := parse_str('/G=', mparm_str); count := parse_int('/#=', mparm_str); type := parse_int('/T=', mparm_str); jx := return_int; while jx <= count do if type = 0 then set_global_str( gstr + str(jx), global_str( gstr + str(jx + 1))); else set_global_int( gstr + str(jx), global_int( gstr + str(jx + 1))); end; ++jx; end; return_int := count - 1; END_MACRO; $MACRO WMENU FROM ALL; {*******************************MULTI-EDIT MACRO****************************** Name: WMENU Description: Builds a scrollable menu out of the current window. Parameters: /T=n Menu title /X=n X coordinate /Y=n Y coordinate /W=n The width override /MH= Height override /S=n Starting line number /A=n 1 = Enable use of right and left error keys. /OR=n Starting (old) row number /SP=str Search prefix /SM=n Search_Mode, if 1, search keys off of first char only and starts over with each keystroke. Primarily added for the switch window list. /NB=n 1 = no box /NK=n 1 = don't kill box on exit /H=str Help string /MARK=n Enable item marking. /NCR=n 1 = Disable CR from exiting. /DBL=n 1 = Require double click of mouse for selection. /CL#=n Number of columns to display. Default is 1. /CLW=n Column width. /CLC=n Current column #. /EV#=n Number of events. /EV=str Global string prefix for events The event globals are cleared upon exit. The event string format is as follows: /T=str title /K1=n Keycode 1 /K2=n Keycode 2 /R=n Result code /ND=1 No display /LL=1 Put event on bottom line of window NOTE: This macro changes the window attribute(WINDOW_ATTR) to make the window non-switchable via the normal user interface. Be aware of this should you wonder why your window "dissapeared". This is of no concern if you deal with the window only in your macro and get rid of it before exiting to edit mode. If you need to deal with the window in the edit mode, before exiting your macro do something like: Window_Attr := 0; Returns: Return_Int = 1 Item was selected. 0 ESC was pressed. All other values corrispond to event results. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} DEF_INT( x, y, menu_width, menu_length, menu_count, jx, jy, jz, {Temporary variables} event_count, event_lines, tbc, t_undo, cl, scroll_bar, t_ins, ll_col,ll2, u_col, marking_enabled, ll, mdl, t_mode, column_count, column_width, current_column, search_mode ); DEF_STR( event_str[20], tstr, tstr2, inc_search_str[20], inc_search_prefix[20] ); Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); Refresh := FALSE; t_mode := mode; mode := edit; Search_Mode := Parse_Int('/SM=',MParm_Str); Push_Labels; t_undo := undo_stat; undo_stat := false; t_ins := insert_mode; insert_mode := true; TOF; jx := Parse_Int('/W=', mparm_str); IF jx > 0 THEN menu_width := jx; eof; goto_col(1); IF not(at_eof) THEN menu_count := c_line; ELSE menu_count := c_line - 1; END; ELSE menu_width := 0; WHILE NOT(at_eof) DO tstr := Get_Line; jx := svl(tstr); IF str_char(tstr, jx) <> '|254' THEN IF jx > menu_width THEN menu_width := jx; END; END; DOWN; END; menu_count := c_line - 1; END; IF menu_count = 0 THEN Put_Line('No Items In Menu'); menu_width := Length( get_line ); END; marking_enabled := Parse_Int('/MARK=', mparm_str); x := Parse_Int('/X=', mparm_str); y := Parse_Int('/Y=', mparm_str); IF x <= 0 THEN x := 2; END; IF y <= 0 THEN y := 3; END; current_column := parse_int('/CLC=', mparm_str); IF current_column < 1 THEN current_column := 1; END; column_width := parse_int('/CLW=', mparm_str); column_count := parse_int('/CL#=', mparm_str); if column_count = 0 THEN column_count := 1; END; if menu_width < (column_count * column_width) THEN menu_width := column_count * column_width; end; {Now process keystroke/mouse event list} event_count := Parse_Int('/EV#=', MParm_Str); event_str := Parse_Str('/EV=', MParm_Str); IF (marking_enabled) AND (event_count > 0) THEN ++event_count; Set_Global_Str(Event_Str + str(event_count), '/T=Mark item/KC=<SpaceBar>/K1=32/K2=57/R=0/PK=1'); END; jx := 0; jy := 1000; ll_col := 0; event_lines := 0; mdl := 1; WHILE jx < event_count DO ++jx; tstr := Global_Str( event_str + str(jx)); IF parse_int('/ND=',tstr) = 0 THEN key1 := Parse_Int('/K1=', tstr); key2 := Parse_Int('/K2=', tstr); return_str := parse_str('/KC=', tstr); IF key1 = 0 THEN IF (key2 > 58) AND (key2 < 114) THEN flabel(Parse_Str('/FL=', tstr), key2 - 58, -1); END; END; IF return_str = '' THEN RM( 'SETUP^MAKEKEY /K1=' + Str(key1) + '/K2=' + Str(key2)); END; jz := Length(return_str) + Length( Parse_Str('/T=', tstr)) + 1; ll := Parse_Int('/LL=', tstr); IF ll = 1 THEN tstr := tstr + '/C=' + str( ll_col ); ll_col := ll_col + jz + 1; IF (menu_width < (ll_col - 2)) THEN menu_width := ll_col - 3; END; ELSIF ll = 2 THEN tstr := tstr + '/C=' + str( mdl + 1 ); mdl := mdl + jz{ + 1}; ELSE IF (menu_width - jy) < jz THEN IF (event_lines > 0) THEN set_global_int('@EVL#' + str( event_lines ), jy - 3); END; jy := 0; ++event_lines; END; IF (menu_width < (jy + jz)) THEN menu_width := jy + jz; END; tstr := tstr + '/EL=' + str( event_lines ) + '/C=' + str( jy ); jy := jy + jz + 1; END; tstr := tstr + '/KC=' + return_str + '/W=' + str(jz - 1); Set_Global_Str( event_str + str(jx), tstr ); END; END; IF (event_lines > 0) THEN set_global_int('@EVL#' + str( event_lines ), jy - 3); END; IF (menu_width > (Screen_Width - 3)) THEN menu_width := Screen_Width - 3; END; IF ((x + menu_width) > (Screen_Width - 2)) THEN x := Screen_Width - menu_width - 2; END; menu_length := menu_count; IF menu_count = 0 THEN menu_length := 1; END; jx := parse_int('/MH=', mparm_str); IF jx <> 0 THEN menu_length := jx; END; IF (y + menu_length + event_lines + 3 + (event_lines > 0)) > Screen_length THEN menu_length := ((screen_length - y) - event_lines - 3 - (event_lines > 0)); END; set_virtual_display; tbc := box_count; IF Parse_Int('/NB=',mparm_str) = 0 THEN Put_Box( x, y, x + menu_width + 3, y + event_lines + menu_length + 2 + (event_lines > 0), 0, m_b_color, Parse_Str('/T=', mparm_str), TRUE ); END; tof; t_color := m_t_color; b_color := m_b_color; s_color := m_s_color; h_color := m_h_color; c_color := m_t_color; eof_color := (m_t_color AND $F0) OR ((m_t_color AND $70) SHR 4); window_attr := $86; Size_Window( x , y + event_lines + (event_lines > 0), x + menu_width + 1, y + menu_length + event_lines + 1 + (event_lines > 0) ); IF event_count > 0 THEN IF event_lines > 0 THEN Draw_Char(196, x + 1, y + event_lines + 1, m_b_color, menu_width ); END; jx := 0; WHILE jx < event_lines DO ++jx; Set_Global_Int('@EVL#' + str(jx), x + 1 + ((menu_width / 2) - (Global_Int('@EVL#' + str(jx)) / 2))); END; IF ll_col > 0 THEN ll_col := ll_col - 3; END; ll_col := x + 1 + ((menu_width / 2) - (ll_col / 2)); ll2 := 0; u_col := 0; jx := 0; WHILE jx < event_count DO ++jx; tstr := Global_Str( event_str + str(jx)); IF (parse_int('/ND=', tstr) = 0) THEN ll := Parse_Int('/LL=', tstr); IF ll = 1 THEN jz := win_y2; jy := ll_col + ll2; ll_col := ll_col + parse_int('/W=', tstr) + 1; ELSIF ll = 2 THEN jz := (y + event_lines + 1) * (event_lines <> 0); jy := parse_int('/C=',tstr) + x; ELSE jz := Parse_Int('/EL=', tstr); jy := Global_Int('@EVL#' + str(jz)) + Parse_Int('/C=', tstr); jz := y + jz; END; Set_Global_Str( event_str + str(jx), tstr + '/X=' + str(jy) + '/Y=' + str(jz)); tstr2 := Parse_Str('/T=', tstr ); write( tstr2, jy, jz, 0, m_t_color ); jy := jy + svl(tstr2); tstr2 := Parse_Str('/KC=', tstr); write( tstr2, jy, jz, 0, m_s_color ); END; END; {RM('CheckEvents /M=2/G=' + event_str + '/#=' + str(event_count));} END; jy := parse_int('/S=', mparm_str ); IF jy = 0 THEN jy := 1; END; jx := parse_int('/OR=', mparm_str); IF jy > menu_count THEN jy := menu_count; END; IF (menu_count - (jy - jx)) < menu_length THEN jx := menu_length; END; WHILE (c_row < jx) AND (c_row < menu_length) DO DOWN; END; Goto_Line(jy); Scroll_Bar := (menu_length > 2) AND (menu_count > menu_length); IF scroll_bar = 0 THEN window_attr := window_attr OR $08; END; call skip_up; call skip_down; REFRESH := true; redraw; update_virtual_display; reset_virtual_display; inc_search_str := ''; inc_search_prefix := Parse_Str('/SP=',mparm_str); IF inc_search_prefix = '' THEN if marking_enabled then inc_search_prefix := '%?'; ELSE inc_search_prefix := '%'; END; END; If column_width = 0 THEN column_width := menu_width; end; main_loop: goto_col( (column_width * (current_column - 1)) + svl(inc_search_str) + 1 + marking_enabled); IF (at_eof) AND (current_column > 1) THEN goto go_left; END; call Hi_Line; read_key; draw_attr( x + 1, wherey, m_t_color, menu_width ); pass_key_through: IF key1 = 0 THEN inc_search_str := ''; IF (key2 = 59) THEN Help( Parse_Str('/H=', mparm_str ) ); Goto Main_Loop; ELSIF (key2 = 77) OR (key2 = 242) THEN ++current_column; IF (current_column > column_count) THEN current_column := 1; goto go_down; END; ELSIF (key2 = 75) OR (key2 = 243) THEN go_left: --current_column; IF (current_column < 1) THEN current_column := column_count; goto go_up; END; ELSIF (key2 = 80) OR (key2 = 241) THEN go_down: IF (c_line < menu_count) THEN DOWN; END; Call Skip_Down; Call Skip_Up; ELSIF (key2 = 72) OR (key2 = 240) THEN go_up: UP; Call Skip_Up; Call Skip_Down; ELSIF (key2 = 73) THEN Page_Up; Call Skip_Up; Call Skip_Down; ELSIF (key2 = 81) THEN IF (c_line + Menu_Length - C_row) > (menu_count - Menu_Length + 1) THEN goto goto_eof; END; Page_Down; Call Skip_Down; Call Skip_Up; ELSIF (key2 = 79) THEN goto_eof: refresh := false; EOF; goto_col(1); goto_line(c_line - 1); down; Call Skip_Up; Call Skip_Down; {WHILE c_line < menu_count DO DOWN; END;} current_column := column_count; refresh := true; redraw; ELSIF (key2 = 71) THEN goto_tof: current_column := 1; tof; Call Skip_Down; Call Skip_Up; ELSIF (key2 = 244) THEN Goto go_cr; ELSIF (key2 = 245) THEN Goto go_esc; ELSIF (key2 = 250) THEN {process mouse event} Goto do_mouse_event; ELSIF (key2 = 251) AND (marking_enabled) THEN Mark_Pos; RM('MOUSE^MouseInWindow'); IF at_eof THEN goto_mark; ELSE pop_mark; current_column := ((c_col - 1) / column_width) + 1; IF (return_int = 1) AND (xpos('|254', get_line,1) = 0) THEN call toggle_mark; END; end; ELSE call Process_Key_Event; IF jx <> 0 THEN goto exit; END; END; ELSE call process_key_event; IF jx <> 0 THEN goto exit; END; IF (key1 = 27) THEN go_esc: RETURN_INT := 0; Goto EXIT; ELSIF (key1 = 13) THEN go_cr: IF Parse_Int('/NCR=', mparm_str) = 0 THEN RETURN_INT := 1; Goto EXIT; END; ELSIF (key1 = 43) AND (marking_enabled) THEN do_mark: call toggle_mark; ELSIF( key1 = 08 ) THEN IF svl(inc_search_str) > 0 THEN refresh := false; TOF; inc_search_str := str_del( inc_search_str, svl(inc_search_str), 1 ); GOTO inc_search; END; ELSE inc_search: {tstr := inc_search_prefix + inc_search_str;} IF (Search_Mode) THEN inc_search_str := ''; if key1 <> 08 THEN tstr := CAPS(char(key1)); END; ELSE tstr := CAPS(inc_search_str); if key1 <> 08 THEN tstr := tstr + CAPS(char(key1)); END; END; refresh := false; mark_pos; IF (inc_search_str = '') THEN tof; END; jy := 0; search_loop: ++jy; IF (jy > column_count) THEN down; jy := 1; END; IF (c_line > menu_count) THEN goto search_exit; END; goto_col( (column_width * (jy - 1)) + 1 + marking_enabled ); IF caps(copy(get_line, c_col, svl(tstr))) = tstr THEN if key1 <> 08 THEN inc_search_str := inc_search_str + char(key1); END; pop_mark; refresh := true; current_column := jy; GOTO main_loop; END; goto search_loop; search_exit: goto_mark; refresh := true; END; END; GOTO main_loop; Toggle_Mark: insert_mode := false; goto_col( (column_width * (current_column - 1)) + 1 ); IF (cur_char = '|16') THEN text(' '); ELSE text('|16'); END; insert_mode := true; ret; {Returns with jx = 0, no action; jx > 0, goto exit} Process_Key_Event: jx := 0; RM('CheckEvents /G=' + event_str + '/#=' + str(event_count)); IF RETURN_INT <> 0 THEN JX := RETURN_INT; RETURN_INT := Parse_Int('/R=', Return_Str ); END; RET; Skip_Down: While (Xpos('|254',get_line,1) <> 0) AND (c_line < menu_count) DO DOWN; END; RET; Skip_UP: While (Xpos('|254',get_line,1) <> 0) AND (C_Line > 1) DO UP; END; RET; Hi_Line: draw_attr( x + 1 + ((current_column - 1) * column_width), wherey, m_h_color, column_width ); RET; Do_Mouse_Event: Mark_pos; jy := c_line; jx := current_column; RM('MOUSE^MouseInWindow'); IF (return_int = 1) AND (xpos('|254', get_line,1) = 0) AND (not(at_eof)) THEN pop_mark; current_column := ((c_col - 1) / column_width) + 1; goto_col( (column_width * (current_column - 1)) + 1 ); call Hi_Line; IF (Parse_Int('/DBL=', mparm_str) = 0) OR ((jy = c_line) AND (jx = current_column )) THEN return_int := 1; goto exit; END; ELSE goto_mark; IF (Mou_Last_Y = Fkey_Row) THEN RM( 'MOUSE^MouseFkey' ); GOTO Main_Loop; ELSIF (Mou_Last_X = Win_X2) THEN RM('MOUSE^HandleScrollBar /EOF=1/L=' + str(menu_count)); IF return_int = 1 THEN call skip_down; ELSIF return_int = 2 THEN call skip_up; END; ELSIF (Mou_Last_X > X) AND (Mou_Last_Y <= (X + Menu_Width)) THEN RM('CheckEvents /M=1/G=' + event_str + '/#=' + str(event_count)); IF RETURN_INT <> 0 THEN RETURN_INT := Parse_Int('/R=', Return_Str ); IF parse_int('/PK=', mparm_str) THEN key1 := parse_int('/K1=', mparm_str); key2 := parse_int('/K2=', mparm_str); goto pass_key_through; END; Goto Exit; END; END; END; IF (Mou_Last_X < X) OR (Mou_Last_X > (X + Menu_Width + 3)) OR (Mou_Last_Y < Y) OR (Mou_Last_Y > (WIN_Y2 + 1)) THEN Push_Key(0,250); RETURN_INT := 0; goto exit; END; goto main_loop; exit: refresh := false; call hi_line; if menu_count = 0 THEN IF ((return_int = 1) and (Parse_Int('/OEM=',MParm_Str) = 0)) THEN return_int := 0; END; del_line; END; IF Parse_Int('/NK=',mparm_str) = 0 THEN WHILE (box_count > tbc) DO kill_box; END; END; jx := 0; WHILE (jx < Event_Count) DO ++jx; Set_Global_Str( event_str + str(jx), ''); END; goto_col( (column_width * (current_column - 1)) + 1 ); Pop_Labels; undo_stat := t_undo; insert_mode := t_ins; mode := t_mode; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); END_MACRO; $MACRO CHECKEVENTS FROM ALL; {*******************************MULTI-EDIT MACRO****************************** Name: CheckEvents Description: Checks to see if a keyboard or mouse event occurred. Parameters: /G=str Global string prefix for event variables. /#=n Number of events /M=n 0 = Check keyboard 1 = Check mouse 2 = Redraw events /F=1 Update function key labels 3 = Clear events 4 = Center events on line. IF you use this DO NOT put /X= and /Y= coordinates in your event globals, as this function will take care of that for you. /X=n x coordinate /Y=n y coordinate /W=n width RETURNS: FOR /M=0 or 1 Return_Int = 0 IF NO EVENT FOUND ELSE Return_Int = EVENT #. RETURN_STR = The event string. FOR /M=4 Return_Int = Total width the events took up. Global String Format: /T=str title /X=n X coordinate /Y=n Y coordinate /W=n Total event width. /K1=n Keycode 1 /K2=n Keycode 2 /KC=str Keycode name /R=n Result code /ND=1 No display /FL= Function key label. Will only work if /K1= and /K2= define a function key. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} Def_Str( event_str[80], tstr[100], tstr2[100] ); Def_Int( k1, k2, jj, jx, jy, jz, tint, Event_Count, check_mode, fkeyl ); event_count := Parse_Int('/#=', mparm_str); event_str := Parse_Str('/G=', mparm_str ); jx := 0; check_mode := parse_int('/M=', mparm_str); IF check_mode = 1 THEN RETURN_INT := 0; WHILE (jx < Event_Count) DO ++jx; tstr := Global_Str( event_str + str(jx) ); IF (Mou_Last_Y = Parse_Int('/Y=', tstr)) THEN jy := Parse_Int('/X=', tstr); IF (Mou_Last_X >= jy) AND (Mou_Last_X < (jy + Parse_Int('/W=',tstr))) THEN goto Hi_Event; END; END; END; ELSIF check_mode = 2 THEN fkeyl := parse_int('/F=', mparm_str); WHILE (jx < Event_Count) DO ++jx; tstr := Global_Str( event_str + str(jx)); jy := Parse_Int('/X=', tstr); jz := Parse_Int('/Y=', tstr); tstr2 := Parse_Str('/T=', tstr); jj := svl(tstr2); IF jj <> 0 THEN WRITE( tstr2, jy, jz, 0, m_t_color ); jy := jy + jj; END; tstr2 := Parse_Str('/KC=', tstr); WRITE( tstr2, jy, jz, 0, m_s_color ); IF fkeyl THEN k1 := parse_int('/K1=', tstr); IF k1 = 0 THEN k2 := parse_int('/K2=', tstr); IF (k2 > 58) AND (k2 < 114) THEN flabel(Parse_Str('/FL=', tstr), k2 - 58, -1); END; END; END; END; ELSIF check_mode = 0 THEN RETURN_INT := 0; WHILE (jx < Event_Count) DO ++jx; tstr := Global_Str( event_str + str(jx)); IF (Parse_Int('/K1=', tstr) = key1) AND (Parse_Int('/K2=', tstr) = key2) THEN RETURN_INT := Parse_Int('/R=', tstr); goto hi_event; END; END; ELSIF check_mode = 3 THEN WHILE (jx < Event_Count) DO ++jx; Set_Global_Str( event_str + str(jx), ''); END; ELSIF check_mode = 4 THEN jy := 1; WHILE (jx < event_count) DO ++jx; tstr := Global_Str( event_str + str(jx)); jj := parse_int('/W=', tstr ); IF jj = 0 THEN jj := Length(parse_str('/KC=', tstr)) + Length(parse_str('/T=', tstr) ); tstr := tstr + '/W=' + str( jj ); Set_Global_Str( event_str + str(jx), tstr); END; jy := jy + jj + 1; END; jy := jy - 2; tint := parse_int('/Y=', mparm_str); return_int := jy; jx := parse_int('/X=', mparm_str); jy := jx + (((parse_int('/W=', mparm_str) / 2)) - (jy / 2)); IF jy < jx THEN jy := jx; END; jx := 0; WHILE (jx < event_count) DO ++jx; tstr := Global_Str( event_str + str(jx)); jj := parse_int('/W=', tstr ); IF jj = 0 THEN jj := Length(parse_str('/KC=', tstr)) + Length(parse_str('/T=', tstr) ); tstr := tstr + '/W=' + str( jj ); Set_Global_Str( event_str + str(jx), tstr); END; tstr := tstr + '/X=' + str(jy) + '/Y=' + str(tint); Set_Global_Str( event_str + str(jx), tstr); jy := jy + jj + 1; END; END; goto exit; Hi_Event: RETURN_INT := jx; RETURN_STR := tstr; Draw_Attr( parse_int('/X=', tstr), parse_int('/Y=', tstr), m_h_color, parse_int('/W=', tstr)); exit: END_MACRO; $MACRO DB; {*******************************MULTI-EDIT MACRO****************************** Name: DB Description: A text database manager, capable of considerable versatility. Can be used as for such simple things as establishing a pop-up phone list, to much more sophisticated uses as managing the filename extension setup parameters. This macro can actually be nested so that editing a field can bring up yet another database. File Format: The header is composed of one field definition per line as follows (except for /DBF, the format is the same as individual string fields in DATA_IN): /TP=field_type/T=field_name/L=line/C=col/W=field_width/ML=max_field_length/DBF=field_designator (any number of repeats of the above line) ****START**** (data records) The /DBF field designator must be unique, and represents the identifier in each record for that field. See PHONE.DB for a sample note card file. Parameters: /X= X coordinate for the menu box. /Y= Y coordinate for the menu box. /F= The file name of the database file. If no path is specified, then: A. the ME_PATH is used if no USER_ID is in use B. the USER_ID directory is used. /CP= Create Prompt. If present, will be the prompt when user creates a new record. /LD= Leading delimiter for each field. MUST be the last parameter on the command line. Default is "". /TT= Title type. 0 = File name with extension 1 = File name without extension /LT= List title If present, /LT= will replace the file name /DT= Data title If present, /DT= will be used in the DATA_IN title instead of the list title. /NOALPHA= If 1, No alphabetic sorting will take place. /LO= 1 : List only. Select with <ENTER>. No DATA_IN screen. 2 : Same as 1 but adds the Modify option. /NL= No list. If 1, the DVMENU of records is bypassed. Display /FV= record. /FV= Field value first field of record to be displayed. Only used if /NL=1 or /C=1. If /FV is null, the first record will be displayed. /PROTECT1 - nn= Set of first field values of records to protect against deletion. /C= Immediately create a new record if /FV= is not found. Can be used only with /NL=. /HF=str Specifies a header file. This allows you to use a seperate file for your field definitions. /PRE=str Prefix for the ISTR, IPARM and IINT. Use when nesting DB. /RR=1 Return record only /FV= and store into /GLO=. Will not create a list or data screen. /GLO= Name of global string to store a found record. Can be used with or without /RR=. /DS=str Display string global var name. The display string global should be formatted as follows: /field_name=length /field_name=length... ("/" should be replaced by the /LD= delimit) /PR= Print records. Will, instead of displaying the menu, send it to the currently defined printer device. /NC= If 1, disables Copy record function. /NE= If 1, disables Edit record function. /NDF=1 Do NOT delete file window when done. /NDH=1 Do NOT delete header window when done. /ENC=1 Exit if no records are found. /MACRO=str Name of macro to be run both BEFORE and AFTER a record is modified. The record will be in the global variable specified by /GLO=. The following parameters will be passed to the macro: /P=nn nn = 0 Macro was run before modification. = 1 Macro was run AFTER modification. /GLO=str name of the global variable containing the record. /DPT=str Name of the page to use for the data in multiple page db files. /HPT=str Name of the page to use for the header in multiple page db files. /SRP=n 1 = Allow search. /S= Starting choice. This will be the hilited choice if <> 0 /NSF= Don't save the DB file even if a change is made. Rarely used. Global Variables Returned: Global_Int( '@DB_FILE_CHANGED' ) will be TRUE if any changes were made to the file. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} def_int( x, y, {Display coordinates} field_count, {The # of fields in the database} tp, {current record type} No_List, t_refresh, Create, List_Only, Search_result, record_count, {The # of records in the database} jx, jy, jz, {Temp vars} need_rebuild, {1 = Need new list of records} new_box, end_field, {The line number of the last field in the header. end_field will be 0 if a seperate header file is used} tbc, {The box count we started witch} header_win, {The database header window} old_win, {The window we started with} db_win, {The database data window} build_win, {The window to build the database menu in} db_win_num, build_win_num, max_width, {The length of the biggest record} Return_Record, use_ds, cur_item, cur_row, No_Alpha, old_width, first_display, Print_Records, Use_Ps, Handle, T_Insert_Mode, T_Truncate_Spaces, Ev_Count, header_page_line, data_page_line, db_exists, header_exists, temp_use_ds, old_backups ); {Used for parse_ds} def_int( tint, tint2 ); Def_Int(Ticks); def_str( tstr[2000], tstr2[80], tstr3, header_file[80], Prefix[10], List_Title[78], Data_Title[78], mac_str, glo_str[16], PP_Str[10], DSG_Name[20], DSG_Ints[30], TP_STR ); def_int( ds_count ); Def_Char(Delimit); Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); Error_Level := 0; reg_exp_stat := TRUE; T_Insert_Mode := Insert_Mode; T_Truncate_Spaces := Truncate_Spaces; Truncate_Spaces := False; Old_Backups := Backups; Backups := FALSE; Use_Ps := 0; Return_Int := XPos('/LD=',MParm_Str,1); IF (Return_Int) THEN Delimit := Copy(MParm_Str,Return_Int + 4,1); ELSE Delimit := ''; END; Return_Record := FALSE; glo_str := Parse_Str('/GLO=',MParm_Str); No_Alpha := Parse_Int('/NOALPHA=',MParm_Str); No_List := Parse_Int('/NL=',MParm_Str); IF (No_List = 0) THEN IF (Parse_Int('/RR=',MParm_Str)) THEN Return_Record := True; Return_Int := 1; No_List := True; Set_Global_Str(glo_str,''); END; END; Create := Parse_Int('/C=',MParm_Str); Jx := XPos('/MACRO=',MParm_Str,1); IF (Jx) THEN mac_str := Copy(Mparm_str,Jx + 7,254); IF (XPos(' ',Mac_Str,1) = 0) THEN Mac_Str := Mac_Str + ' '; END; END; Print_Records := False; List_Title := Parse_Str('/LT=',MParm_Str); IF (List_Title = '') THEN List_Title := Truncate_Path(Parse_Str('/DPT=',MParm_Str)); IF (List_Title = '') THEN List_Title := Truncate_Path(Parse_Str('/F=',MParm_Str)); END; IF (Parse_Int('/TT=',MParm_Str) = 1) THEN List_Title := Truncate_Extension(List_Title); END; END; Data_Title := Parse_Str('/DT=',MParm_Str); IF (Data_Title = '') THEN Data_Title := List_Title; END; List_Only := Parse_Int('/LO=',MParm_Str); Search_Result := 1; t_refresh := refresh; refresh := false; old_win := window_id; build_win := 0; build_win_num := 0; Prefix := Parse_Str('/PRE=',MParm_Str); IF prefix = '' THEN prefix := str(global_int('MENU_LEVEL')); END; field_count := 0; tbc := box_count; {Calculate position of box} x := parse_int('/X=', mparm_str); y := parse_int('/Y=', mparm_str); if x <= 0 then x := 2; end; if y <= 0 then y := 3; end; Ds_Count := 0; Use_Ds := 0; new_box := TRUE; {Get file name. If no path is specified, then assume the ME directory} tstr := parse_str('/F=', mparm_str); if get_path(tstr) = '' then IF user_id = '' THEN tstr := CAPS(me_path + tstr); ELSE tstr := CAPS(me_path + user_id + '.USR\' + tstr); END; IF switch_file( tstr ) = FALSE THEN return_str := Truncate_Path(tstr); RM('MakeUserPath /DF=1'); tstr := return_str; END; end; tstr := CAPS(fexpand(tstr)); error_level := 0; db_exists := Switch_File(Tstr); IF NOT(db_exists) THEN create_window; load_file( tstr ); window_attr := $80; if error_level <> 0 then error_level := 0; file_name := tstr; end; IF parse_int('/NDF=', mparm_str) <> 0 THEN db_exists := TRUE; END; END; window_attr := $81; db_win := window_id; db_win_num := cur_window; header_win := window_id; {Check for a seperate header file} header_file := parse_str( '/HF=', mparm_str ); if (header_file <> '') then if get_path(header_file) = '' then return_str := header_file; RM('MakeUserPath /DF=1'); header_file := return_str; end; header_file := CAPS(fexpand(header_file)); {If the header_file is not the same as the db file then load the header file} if header_file <> tstr then header_exists := Switch_File( header_file ); IF NOT(header_exists) THEN create_window; load_file(header_file); window_attr := $80; if error_level <> 0 then RM('MEERROR^Beeps /C=1'); goto exit2; end; END; header_win := window_id; end; end; CALL find_page_lines; {Parse out the Display String array} IF (Use_ds = false) THEN tstr := global_str( parse_str('/DS=', mparm_str ) ); use_ds := tstr <> ''; IF use_ds THEN DSG_Name := '#DBDS'; Call BUILD_DS; DS_Count := Jz; END; END; need_rebuild := true; call build_fields; IF (Field_Count < 1) THEN goto exit2; END; tstr := global_str( 'DB#' + truncate_path(truncate_extension(file_name)) + '^' + truncate_extension(parse_str('/DPT=', mparm_str)) ); {If the calling macro specified a starting choice, use that instead.} cur_item := parse_int('/S=',MParm_str); IF (Cur_Item < 1) THEN cur_item := parse_int('/S=',tstr); END; cur_row := parse_int('/OR=', tstr ); if switch_win_id( db_win ) then end; first_display := FALSE; main_loop: {Display the list of all of the fields} IF (No_List) THEN Goto NO_LIST; END; first_display := TRUE; call build_record_list; IF (Record_Count = 0) THEN IF (Parse_Int('/ENC=',MParm_Str)) THEN Search_Result := 0; Goto EXIT; END; END; {Exit from DB} if return_int = 0 then NO_LIST_EXIT: IF switch_win_id( db_win ) THEN END; call set_db_global; goto exit2; {Modify was selected} elsif return_int = 4 THEN goto SKIP_NO_LIST; {Display selected record} elsif return_int = 1 then IF (List_Only) THEN IF parse_int( '/2TOP=', mparm_str ) AND NOT(read_only) THEN call move_item_to_top; END; IF glo_str = '' THEN Goto NO_LIST_EXIT; END; END; NO_LIST: IF (No_List) THEN Return_Str := Parse_Str('/FV=',MParm_Str); call find_data; IF ((No_List = 1) and (Search_Result = 0)) THEN IF ((Return_Record = True) or (List_Only = true)) THEN Set_Global_Str(glo_str,Get_Line); Goto EXIT; END; IF (Create = 0) THEN IF (Parse_Str('/FV=',MParm_Str) = '') THEN Goto DISPLAY_FIELDS; END; Goto EXIT2; ELSE Goto NO_LIST_CREATE; END; END; END; SKIP_NO_LIST: goto_line( end_field + cur_item ); display_fields: IF (return_int = 1) AND ((Return_Record = True) or (List_Only > 0)) THEN call set_db_global; Set_Global_Str(glo_str,Get_Line); Goto EXIT2; END; display_fields2: IF mac_str <> '' THEN Set_Global_Str( glo_str, get_line ); RM( mac_str + '/GLO=' + glo_str ); IF global_str( glo_str ) <> get_line THEN put_line( global_str( glo_str ) ); END; END; call get_data; {This stuff here will guarantee we will be able to compensate if lines in a shared DB file are inserted or deleted while nested under DATA_IN} Mark_Pos; Set_Mark(1); IF (Header_Win = Db_Win) THEN Goto_Line(Header_Page_Line); Jy := C_Line; Mark_Pos; END; Get_Mark(1); Jx := C_Line; RM('USERIN^DATA_IN /X=' + str(x + 2) + '/Y=' + str(y + 2) + '/NC=1/T=' + Data_Title + '/A=2' + '/#=' + str(field_count) + '/PRE=' + Prefix + '/RGS=' + Parse_Str('/RGS=',MParm_Str)); {Relocate the file position in case anything has changed} { call Find_Page_Lines; } {If, while in DATA_IN, lines above this line were inserted or deleted, this will compensate} IF (Header_Win = DB_Win) THEN Goto_Mark; Header_Page_Line := Header_Page_Line + (c_line - Jy); END; Goto_Mark; End_Field := End_Field + (c_line - Jx); Data_Page_Line := Data_Page_Line + (c_line - Jx); call Set_Data_Page_Line; call set_data; return_str := global_str(Prefix + 'ISTR_1'); IF (No_List) THEN Goto NO_LIST_EXIT; END; {Copy a record} elsif return_int = 5 THEN call check_read_only; IF read_only THEN goto main_loop; END; if (switch_win_id( db_win ) ) THEN goto_line(cur_item + end_field); Return_Str := parse_str(Delimit + parse_str('/DBF=',global_str(Prefix + 'IPARM_1')) + '=',Get_Line); END; RM('QUERYBOX /T=COPY A RECORD/P=' + Shorten_Str(parse_str('/T=' ,global_str(Prefix + 'IPARM_1'))) + ' /C=' + str(x + 2) + '/L=' + str( y + 2 ) + '/W=' + parse_str('/W=' ,global_str(Prefix + 'IPARM_1')) + '/ML=' + parse_str('/ML=' ,global_str(Prefix + 'IPARM_1'))); IF return_int = 0 THEN goto main_loop; END; call copy_record; goto display_fields2; {Create new record. Put it in the file in alphabetical order} elsif return_int = 2 then call check_read_only; IF read_only THEN goto main_loop; END; return_str := ''; tstr3 := parse_str('/CP=', mparm_str); IF tstr3 <> '' THEN RM('QUERYBOX /T=CREATE NEW RECORD/P=' + tstr3 + '/C=' + str(x + 2) + '/L=' + str( y + 2 ) + '/W=' + parse_str('/W=' ,global_str(Prefix + 'IPARM_1')) + '/ML=' + parse_str('/ML=' ,global_str(Prefix + 'IPARM_1'))); IF return_int = 0 THEN goto main_loop; END; END; NO_LIST_CREATE: tstr := Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_1')) + '=' + return_str; create2: call insert_record; goto display_fields2; {Delete selected record} elsif return_int = 3 then IF (Record_Count = 0) THEN Goto MAIN_LOOP; END; {Check to see if this record is protected} IF (XPos('/PROTECT',MParm_Str,1)) THEN if (switch_win_id( db_win ) ) THEN call check_read_only; IF read_only THEN goto main_loop; END; goto_line(cur_item + end_field); Tstr := Caps(Parse_Str(Delimit + parse_str('/DBF=',global_str(Prefix + 'IPARM_1')) + '=',Get_Line)); Jx := 1; CHECK_PROTECT: Tstr3 := Caps(Parse_Str('/PROTECT' + Str(Jx) + '=',MParm_Str)); IF (Tstr3 <> '') THEN IF (Tstr = Tstr3) THEN RM('MEERROR^MessageBox /B=1/T=/M=This record is protected against deletion!'); Goto Main_loop; ELSE ++Jx; Goto CHECK_PROTECT; END; END; end; END; RM('USERIN^VERIFY /T=Delete this record ?/H=' + Parse_Str('/H=',MParm_Str) + '/C=' + str(x + 2 ) + '/L=' + str(y + 2) ); IF return_int THEN call delete_record; END; {print the list} elsif return_int = 6 then Print_Records := True; call build_record_list; {search} elsif return_int = 20 then end; goto main_loop; check_read_only: IF (read_only) THEN RM('MEERROR^MessageBox /B=1/T="' + file_name + '" IS LOCKED!/M=DB File is locked, no modifications will be allowed.'); END; RET; BUILD_DS: Jz := 0; jx := 0; DSG_Ints := ''; pd_loop: jx := xpos( delimit, tstr, jx + 1); if jx <> 0 THEN ++Jz; jy := xpos('=', tstr, jx + 1 ); tstr2 := copy( tstr, jx, jy - jx + 1 ); Set_Global_Str( str(Jz) + DSG_Name, tstr2 ); jx := jy; DSG_Ints := DSG_Ints + CHAR( parse_int( tstr2, tstr ) ); {Set_Global_Int( str(Jz) + DSG_Name, parse_int( tstr2, tstr ));} goto pd_loop; END; RET; {Searches for the specified record, according to field 1} find_data: if switch_win_id( db_win ) then end; goto_line(end_field); goto_col(1); search_again: Search_Result := search_fwd(Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_1')) + '=' + return_str, 0); IF (search_result <> 0) AND (caps( parse_str( Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_1')) + '=', get_line )) <> caps( return_str )) THEN eol; Goto search_again; END; if (Search_Result = 0) then Goto_line(end_field + 1); end; cur_item := c_line - end_field; ret; {Retrieves the data in the current record and puts it into a DATA_IN compatible globals} get_data: jx := 0; tstr := get_line; while jx < field_count do ++jx; TStr3 := global_str(Prefix + 'IPARM_' + str(jx)); tp := parse_int('/TP=', Tstr3); {Assign to a special global if one exists for this field. Originally created for format line initialization.} IF (XPos('/GSTR=',Tstr3,1)) THEN IF ((parse_str(Delimit + parse_str('/DBF=', Tstr3) + '=',tstr ) <> '') or (Parse_Int('/GSET=',Tstr3) > 0)) THEN Set_Global_Str( Parse_Str('/GSTR=',Tstr3), parse_str(Delimit + parse_str('/DBF=',TStr3) + '=',TStr)); END; END; if ((tp = 0) or (Tp = 6) or ((tp = 8) and (Parse_Str('/ISTR=',TStr3) = ''))) then set_global_str(Prefix + 'ISTR_' + str(jx), parse_str(Delimit + parse_str('/DBF=',Tstr3) + '=', tstr )); elsif (tp = 1) or (tp = 3) or (tp = 4) or (tp = 5) or (tp = 7) or (tp = 9) then set_global_int(Prefix + 'IINT_' + str(jx), parse_int(Delimit + parse_str('/DBF=',TStr3) + '=', tstr )); end; end; ret; delete_record: if switch_win_id( db_win ) then call check_read_only; IF read_only THEN ret; END; goto_line( cur_item + end_field ); del_line; --record_count; if switch_win_id( build_win ) THEN del_line; call set_max_width; END; if switch_win_id( db_win ) THEN END; if AT_EOF then --cur_item; end; IF record_count < (screen_length - 3) THEN new_box := TRUE; END; end; ret; copy_record: if (switch_win_id( db_win ) ) THEN call check_read_only; IF read_only THEN ret; END; goto_line(cur_item + end_field); tstr := get_line; {Place the prompted for first field value in place of the original for the copy} Tstr3 := Delimit + parse_str('/DBF=',global_str(Prefix + 'IPARM_1')) + '='; Tstr := Tstr3 + Return_Str + Copy(Tstr, Length(parse_str(Tstr3,tstr )) + Svl(Tstr3) + 1,2048); call insert_record; end; ret; {Inserts the record contained in tstr into the file at the current position} insert_record: if (switch_win_id( db_win ) ) THEN call check_read_only; IF read_only THEN ret; END; goto_line(cur_item + end_field); goto_col(1); IF NOT(AT_EOF) THEN eol; Insert_Mode := True; cr; END; ++record_count; call Put_Line_Here; IF record_count < (screen_length - 3) THEN new_box := TRUE; END; END; ret; {Takes the current record out of the DATA_IN globals and puts it in the file} set_data: call check_read_only; IF read_only THEN ret; END; jx := 0; tstr := ''; while jx < field_count do ++jx; TStr3 := global_str(Prefix + 'IPARM_' + str(jx)); tp := parse_int('/TP=', Tstr3); {If we are supposed to use a special global instead of the ISTR, do that} IF (XPos('/GSTR=',Tstr3,1)) THEN IF (Global_Str( Parse_Str('/GSTR=',Tstr3)) <> '') THEN tstr := tstr + Delimit + parse_str('/DBF=',Tstr3) + '=' + Global_Str(Parse_Str('/GSTR=',Tstr3)); END; Goto BYPASS_SET; END; if (tp = 0) or (Tp = 6) or (tp = 8) then if global_str(Prefix + 'ISTR_' + str(jx)) <> '' then tstr := tstr + Delimit + parse_str('/DBF=', tstr3 ) + '=' + global_str(Prefix + 'ISTR_' + str(jx)); end; end; IF (tp = 3) THEN IF global_int( prefix + 'IINT_' + str(jx)) = 0 THEN set_global_int( prefix + 'IINT_' + str(jx), 1); END; END; if (tp = 1) or (tp = 3) or (tp = 4) or (tp = 5) or (tp = 7) or (tp = 9) then if global_int(Prefix + 'IINT_' + str(jx)) <> 0 then tstr := tstr + Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_' + str(jx))) + '=' + str(global_int(Prefix + 'IINT_' + str(jx))); end; end; BYPASS_SET: end; IF mac_str <> '' THEN Set_Global_Str( glo_str, tstr ); Set_Global_Int('@DB_NEED_REBUILD!',0); RM( mac_str + '/P=1/GLO=' + glo_str ); tstr := global_str( glo_str ); Need_Rebuild := Global_Int('@DB_NEED_REBUILD!'); END; if (tstr <> get_line) then del_line; {This entry point is only used by CREATE} set_data2: if switch_win_id( build_win ) THEN goto_line( cur_item ); del_line; END; set_data3: switch_win_id( db_win ); Goto_Col(1); IF (No_Alpha) THEN Goto_Line(End_Field + Cur_Item); ELSE goto_line(end_field+1); goto_col(1); tstr2 := Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_1')) + '='; tstr3 := caps(parse_str(tstr2,tstr)); while not(at_eof) and (caps(parse_str(tstr2,get_line)) < tstr3) AND (Cur_Char <> '|12') do down; end; END; if not(at_eof) then Insert_Mode := True; cr; up; end; put_line_here: call check_read_only; IF read_only THEN ret; END; put_line(tstr); cur_item := c_line - end_field; tstr := Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_1') ) + '='; DSG_Name := '#DBDS'; call parse_ds; if switch_win_id( build_win ) THEN goto_line( cur_item ); goto_col( 1 ); set_indent_level; Insert_Mode := True; cr; up; put_line( tstr3 ); IF svl( tstr3 ) > max_width THEN max_width := svl( tstr3 ); new_box := true; END; END; if switch_win_id( db_win ) THEN END; {need_rebuild := true;} end; ret; {Takes the file header that defines the fields and builds DATA_IN compatible global parameter variables.} build_fields: Set_Global_Str(Prefix + 'IHELP1',''); Set_Global_Str(Prefix + 'IHELP2',''); Set_Global_Str(Prefix + 'IHELP3',''); tp_str := ''; if switch_win_id( header_win ) then field_count := 0; Goto_Line( header_page_line + 1); floop: tstr := get_line; if (tstr = '****START****') or (At_Eof) then end_field := c_line; goto floop_exit; end; IF str_char(tstr,1) = '|12' THEN IF svl(tstr) > 0 THEN end_field := c_line; goto floop_exit; END; END; {This is for the new stuff for printer string and display string being in the header} IF (XPos('@',TStr,1) = 1) THEN IF (XPos('@DISPLAY_STRING=',TStr,1) = 1) THEN IF NOT( use_ds ) THEN Set_Global_Str('#DBDS@' + Str(Global_Int('MENU_LEVEL')), Copy(TStr,17,2048)); TStr := Copy(TStr,17,2048); DSG_Name := '#DBDS'; Call BUILD_DS; Ds_Count := Jz; use_ds := true; END; ELSIF (XPos('@PRINTER_STRING=',TStr,1) = 1) THEN Set_Global_Str('#DBPS@' + Str(Global_Int('MENU_LEVEL')), Copy(TStr,17,2048)); use_Ps := true; ELSIF (XPos('@IHELP',TStr,1) = 1) THEN Set_Global_Str(Prefix + Copy(Tstr,2,6),Copy(TStr,9,2048)); END; Goto other_data; END; ++field_count; set_global_str(Prefix + 'IPARM_' + str(field_count), tstr); IF (Parse_Int('/TP=',Tstr) = 5) THEN {This is to accomodate the type 5 true/false.} set_global_str(Prefix + 'ISTR_' + str(field_count), Copy(tstr,XPos('/ISTR=',Tstr,1) + 6,255)); ELSE set_global_str(Prefix + 'ISTR_' + str(field_count), parse_str('/ISTR=', tstr)); END; set_global_int(Prefix + 'IINT_' + str(field_count), parse_int('/IINT=', tstr)); {Save a special string which ties the /TP= with the /DBF= for use by PARSE_DS} tp_str := tp_str + Delimit + Parse_Str('/DBF=', tstr) + '=' + Parse_Str('/TP=',Tstr); other_data: down; goto floop; floop_exit: end; set_data_page_line: if (db_win <> header_win) OR (data_page_line <> 0) then IF (data_page_line = header_page_line) AND (db_win = header_win) THEN data_page_line := end_field; END; end_field := data_page_line; end; IF (Field_Count < 1) THEN RM('MEERROR^Beeps /C=1'); RM('MEERROR^MessageBox /B=1/T=NO HEADER/M=Header in "' + file_name + '" or file not found! Cannot display menu.'); END; switch_win_id( db_win ); ret; {Builds the Variable Length Menu that lists all of the records by their first field} build_record_list: IF (Print_Records) THEN {Open the printer device/file} IF use_ps THEN temp_use_ds := use_ds; use_ds := true; tstr := Global_Str('#DBPS@' + Str(Global_Int('MENU_LEVEL'))); Call BUILD_DS; DS_Count := Jz; END; RM('MEUTIL3^OPEN_CLOSE_FILE /M=1/FN=' + Global_Str('PRINTER_DEVICE')); IF (Error_Level) THEN RM('MEERROR'); RET; ELSE Handle := Return_Int; END; PP_Str := ' /S=1'; switch_win_id( build_win ); Jx := Cur_Window; Goto print_it; END; if build_win = 0 then switch_window(window_count); create_window; window_attr := $80; build_win := window_id; build_win_num := cur_window; end; if switch_win_id( build_win ) then jx := cur_window; old_width := max_width; if (need_rebuild) then working; need_rebuild := FALSE; erase_window; max_width := 13; print_it: if switch_win_id( db_win ) then jy := cur_window; goto_col(1); goto_line(end_field + 1); tstr := Delimit + parse_str('/DBF=', global_str(Prefix + 'IPARM_1') ) + '='; record_count := 0; { Ticks := MemP($46C); } DSG_Name := '#DBDS'; while not(at_eof) AND (cur_char <> '|12') do ++record_count; {This will detect a "Skip_Over" situation} IF (XPos(Delimit + '@|254=',Get_Line,1)) THEN TStr3 := Parse_Str(Delimit + '@|254=',Get_Line) + '|254'; jz := svl(tstr3) - 1; ELSE call parse_ds; jz := svl(tstr3); END; IF (Print_Records) THEN Return_Str := TStr3 + '|13|10'; RM('MEUTIL3^PRINTSTR' + PP_Str + '/H=' + Str(Handle)); PP_Str := ' '; IF (Error_Level) THEN RM('MEERROR'); RET; END; ELSE put_line_to_win( tstr3, record_count, build_win_num, false ); END; down; IF Not(Print_Records) THEN if jz > max_width then max_width := jz; end; END; end; {Make_Message('[' + Str(Memp($46C) - Ticks) + ']' + str(ticks));} IF (Print_Records) THEN {Close the printer device/file} RM('MEUTIL3^OPEN_CLOSE_FILE /H=' + Str(Handle)); IF (Error_Level) THEN RM('MEERROR'); END; Print_Records := False; use_ds := TEMP_USE_DS; IF use_ds THEN tstr := Global_Str('#DBDS@' + Str(Global_Int('MENU_LEVEL'))); Call BUILD_DS; DS_Count := Jz; END; Need_Rebuild := TRUE; RET; END; end; end; IF max_width < 20 THEN max_width := 20; new_box := true; END; IF old_width <> max_width THEN new_box := true; END; IF cur_item > record_count then cur_item := 1; END; IF new_box THEN while (box_count > tbc) do kill_box; end; end; switch_window(jx); IF (Record_Count = 0) THEN IF (Parse_Int('/ENC=',MParm_Str)) THEN Ret; END; END; update_status_line; IF ((list_only > 0) and (list_only < 3)) THEN Set_Global_Str('@DBEV1', '/T=Select/K1=13/K2=28/R=1/LL=1'); Set_Global_Str('@DBEV2', '/T=Cancel/K1=27/K2=1/R=0/LL=1'); ELSE Set_Global_Str('@DBEV1', '/T=Select/K1=13/K2=28/R=1/LL=1'); Set_Global_Str('@DBEV2', '/T=Done/K1=27/K2=1/R=0/LL=1'); END; {This overrides events 1 or 2} IF (Parse_Str('/EV1=',MParm_Str) <> '') THEN Set_Global_Str('@DBEV1', Global_Str(Parse_Str('/EV1=',MParm_Str))); END; IF (Parse_Str('/EV2=',MParm_Str) <> '') THEN Set_Global_Str('@DBEV2', Global_Str(Parse_Str('/EV2=',MParm_Str))); END; Ev_Count := 2; IF (Parse_Int('/NI=',MParm_Str) = 0) THEN ++Ev_Count; Set_Global_Str('@DBEV' + Str(Ev_Count), '/T=Create/K1=0/K2=82/R=2'); END; IF (Parse_Int('/ND=',MParm_Str) = 0) THEN ++Ev_Count; Set_Global_Str('@DBEV' + Str(Ev_Count), '/T=Delete/K1=0/K2=83/R=3'); END; IF (Parse_Int('/NC=',MParm_Str) = 0) THEN ++Ev_Count; Set_Global_Str('@DBEV' + Str(Ev_Count), '/T=Copy/K1=0/K2=62/R=5/FL=Copy'); END; IF (Parse_Int('/NE=',MParm_Str) = 0) THEN ++Ev_Count; Set_Global_Str('@DBEV' + Str(Ev_Count), '/T=Edit/K1=0/K2=61/R=4/FL=Edit'); END; IF (Parse_Int('/SRP=',MParm_Str) <> 0) THEN ++Ev_Count; Set_Global_Str('@DBEV' + Str(Ev_Count), '/T=Search/K1=0/K2=64/R=20/FL=Search'); END; IF (Use_Ps) THEN ++Ev_Count; Set_Global_Str('@DBEV' + Str(Ev_Count), '/T=Print/K1=0/K2=66/R=6/FL=Print'); END; IF (Parse_Int('/NB=',MParm_Str)) THEN New_Box := 0; END; RM('USERIN^WMENU /X=' + str(x) + '/Y=' + str(y) + '/DBL=1/S=' + str(cur_item) + '/OR=' + str( cur_row ) + '/W=' + str( max_width ) + '/T=' + List_Title + '/H=' + Parse_Str('/H=',MParm_Str) + '/NB=' + str(new_box = 0) + '/EV=@DBEV/EV#=' + Str(Ev_Count) + '/NK=1' ); new_box := false; cur_item := c_line; cur_row := c_row; return_str := get_line; switch_win_id( db_win ); end; ret; {This routine parses out the display line from the data line} parse_ds: IF NOT(use_ds) THEN tstr3 := parse_str(tstr, get_line); Goto PARSE_DS_EXIT; END; tstr3 := ''; tstr := get_line; tint := 0; WHILE tint < ds_count DO ++tint; tint2 := ASCII( str_char( dsg_ints, tint ) ); IF tint2 = 0 THEN IF (Parse_Int(GLOBAL_STR(str( tint ) + DSG_NAME),tp_str) = 9) THEN {This is to properly display keystroke fields} RM('SETUP^MAKEKEY /K1=' + Str(parse_int(GLOBAL_STR(str(tint) + DSG_NAME), tstr) and $FF) + '/K2=' + Str((parse_int(GLOBAL_STR(str(tint) + DSG_NAME), tstr) shr 8) and $FF)); tstr3 := tstr3 + return_str + ' '; ELSE tstr3 := tstr3 + parse_str( GLOBAL_STR(str( tint ) + DSG_NAME), tstr ) + ' '; END; ELSE IF (Parse_Int(GLOBAL_STR(str( tint ) + DSG_NAME),tp_str) = 9) THEN {This is to properly display keystroke fields} RM('SETUP^MAKEKEY /K1=' + Str(parse_int(GLOBAL_STR(str(tint) + DSG_NAME), tstr) and $FF) + '/K2=' + Str((parse_int(GLOBAL_STR(str(tint) + DSG_NAME), tstr) shr 8) and $FF)); Tstr2 := COPY(Return_Str,1,tint2); ELSE tstr2 := COPY(parse_str( GLOBAL_STR(str( tint ) + DSG_NAME), tstr ), 1, tint2 ); END; tstr3 := tstr3 + tstr2 + copy( ' ', 1, tint2 - svl(tstr2) ); END; END; PARSE_DS_EXIT: IF (Tstr3 = '') THEN {Expand the null string so it will work right with WMENU} Tstr3 := ' '; END; ret; {Goes through the display file and resets the maximum width} set_max_width: MARK_POS; tof; max_width := 17; while NOT( at_eof ) DO tstr := get_line; jz := svl(tstr); IF str_char( tstr, jz ) = '|254' THEN --jz; END; if jz > max_width THEN max_width := jz; END; down; END; tof; ret; move_item_to_top: switch_win_id( db_win ); Goto_Line(End_Field + Cur_Item); tstr := get_line; del_line; goto_line( end_field); eol; Insert_Mode := true; cr; put_line( tstr ); cur_item := 1; ret; find_page_lines: End_Field := 0; header_page_line := 0; data_page_line := 0; tstr := parse_str('/HPT=', mparm_str); IF tstr <> '' THEN switch_win_id( header_win ); tof; IF search_fwd('%|12' + tstr + '$',0) THEN header_page_line := c_line; IF search_fwd('%@*@*@*@*START@*@*@*@*$',0) THEN {Look for end of header} End_Field := c_line; END; END; END; tstr := parse_str('/DPT=', mparm_str); IF tstr <> '' THEN switch_win_id( db_win ); tof; IF search_fwd('%|12' + tstr + '$',0) THEN data_page_line := c_line; IF header_page_line = 0 THEN header_page_line := data_page_line; IF search_fwd('%@*@*@*@*START@*@*@*@*$',0) THEN {Look for end of header} End_Field := c_line; END; END; ELSIF header_page_line <> 0 THEN EOF; EOL; Insert_mode := true; CR; TEXT('|12'+ tstr ); data_page_line := c_line; END; END; RET; set_db_global: set_global_str( 'DB#' + truncate_path(truncate_extension(file_name))+ '^' + truncate_extension(parse_str('/DPT=', mparm_str)), '/S=' + Str(cur_item) + '/OR=' + str(cur_row) ); ret; exit: Return_Int := Search_Result - 1; exit2: jx := 0; WHILE jx < ds_count DO ++jx; SET_GLOBAL_INT( str( jx ) + '#DBDS', 0 ); END; Set_Global_Str('#DBPS@' + Str(Global_Int('MENU_LEVEL')),''); Set_Global_Str('#DBDS@' + Str(Global_Int('MENU_LEVEL')),''); Set_Global_Str(Prefix + 'IHELP1',''); Set_Global_Str(Prefix + 'IHELP2',''); Set_Global_Str(Prefix + 'IHELP3',''); jx := 0; while jx < field_count do ++jx; set_global_str(Prefix + 'IPARM_' + str(jx), ''); set_global_str(Prefix + 'ISTR_' + str(jx), ''); set_global_int(Prefix + 'IINT_' + str(jx), 0); Set_Global_Str(Prefix + 'DB_GSTR' + Str(jx),''); end; IF (parse_int('/NK=',MParm_str)) THEN ++tbc END; while box_count > tbc do kill_box; end; if switch_win_id( db_win ) then set_global_int('@DB_FILE_CHANGED', file_changed ); if ((file_changed = true) and (Parse_Int('/NSF=',MParm_Str) = false)) then save_file; end; IF NOT( db_exists ) THEN delete_window; END; end; if (db_win <> header_win) AND switch_win_id( header_win ) then IF NOT( header_exists ) THEN delete_window; END; end; if switch_win_id( build_win ) then delete_window; end; switch_win_id(old_win); Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); Backups := Old_Backups; Insert_Mode := T_Insert_Mode; Truncate_Spaces := T_Truncate_Spaces; Refresh := T_Refresh; update_status_line; END_MACRO; {*******************************MULTI-EDIT MACRO****************************** Name: SetConfig Description: Loads up the specified DB file (if it is not already loaded), and then searches for the specified page title. Returns: RETURN_INT = 1 IF the title was found, 0 If NOT found. Parameters: /DB=str The db file name. /T=str The page Title. /C=int 1 = Create page if not found. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} $MACRO SetConfig FROM ALL; def_str( tstr[40] ); return_str := parse_str('/DB=', mparm_str); IF user_id = '' THEN tstr := ''; ELSE tstr := me_path + user_id + '.USR\'; END; IF switch_file( CAPS( tstr + return_str ) ) THEN return_str := tstr + return_str; error_level := 0; ELSE RM('MakeUserPath /DF=1'); error_level := 0; IF NOT( switch_file( return_str ) ) THEN Switch_Window( window_count ); Create_Window; Load_File( Return_Str ); window_attr := $81; END; END; RETURN_INT := 1; IF error_level = 0 THEN tstr := parse_str('/T=', mparm_str ); reg_exp_stat := TRUE; IF tstr <> '' THEN TOF; IF NOT(Search_Fwd( '%|12' + tstr + '$' ,0)) THEN RETURN_INT := 0; IF parse_int( '/C=', mparm_str ) THEN EOF; Insert_mode := true; IF c_col > 1 THEN CR; END; TEXT( '|12' + tstr ); RETURN_INT := 1; END; END; END; ELSE RETURN_INT := 0; END; END_MACRO; $MACRO EDITWINDOW; {*******************************MULTI-EDIT MACRO****************************** Name: EditWindow Description: Creates an editable window for inputing multiple lines of text. Uses the current window. If you only want the text to be examined, not edited, then set the READ_ONLY switch to TRUE before calling EDITWINDOW. Parameters: /X=nn X position /Y=nn Y position /W=nn Width /L=nn Length /T=str Title string. /WW= 1 = enable word wrap. /RM= Right margin for wordwrap. Defaults to 2048. /CC= If 1, line changed color will be M_S_Color else M_T_Color. /NK=nn 1 = Don't kill box when done. /H=str Help string. /NB= 1 = Don't create a box. /SP= 1 = enable <AltS> to do a spell check. /SE= 1 = enable <F6> to do a search. /EV1= Name of event global string to add. (C) Copyright 1989 by American Cybernetics, Inc. ******************************************************************************} DEF_INT( jx, ev_count, x, y, w, l ,T_Mode,Extra_Event, evw ); DEF_STR( event_str[20], allowed_extended_keys[100] ,Extra_Name[20]); refresh := FALSE; Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') + 1); Extra_Event := false; Extra_Name := Parse_Str('/EV1=',MParm_Str); T_Mode := Mode; Mode := Edit; allowed_extended_keys := '|83|72|80|77|75|71|79|116|115|119|117|73|81|132|118'; x := parse_int('/X=', mparm_str ); y := parse_int('/Y=', mparm_str ); w := parse_int('/W=', mparm_str ); l := parse_int('/L=', mparm_str ); if x = 0 THEN x := 1; END; if y = 0 then y := 3; END; IF w = 0 THEN w := 40; END; if l = 0 THEN l := 10; END; push_labels; call test_box_size; call set_events; IF (x + return_int) >= screen_width THEN x := screen_width - return_int - 1; call test_box_size; call set_events; END; set_virtual_display; IF (Parse_Int('/NB=',MParm_Str) = 0) THEN Put_Box( x, y, x + w + 2, y + l + 1, 0, m_b_color, parse_str('/T=', mparm_str), TRUE ); END; Size_Window( x, y, x + w, y + l ); Window_Attr := $86; t_color := m_t_color; IF (Parse_Int('/CC=',MParm_Str)) THEN c_color := m_s_color; ELSE c_color := m_t_color; END; s_color := m_s_color; eof_color := m_s_color; h_color := m_h_color; b_color := m_b_color; Right_Margin := Parse_Int('/RM=',MParm_Str); IF ((Right_Margin < 1) or (Right_Margin > 2048)) THEN right_margin := 2048; END; wrap_stat := Parse_Int('/WW=',MParm_Str); RM('UserIn^CheckEvents /M=2/F=1/G=' + event_str + '/#=' + str(ev_count)); Refresh := TRUE; REDRAW; update_virtual_display; reset_virtual_display; LOOP: JX := window_id; READ_KEY; IF (Extra_Event) THEN IF ((Key1 = Parse_Int('/K1=',Global_Str(Extra_Name))) and (Key2 = Parse_Int('/K2=',Global_Str(Extra_Name)))) THEN EXTRA_EV: Jx := Xpos('/MACRO=',Global_Str(Extra_Name),1); RM(Copy(Global_Str(Extra_Name),jx + 7,254)); refresh := true; Goto LOOP; END; END; IF key1 = 0 THEN IF key2 = 250 THEN RM('UserIn^CheckEvents /M=1/G=' + event_str + '/#=' + str(ev_count)); IF RETURN_INT <> 0 THEN Return_Int := Parse_Int('/R=', return_str); IF return_int = 0 THEN Goto EXIT_LOOP; ELSIF return_int = 1 THEN Goto SPELL_CHECK; ELSIF return_int = 2 THEN Goto SEARCH; ELSIF (extra_event) THEN IF (Return_int = Parse_Int('/R=',Global_Str(Extra_Name))) THEN Goto EXTRA_EV; END; END; ELSE RM( 'MOUSE^MouEvent /M=1/S=1' ); END; ELSIF key2 = 59 THEN Help( Parse_Str('/H=', mparm_str ) ); ELSIF key2 = 31 THEN SPELL_CHECK: RM('SPELL /BC=' + str( box_count ) ); refresh := true; ELSIF key2 = 64 THEN SEARCH: RM('MEUTIL2^SEARCH /BC=' + Str(Box_Count)); refresh := true; ELSE IF xpos( CHAR(key2), allowed_extended_keys, 1) <> 0 THEN Pass_Key( key1, key2 ); END; END; ELSIF key1 = 27 THEN goto EXIT_LOOP; ELSE Pass_Key( key1, key2 ); END; GOTO LOOP; TEST_BOX_SIZE: IF (x + w + 2) >= Screen_Width THEN x := screen_width - 2 - w; END; IF x < 1 THEN x := 1; END; IF (x + w + 2) > Screen_Width THEN w := Screen_Width - x - 2; END; IF (y + l + 1) >= max_window_row THEN y := max_window_row - l - 1; END; IF y < 1 THEN y := 1; END; IF (y + l + 1) >= max_window_row THEN l := max_window_row - y - 1; END; ret; SET_EVENTS: Ev_Count := 1; event_str := '@EV' + Str(Global_Int( 'MENU_LEVEL' )) + '#'; Set_Global_Str(Event_Str + '1', '/T=Done/KC=<ESC>/K1=27/K2=1/R=0'); IF (Parse_Int('/SP=',MParm_Str)) THEN ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/T=Spell check/KC=<AltS>/K1=0/K2=31/R=1'); END; IF (Parse_Int('/SE=',MParm_Str)) THEN ++Ev_Count; Set_Global_Str(Event_Str + Str(Ev_Count), '/T=Search/FL=Search/KC=<F6>/K1=0/K2=64/R=2'); END; IF (Extra_Name <> '') THEN ++Ev_Count; Extra_Event := True; Set_Global_Str(Event_Str + Str(Ev_Count),Global_Str(Extra_Name)); END; RM('UserIn^CheckEvents /M=4/G=' + event_str + '/#=' + str(ev_count) + '/X=' + str(x+1) + '/Y=' + str( y + l ) + '/W=' + str(w)); RET; EXIT_LOOP: Set_Global_Int('MENU_LEVEL', Global_Int('MENU_LEVEL') - 1); Mode := T_Mode; refresh := FALSE; IF parse_int('/NK=', mparm_str) = 0 THEN Kill_Box; END; pop_labels; RM('UserIn^CheckEvents /M=3/G=' + event_str + '/#=' + str(ev_count)); END_MACRO;