From: SMTP%"DSJ@Data.Basix.COM" 10-JUN-1995 22:24:57.99 To: EVERHART CC: Subj: APRIL95.AUTO X-FileServer: Digital Systems Journal source code files Date: Sat, 10 Jun 1995 19:22:43 -0700 Sender: DSJ-Mgr@Data.Basix.COM Errors-To: DSJ-Mgr@Data.Basix.COM Warnings-To: <> From: DSJ-Mgr@Data.Basix.COM Reply-To: DSJ@Data.Basix.COM Subject: APRIL95.AUTO To: EVERHART@arisia.gce.com $! $! AUTOFORM.COM: Full-screen form utility for DCL procedures. $! $! Usage: $! $! AUTOFORM inform indata outform outdata [blank_char] [NODISPLAY] [INSERT] $! $! See file AUTOFORM.DOC for a complete command description and examples. $! $! N.B. logical AUTOFORM_TPUSEC must point to the AUTOFORM VAXTPU section file; $! see README.DOC for more information and AUTOFORM installation instructions. $! $ locals = " LOCALS STATUS I J G AUTOFORM_OPENFILE XXX" + - " P P1 P2 P3 P4 P5 P6 P7 F F1 F2 F3 F4 " $ status=3 $ on control_y then goto cleanup $ on error then goto error $ if (p1.eqs."") ! first parameter, the form specification, is required $ then $ write sys$output - "Usage: AUTOFORM inform indata outform outdata [blank_char] [NODISPLAY] [INSERT]" $ goto badparam $ endif $! $! Check parameters for errors & convert global variable files to temp files. $! $ i = 1 $ nextinp: p = p'i' $ if (p-"()"+"()" .nes. p) ! no global variable file flag - ordinary file $ then $ f = p $ if (f.NES."" .and. i.LE.2 .and. f$search(f).EQS."") ! no such input file $ then $ write sys$output "%AUTOFORM-W-NOFILE, file """,f,""" not found." $ goto badparam $ endif $ else ! parameter is a global variable file $ f = F$GETJPI("","PID") + "_AUTOFORM" + f$string(i) + ".TMP" $ g = p - "()" $ if (locals - (" " + g + " ") .nes. locals) ! avoid local/global ambiguity $ then $ write sys$output - "%AUTOFORM-W-RESERVEDGBL, reserved global var """,g,""" - choose another name." $ goto badparam $ endif $ if (i.LE.2) ! input parameter; create temp file $ then $ if (f$type('g').nes."INTEGER") $ then $ write sys$output - "%AUTOFORM-W-NOINTGLBLVAR, integer global variable """,g,""" not defined." $ goto badparam $ endif $ open/write autoform_openfile 'f' $ j = 1 $ nextglobal: if (j.GT.f$integer('g')) then goto lastglobal $ if (f$type('g''j').eqs."") ! Undefined global variable $ then $ write autoform_openfile "" $ else $ write autoform_openfile 'g''j' $ endif $ j = j + 1 $ goto nextglobal $ lastglobal: close autoform_openfile $ endif $ endif $ f'i' = f $ i = i + 1 $ if (i.LE.4) then goto nextinp $ if (p5.eqs."") then p5 = "_" $ if (p6.eqs."") then p6 = "DISPLAY" $ if ((p6.nes."NODISPLAY").AND.(p6.NES."DISPLAY")) $ then $ write sys$output - "%AUTOFORM-W-BADDISPLAYQUAL, use ""DISPLAY"" or ""NODISPLAY"" not """,p6,"""" $ goto badparam $ endif $ if (p7.eqs."") then p7 = "OVERSTRIKE" $ if ((p7.nes."OVERSTRIKE").AND.(p7.NES."INSERT")) $ then $ write sys$output - "%AUTOFORM-W-BADENTRYMODE, use ""OVERSTRIKE"" or ""INSERT"" not """,p7,"""" $ goto badparam $ endif $! $! Invoke the main VAXTPU program. $! $ define/user_mode/nolog sys$input sys$command $ edit/tpu/'p6'/section=autoform_tpusec/nocommand - "''f1,''f2,''f3,''f4,''p5,''p7'" $! $! Convert temp output files to global variable files and delete temp files. $! $ i = 1 $ nextoutp: p = p'i' $ if (p-"()"+"()" .eqs. p) $ then $ f = f'i' $ if (i.GE.3) ! convert temp file outputs to global variable files $ then $ g = p - "()" $ open/read autoform_openfile 'f' $ j = 1 $ nextrecord: read/end=lastrecord autoform_openfile xxx $ 'g''j' == xxx $ j = j + 1 $ goto nextrecord $ lastrecord: close autoform_openfile $ 'g' == j-1 ! number of "records" in "global variable file" $ endif $ delete 'f'; ! delete temporary file (both inputs and outputs) $ endif $ i = i+1 $ if (i.LE. 4) then goto nextoutp $ EXIT 1 ! normal, successful completion. $ badparam: status = 5 ! cleanup for bad syntax, errors, and interrupts $ goto cleanup $ error: status = $STATUS $ cleanup: if (f$trnlnm("autoform_openfile").NES."") then close autoform_openfile $ if (f$search( F$GETJPI("","PID") + "_AUTOFORM%.TMP").NES."") then - delete 'F$GETJPI("","PID")'_AUTOFORM%.TMP; $ EXIT 'status' = ! ! AUTOFORM.TPU allows full-screen entry into a form specified via a ! text file where _ characters stand for the blanks to be filled in. ! For best results, this program should be invoked via the AUTOFORM.COM ! DCL front-end. See file AUTOFORM.DOC for full usage details for this ! AUTOFORM.COM/AUTOFORM.TPU combination. ! ! To compile this as a VAXTPU section file (c.f. SAVE at end of file) ! ! edit/tpu/nosection/command=autoform/output=autoform_tpusec ! ! To run: ! ! edit/tpu/nocom/section=autoform_tpusec "inform,indata,outform,outdata,c,mode" ! ! -- Add /NODISPLAY for noninteractive "fill in the blanks" applications. ! ! In the above, the DOUBLE QUOTES ARE REQUIRED, autoform_tpusec is ! the name of the VAXTPU section file (containing the compiled VAXTPU code) and ! inform,indata,etc. are as shown below: ! ! inform - text file that contains the form; The _ character is ! used to indicate "blanks" to be filled in. ! ! indata - text file in which the first line is the default value ! for the first field, the second line for the second field, ! etc. Linear order of fields is left-to-right, top-to-bottom. ! ! outform - inform, with default values and user entries filled in. ! Any remaining _ characters are replaced with spaces. ! ! outdata - file containing the data entered into the form, one record ! per field, blank padded to the field width. Linear order of ! fields is left-to-right, top-to-bottom. ! ! c - alternate field indicator character(s) (default is _). ! ! mode - if INSERT, initial text entry is in insert mode; otherwise ! the default, overstrike mode, is used. ! ! You can ommit indata, outform, and/or outdata. However, you must ! include the commas between them. If indata is ommitted, fields ! are initialized with blanks. If outform and/or outdata are ommitted, ! the corresponding file(s) are not written. ! ! ! Return n modulo m for positive n, m ! procedure mod(n, m) return (n - m*(n/m)); ! integer div rounds down endprocedure ! ! Analogue of DCL's F$ELEMENT() ! procedure f_element(n,delim,s) if (n <= 0) then ! pick off leading element return(substr(s,1,index(s+delim,delim)-1)); else if (index(s,delim) = 0) then ! No such element return(delim); else ! recursive step return(f_element(n-1,delim,substr(s,index(s,delim)+1))); endif; endif; endprocedure ! ! Vertical distance (in lines) between two marks. ! procedure vdist(m1,m2) return(get_info(m1,"record_number") - get_info(m2,"record_number")); endprocedure ! ! Horizontal distance (in characters) between two marks. ! procedure hdist(m1,m2) return(get_info(m1,"offset") - get_info(m2,"offset")); endprocedure ! ! Return range expanded on right by one character cell. ! procedure rangeplus(r) local here; here := mark(NONE); position(end_of(r)); move_horizontal(1); rangeplus := create_range(beginning_of(r),mark(NONE),NONE); position(here); endprocedure ! ! Move just beyond the last non-space character in the range. ! procedure last_nonblank(r) position(end_of(r)); loop exitif ((mark(NONE)<=beginning_of(r)) OR (current_character<>" ")); move_horizontal(-1); endloop; if (current_character<>" ") then move_horizontal(1); endif; endprocedure ! ! Returns position just past the last non-space character within the range. ! procedure last_nonblank_mark(r) local here; here := mark(none); last_nonblank(r); last_nonblank_mark := mark(NONE); position(here); endprocedure ! ! Recognize, encode as ranges, and stuff data into, fields indicated by ! contiguous underscores. Overstrike mode in buffer formbuf is assumed. ! procedure encode_form_ranges local field_val, eol; position(beginning_of(formbuf)); ifield := 1; loop ! for each field (one or more contiguous underscores) found field{ifield} := search_quietly(SPAN(blank_char), FORWARD); exitif field{ifield} = 0; modify_range(field{ifield}, , , REVERSE); ! display fields in reverse video position(field{ifield}); copy_text(" "*length(field{ifield})); ! replace underscores with blanks position(databuf); ! copy in next default field value if (mark(NONE)<>end_of(databuf)) then ! (if it exists) field_val := erase_line; position(field{ifield}); copy_text(substr(field_val,1,length(field{ifield}))); endif; position(end_of(field{ifield})); ! prepare to find next field move_horizontal(1); ifield := ifield + 1; endloop; field_count := ifield-1; ! ! In this section we determine the first and last field on each line that ! has fields on it, demarcation markers between fields on the same ! line (midfield{ifield}), and the number of lines with fields on them ! (line_count). The field_move_vertical procedure uses this information ! to help it determine the "closest field" when moving up or down. ! ifield := 0; iline := 0; loop exitif (ifield >= field_count); ifield := ifield + 1; iline := iline + 1; firstfield{iline} := ifield; ! index of the first field on the line position(beginning_of(field{ifield})); eol := search(LINE_END, FORWARD); loop exitif (ifield >= field_count); exitif (beginning_of(field{ifield+1}) > beginning_of(eol)); position(end_of(field{ifield})); move_horizontal( hdist(beginning_of(field{ifield+1}),end_of(field{ifield})) / 2 ); midfield{ifield} := mark(NONE); ! mark between fields ifield and ifield+1 ifield := ifield + 1; endloop; midfield{ifield} := end_of(eol); lastfield{iline} := ifield; ! index of the last field on the line endloop; line_count := iline; endprocedure ! ! "Rubout" the character just before the cursor. Assumes overstrike mode. ! procedure rubout_character local r; if (mark(none) <= beginning_of(field{ifield})) then return; else if (mark(none) > end_of(field{ifield})) then move_horizontal(-1); copy_text(" "); move_horizontal(-1); else r := create_range(mark(NONE),end_of(field{ifield}),NONE); move_horizontal(-1); copy_text(edit(str(r),TRIM_TRAILING)); copy_text(" "); position(r); move_horizontal(-1); endif; endif; endprocedure ! ! Vertical field motion. Use n=-1 for up arrow, n=1 for down arrow. ! procedure field_move_vertical(n) local here; here := mark(NONE); if (iline + n < 1) then ! scroll to see text above first field scroll(current_window, -1); position (here); else if (iline + n > line_count) then ! scroll to see text below last field scroll(current_window, +1); position (here); else ! requested motion within line range iline := iline + n; move_vertical(vdist(beginning_of(field{firstfield{iline}}), mark(NONE))); ifield := firstfield{iline}; loop exitif (ifield >= lastfield{iline}); exitif (midfield{ifield} >= mark(NONE)); ifield := ifield + 1; endloop; if (mark(none) < beginning_of(field{ifield})) then position(beginning_of(field{ifield})); else if (mark(none) > last_nonblank_mark(field{ifield})) then last_nonblank(field{ifield}); endif; endif; ! else we are positioned inside the field already. endif; endif; endprocedure ! ! Return or Enter key processing. ! procedure field_enter if (ifield >= field_count) then ! pressing return on last field => exit. exit_form; else ! move to end of next field ifield := ifield+1; last_nonblank(field{ifield}); if (ifield > lastfield{iline}) then iline := iline + 1; endif; endif; endprocedure ! ! Copy a character into a field at the current editing point. ! procedure field_copy_text(c) local r, t; if (mark(NONE) <= end_of(field{ifield})) then if (NOT autoform_inserting) then copy_text(c); else ! emulate insert mode -- buffer itself is always in overstrike mode. r := create_range(mark(NONE), end_of(field{ifield}), NONE); t := edit(c + str(r), TRIM_TRAILING); if (length(t) <= length(r)) then ! only insert if field has room copy_text(t); position(r); move_horizontal(1); endif; ! else not enough room in field to insert; do nothing. endif; endif; endprocedure ! ! Move left one character within fields. ! procedure field_move_left; if (mark(NONE) > beginning_of(field{ifield})) then move_horizontal(-1); else if (ifield > 1) then ifield := ifield - 1; last_nonblank(field{ifield}); endif; if (ifield < firstfield{iline}) then iline := iline - 1; endif; endif endprocedure ! ! Move right one character within fields. ! procedure field_move_right; if (mark(NONE) < last_nonblank_mark(field{ifield})) then move_horizontal(1); else if (ifield < field_count) then ifield := ifield + 1; position(beginning_of(field{ifield})); endif; if (ifield > lastfield{iline}) then iline := iline + 1; endif; endif endprocedure ! ! Switch between inserting and overstriking characters within each field ! procedure toggle_insert_overstrike if (autoform_inserting) then autoform_inserting := FALSE; else autoform_inserting := TRUE; endif endprocedure ! ! Emulate 8 character tabs (from start of each field) via spaces. ! procedure emulate_tab local spaces; if (NOT autoform_inserting) then ! tabs are always inserting toggle_insert_overstrike; emulate_tab; toggle_insert_overstrike; else ! insert mode spaces := 8 - mod(hdist(mark(NONE), beginning_of(field{ifield})), 8); loop exitif spaces <= 0; field_copy_text(' '); spaces := spaces - 1; endloop; endif endprocedure ! ! Delete the word just before the current cursor location ! procedure delete_prev_word local leading_white, prev_char; leading_white := TRUE; loop exitif mark(NONE) <= beginning_of(field{ifield}); move_horizontal(-1); ! peek ahead at preceeding character prev_char := current_character; move_horizontal(1); if (prev_char <> " ") then leading_white := FALSE; endif; exitif ((NOT leading_white) AND (prev_char = " ")); rubout_character; endloop; endprocedure ! ! Delete all characters before current cursor position to begining of field ! procedure delete_to_bof loop exitif mark(NONE) <= beginning_of(field{ifield}); rubout_character; endloop; endprocedure ! ! Save filled in form, field data, and then exit ! procedure exit_form erase(databuf); position(databuf); ifield := 1; loop exitif ifield > field_count; copy_text(edit(str(field{ifield}), TRIM_TRAILING)); move_horizontal(1); ifield := ifield + 1; endloop; if (f_element(2,",",params + ",,,,")<>"") then write_file(formbuf,f_element(2,",",params)); endif; if (f_element(3,",",params+",,,,")<>"") then write_file(databuf,f_element(3,",",params)); endif; quit; endprocedure ! ! Starts up the form (special "main" procedure called by VAXTPU first) ! procedure TPU$INIT_PROCEDURE field := create_array(1000); ! TPU will auto-extend as needed firstfield := create_array(1000); lastfield := create_array(1000); midfield := create_array(1000); params := get_info(command_line,"file_name") - '"' - '"'; set(COLUMN_MOVE_VERTICAL, ON); !maintain relative position during vert moves TPU$X_MESSAGE_BUFFER := create_buffer("messages"); ! Supresses TPU messages set(NO_WRITE,TPU$X_MESSAGE_BUFFER ,ON); formbuf := create_buffer("formbuf",f_element(0,",",params)); set(NO_WRITE,formbuf,ON); set(OVERSTRIKE,formbuf); set(EOB_TEXT,formbuf,""); formwin := create_window(1,get_info(SCREEN,"original_length"),OFF); databuf := create_buffer("databuf",f_element(1,",",params+",,,,")); set(NO_WRITE,databuf,ON); blank_char := f_element(4,",",params+",_,_,_,_"); encode_form_ranges; ifield := 1; iline := 1; if (f_element(5,",",params) = "INSERT") then ! insert vs overstrike flag autoform_inserting := TRUE; else autoform_inserting := FALSE; endif; if (NOT get_info(command_line,"display")) then exit_form; else map(formwin, formbuf); position(beginning_of(formbuf)); update(formwin); if (field_count < 1) then ! special case of form with no fields--exit exit_form; else last_nonblank(field{ifield}); endif; endif; ! ! Note to the procedurally minded: At this point we have set up all ! the buffers, windows, ranges, (key definitions are compiled in), etc. that ! AUTOFORM needs. We now fall into the main event loop of VAXTPU ! which will respond to each defined key (c.f. procedure define_form_keys) ! and take the appropriate action associated with it. No user code is ! required to implement this main event loop in VAXTPU; it is built in to ! VAXTPU's interpreter. An event-driven architecture -- just one example of ! the excellence of VAXTPU's design. ! endprocedure; ! ! Define keys used by AUTOFORM ! procedure define_form_keys local ichar; ichar := 32; ! define printable ASCII keys loop exitif ichar > 126; define_key(FAO("field_copy_text(ASCII(!SL))",ichar), KEY_NAME(ichar)); ichar := ichar + 1; endloop; define_key("field_enter", ENTER); define_key("field_enter", RET_KEY); define_key("field_move_vertical(1)", DOWN); define_key("field_move_vertical(-1)", UP); define_key("field_move_left", LEFT); define_key("field_move_left", CTRL_D_KEY); define_key("field_move_right", RIGHT); define_key("field_move_right", CTRL_F_KEY); define_key("exit_form", CTRL_Z_KEY); define_key("rubout_character",DEL_KEY); define_key("toggle_insert_overstrike", CTRL_A_KEY); ! VMS line editing define_key("toggle_insert_overstrike", F14); ! keys define_key("last_nonblank(field{ifield})", CTRL_E_KEY); define_key("position(beginning_of(field{ifield}))", CTRL_H_KEY); define_key("position(beginning_of(field{ifield}))", F12); define_key("delete_prev_word", CTRL_J_KEY); define_key("delete_prev_word", F13); define_key("delete_to_bof", CTRL_U_KEY); define_key("refresh", CTRL_R_KEY); define_key("refresh", CTRL_W_KEY); define_key("field_copy_text('0')", KP0); ! Numeric keypad support define_key("field_copy_text('1')", KP1); define_key("field_copy_text('2')", KP2); define_key("field_copy_text('3')", KP3); define_key("field_copy_text('4')", KP4); define_key("field_copy_text('5')", KP5); define_key("field_copy_text('6')", KP6); define_key("field_copy_text('7')", KP7); define_key("field_copy_text('8')", KP8); define_key("field_copy_text('9')", KP9); define_key("field_copy_text('.')", PERIOD); define_key("field_copy_text(',')", COMMA); define_key("field_copy_text('-')", MINUS); define_key("emulate_tab", TAB_KEY); endprocedure ! ! Note: these lines are executed only during compilation, not at runtime ! define_form_keys; ! Compile in key definitions save(get_info(COMMAND_LINE,"output_file"));! and save compiled VAXTPU quit;