PROCEDURE lsi_compile +LOCAL compile_string, ! DCL command string@ diag_file, ! DIAG filename associated with current buffer) buf_name, ! Current buffer's name6 line_count, ! number of lines to saved positionC save_offset, ! saved character offset for restoring position save_spot, ! local marker$ this_buffer, ! current buffer( this_position, ! current position@ unsupported, ! indicates if language supports diagnosticsD full_filename, ! full filename associated with current buffer/ dev, dir, file, ext, ! Parts of file spec= filename, ! filename associated with current bufferD old_timer_msg; ! Old message associated with TPU timer on_error& if error = tpu$_createfail then; message ("compile subprocess could not be created"); return (0); endif; endon_error;!+! Save current position!-! this_buffer := current_buffer; this_position := MARK(NONE);3 save_offset := GET_INFO (this_buffer, "offset");) POSITION (BEGINNING_OF (this_buffer)); line_count := 0; LOOP) EXITIF MARK(NONE) >= this_position; MOVE_VERTICAL (10);# line_count := line_count + 10 ENDLOOP;= IF line_count > GET_INFO (this_buffer,"record_count") THEN9 line_count := GET_INFO (this_buffer,"record_count") ENDIF; LOOP) EXITIF MARK(NONE) <= this_position; MOVE_VERTICAL (-1);! line_count := line_count -1 ENDLOOP;!+! Build the compile string!-8 filename := GET_INFO (CURRENT_BUFFER, "output_file");0 IF GET_INFO (filename, "TYPE") = INTEGER THEN8 filename := GET_INFO (CURRENT_BUFFER, "file_name") ENDIF;1 buf_name := GET_INFO (CURRENT_BUFFER, "name");0 dev := FILE_PARSE (filename, "", "", DEVICE);3 dir := FILE_PARSE (filename, "", "", DIRECTORY);. file:= FILE_PARSE (filename, "", "", NAME);. ext := FILE_PARSE (filename, "", "", TYPE); diag_file := file + ".DIA";+ full_filename := dev + dir + file + ext; filename := file + ext;!+-! Build compile string based on file type!- unsupported := 0;! - - - Ada IF ext = ".ADA" THENC compile_string := "ADA/NOOPT/DEBUG " + filename + " /DIAG=" + diag_file ENDIF;! - - - FORTRAN IF ext = ".FOR" THENC compile_string := "FOR/NOOPT/DEBUG " + filename + " /DIAG=" + diag_file ENDIF;! - - - SCAN IF ext = ".SCN" THEND compile_string := "SCAN/NOOPT/DEBUG " + filename + " /DIAG=" + diag_file ENDIF; ! - - - LATEX IF ext = ".TEX" THEN unsupported := 3;1 compile_string := "LATEX/BATCH " + filename ENDIF;! - - - JOVIAL= IF (ext = ".J73") OR (ext = ".CPL") OR (ext = ".JOV") THEN unsupported := 2;0 compile_string := "LSE$JOVIAL " + filename ENDIF;"! - - - ACT LINKER or 1750A LINKER+ IF (ext = ".LOD") OR (ext = ".CTL") THEN unsupported := 1;0 compile_string := "LSE$LINKER " + filename ENDIF;*! - - - ........ INSERT NEW LANGUAGES HERE! - - - **** UNKNOWN **** IF compile_string = "" THEN> MESSAGE ("Unsupported file type - compilation aborted"); RETURN ENDIF;!+2! Check for presence of lsi$compile_qualifiers!-> IF GET_INFO (lsi$compile_qualifiers, "TYPE") <> STRING THEN# lsi$compile_qualifiers := ""; ENDIF;<!+ <! Only append compile qualifiers if a supported language!- IF unsupported = 0 THEN? compile_string := compile_string + lsi$compile_qualifiers ENDIF;!+ ! Create buffer if necessary!- 5 IF GET_INFO (lsi_dcl_buffer, 'type') <> BUFFER 5 THEN = lsi_dcl_buffer := create_buffer ("DCL/compile Window");% SET (NO_WRITE, lsi_dcl_buffer);) SET (EOB_TEXT, lsi_dcl_buffer, "");" SET (SYSTEM, lsi_dcl_buffer)5 ENDIF; !+$! Create subprocess if necessary!-L if (get_info (lsi_dcl_process, "type") = unspecified) or L (lsi_dcl_process = 0) then 6 message ("Creating compilation subprocess...");H lsi_dcl_process := create_process (lsi_dcl_buffer, "$ set noon");!+0! Check for presence of lsi$process_name!-; IF GET_INFO (lsi$process_name, "TYPE") <> STRING THEN lsi$process_name := "" ELSE IF lsi$process_name <> "" THENA send ("$ set proc/name="+lsi$process_name, lsi_dcl_process); ENDIF ENDIF;- send ("$ set verify", lsi_dcl_process);P ENDIF; !+"! update buffer being compiled!-0 IF GET_INFO (this_buffer,"modified") = 1 THEN WRITE_FILE (this_buffer); ENDIF; SET (SUCCESS,OFF); ERASE(this_buffer);( POSITION (BEGINNING_OF(this_buffer)); READ_FILE (full_filename); WRITE_FILE (this_buffer); SET (SUCCESS,ON);!+! move to proper position!-) POSITION (BEGINNING_OF (this_buffer)); MOVE_VERTICAL (line_count);! MOVE_HORIZONTAL (save_offset);!+! flush out files!- lsi_flush_buffers;!+7! set the default directory in the subprocess, then! perform the compilation!- dir := dev + dir;% POSITION (END_OF(lsi_dcl_buffer)); MOVE_HORIZONTAL (-1); SPLIT_LINE; COPY_TEXT("$ ");9 SEND ('IF F$SEARCH("' + filename + '").EQS."" THEN ' +' 'SET DEF '+dir, lsi_dcl_process); MESSAGE (compile_string);7 old_timer_msg := GET_INFO (SYSTEM, 'timed_message');! SET (TIMER, ON, 'Compiling ');* SEND (compile_string, lsi_dcl_process); IF old_timer_msg = '' THEN SET (TIMER, ON) ELSE$ SET (TIMER, ON, old_timer_msg) ENDIF;!+"! split the line in DCL Buffer!-% POSITION (END_OF(lsi_dcl_buffer)); SPLIT_LINE; COPY_TEXT("$ "); POSITION (this_buffer);!+L! If the language does not produce diagnostics, then display compilation9! results in the DCL buffer. Otherwise, call REVIEW.!- CASE unsupported FROM 0 TO 3F [0] : lse$do_command ("REVIEW/FILE="+dir+diag_file+" "+buf_name) [1] :) IF (current_window = lse$top_window) OR) (current_window = lse$bottom_window) THEN lse$$other_window;, if CURRENT_BUFFER <> lsi_dcl_buffer then- MAP (CURRENT_WINDOW, lsi_dcl_buffer); ENDIF;. SET (STATUS_LINE, CURRENT_WINDOW, REVERSE,7 " Compilation Results") ELSE lse$number_of_windows := 2; UNMAP (lse$main_window);& MAP (lse$top_window, this_buffer);) lse$set_status_line (lse$top_window); UPDATE (lse$top_window);, MAP (lse$bottom_window, lsi_dcl_buffer);. SET (STATUS_LINE, CURRENT_WINDOW, REVERSE,7 " Compilation Results") ENDIF;# POSITION(END_OF(CURRENT_BUFFER)); MOVE_HORIZONTAL (-1); lse$$other_window [2] : lsi_jovial_review [3] : lsi_latex_review ENDCASE;ENDPROCEDURE ! lsi_compile6DEFINE_KEY ('lsi_compile', KEY_NAME ('C', SHIFT_KEY), 'compile/review');