;;*
;;*		BRIEF -- Basic Reconfigurable Interactive Editing Facility
;;*
;;*		Written by Dave Nanian and Michael Strickman.
;;*
;;*
;;*		ccompile.m:
;;*
;;*		This file contains replacement macros for the standard BRIEF macros 
;;*      cc and compile_it  for compiling	files.
;;*
;;*		Revision history:
;;*		-----------------
;;*      1-June-1989     Kevin Baradet 
;;*                      Macros (Compile_it) and (CC) modified to provide
;;*                      support for CLARION compiler CCMP. To locate the
;;*                      changes search for the string ";;*" exclusive of
;;*                      the quotation marks.
;;*      Installation:
;;*      -------------
;;*      1) Add the following to your autoexec.bat: 
;;*            SET BCCLA=!"ccmp %%s.cla NO B"
;;*
;;*      2) Add the file CLAINITL.INC to your initials macro file to provide
;;*         next_error, previous_error and error_info support for CLARION
;;*         files along with the autoload function for the replacement
;;*         macros (cc) and (compile_it). To do this add the following at the
;;*         end of your initials macro source file in column 1:
;;*            #include "clainitl.inc"
;;*         Add the following to your initials macro before the (return): 
;;*            (autoload "ccompile" "compile_it" "cc")
;;*         Note: the .inc file should be in the same directory as the 
;;*               initials macro source code (???.m file).
;;*          SEE sample initials macro file ABC.M for more info.
;;*
;;*
;;*      3) Recompile your initials macro
;;*
;;*      4) Compile the file CCOMPILE.M
;;*     
;;*      5) Add the following line to your SEARCH.M file at the end:
;;*         #include "clasrch.inc"
;;*         SEE clasrch.inc for more info
;;*      
;;*      6) Recompile SEARCH.M
;;*
;;*      7) Note: This works with BRIEF v2.1 may work w/ v2.0 also
;;*
;;*      8) For further information on how to use BRIEF programming
;;*         support, read the chapter in the BRIEF Manual "Using BRIEF
;;*         Programming Support". See also source for ERRORFIX.M
;;*
;;*      9) ^N will advance you to the next error, ^P to previous errors,
;;*          Alt-F10 to compile the file in the current buffer. File must
;;*          have an extension of CLA for all of this to work.
;;*
;;*     10)  If you are using BRIEF v2.0 change the string "replacement" to
;;*          the string "macro" in the (cc) and (compile_it) macros below.
;;*
;;*     11)  The next time you load BRIEF, the CLARION compiler support
;;*          will be in effect.

(extern	add_to_path
			next_error
			_check_warnings
         cm
)
;*** <f>
;**
;**		compile_it:
;**
;**		This function automatically compiles the file in the current
;**	buffer.  It uses the "BC<extension>" environment variable to
;**	determine what to do with any given file.  If no "BC<extension>"
;**	environment variable exists for the specific file extension being
;**	compiled, compile_it checks to see if it's ".c", ".m" or ".asm".  If
;**	it's a macro file the "cm" macro is executed; if it's a C file, a
;**	generic "cc" command is used, and if it's an ASM file, the Macro
;**	Assembler is invoked.
;**
;**		Other compilers can be supported very easily.  Simply set a
;**	"BC<extension>" environment variable to the "pass string" you
;**	want to use.  For example, if you wanted to call the (fictitious)
;**	UnderWare C compiler, which has two passes called "under" and "ware",
;**	you'd use the command:
;**
;**			set bcc="under %s;ware %s"
;**
;**		You must place the pass string in quotes.  If you don't, compile_it
;**	calls a macro named whatever is in the pass string.  So, for example,
;**	if you accidently set your pass string using the command:
;**
;**			set bcc=under %s;ware %s
;**
;**	compile_it would call a macro named "under %s;ware %s".  This probably
;**	isn't what you want -- but this feature can be useful if you want to
;**	run some sort of custom macro for the file extension (compile_it does
;**	this when compiling cm files).
;**
;**		Also note that DOS requires you to double any % characters that
;**	appear in a batch file.  So if you were setting the BCC variable in
;**	your autoexec, you would use the line:
;**
;**			set bcc="under %%s;ware %%s"
;**
;**		Each pass begins with the name of the executable program that does
;**	that compilation pass.  That is followed by the a space, the special
;**	string "%s", which is replaced by the filename (with NO extension),
;**	and the multiple pass separation character ";".  If you want to put
;**	a ";" in your pass string, use "\;".
;**
;**		These special characters are very important -- don't forget them!
;**	Remember that the special "%s" string is only replaced by the filename,
;**	not the filename and the extension.  Up to two of these can be specified
;**	in any given pass.  If your compiler requires the extension as well,
;**	place it after this string (e.g. "cc -c %s.c").
;**
;**		If you want to pass options to your compiler, you can place them
;**	either before or after the "%s".  Placing them before puts the option
;**	before the filename, and vice versa.
;**
;**		If you compiler doesn't return an error code, put an exclamation
;**	point in front of the first pass string (either inside or outside the
;**	quotes); this will override the current warnings_only setting and
;**	automatically check for errors in the compiler output.
;**
;;*
;;*  Revision History
;;*  ================
;;*  1-June-1989       Kevin Baradet    Clarion Support added



(replacement compile_it
	(
		(string	extension
					command
		)

      ;;* add the following line
      (global extension)

		(inq_names NULL extension)
		(= command (trim (ltrim (inq_environment (+ "BC" (upper extension))))))

		(if (!= command "")
			(
				(if (index command "\"")
					(
						(int	loc)

						(while (= loc (index command "\""))
							(= command (+ (substr command 1 (- loc 1)) (substr command (+ loc 1))))
						)
						(if (== "!" (substr command 1 1))
							(cc (substr command 2) extension 1)
						;else
							(cc command extension)
						)
					)
				;else
					(if (== "!" (substr command 1 1))
						(execute_macro (substr command 2) 1)
					;else
						(execute_macro command _check_warnings)
					)
				)
			)
		;else
			(
				(if (== extension "m")
					(cm)
				;else
					(if (== extension "asm")
						(cc "masm %s\\;" extension)
					;else
						(if (== extension "c")
							(cc "cc -c %s.c" extension)
						;else
							(error "Can't compile: no BC%s environment variable." (upper extension))
						)
					)
				)
			)
		)
	)
)

;**
;**		cc:
;**
;**		This routine compiles the file in the current buffer using the
;**	passed "pass string" and the BRIEF DOS command.  It needs a lot
;**	of memory to run (you should have at least 256K and start with -M20)
;**	so be careful!
;**
;**		The "pass string" passed should be of the form:
;**
;**			pass_1 %s;pass_2 %s;...pass_n %s
;**
;**		The optional second parameter is an extended file type -- this is
;**	used by the "cm" macro, and to compile other types of files (e.g.
;**	.asm).
;**
;**		If no pass string is specified, it defaults to a generic "cc"
;**	command.  If no extension is specified, it defaults to "c".
;**
;;*
;;*  Revision History
;;*  ================
;;*  1-June-1989       Kevin Baradet    Clarion Support added

(replacement cc
	(
		(string		file_name			;** The name of the file we're compiling.
						command_line		;** The compile command line.
						path					;** The path of the file we're compiling.
						old_path				;** The original path we were on.
						passes				;** The names of the passes.
						error_file			;** The file to put error information in.
		)
		(int			loc					;** Generic index place holder.
						ret_code				;** Return code from DOS.
						buffer_id			;** Buffer ID of error buffer.
						check_warnings		;** Examine resule of compile for errors?
		)
		;**
		;**		We get the name of the file from inq_names (the extension is
		;**	put in the command_line variable so we don't have to declare too
		;**	many strings) and check to see if it is a C file.
		;**

		(if (! (get_parm 1 passes))
			(= passes "c")
		)
		(if (! (get_parm 2 check_warnings))
			(= check_warnings _check_warnings)
		)
		(inq_names path command_line file_name)
		(= ret_code 1)

		(if (== command_line passes)
			(
			;**
			;**		If the file has been modified, we want to make sure the
			;**	current version gets compiled, so we write it to disk.
			;**
			;**		Note that if the user does not specify a pass string, it
			;**	defaults to a generic "cc" command, which works with the
			;**	Wizard C compiler (and a few others).
			;**

				(if (! (get_parm 0 passes))
					(= passes "cc -c %s.c")
				)
				(if (inq_modified)
					(
						(int			old_msg_level)

						(= old_msg_level (inq_msg_level))
						(set_msg_level 0)
						(= ret_code (write_buffer))
						(set_msg_level old_msg_level)
					)
				)
				(if (>= ret_code 0)
					(
						;**
						;**		Now we parse the filename off the path string,
						;**	making sure to handle the possible presence of forward
						;**	and backward slash characters.  We then replace the
						;**	file_name's ".c" with ".err" for redirection purposes.
						;**
		
						(= path (substr path 1 (rindex path (substr path 3 1))))

						(if (> (strlen path) 3)
							(= path (substr path 1 (- (strlen path) 1)))
						)
						(= file_name (substr file_name 1 (- (index file_name ".") 1)))
						(= error_file (+ file_name ".err"))
						(= ret_code 0)
		
						;**
						;**		We want the .obj file to end up in the file's
						;**	directory, so we change to the directory where the
						;**	file is, saving the current directory.  We also make
						;**	the file's drive the default drive.
						;**
		
						(getwd "" command_line)
						(getwd path old_path)
						(= old_path (+ (substr command_line 1 1) (substr old_path 2)))
						(cd path)
						(cd (substr path 1 2))
		
						;**
						;**		If there is already a buffer for the error file, we
						;**	"create" it (create_buffer returns the ID of a buffer
						;**	that already existed) and then delete it immediately.
						;**	Note that under some very obscure circumstances, the
						;**	create_buffer call could fail.  If it does, it'll
						;**	return 0, which is an invalid buffer id.  We check for
						;**	this case since delete_buffer does not.
						;**

						(if (= buffer_id (create_buffer "C Errors" error_file 1))
							(delete_buffer buffer_id)
						)

						;**
						;**		This loop goes through each pass of the compiler,
						;**	checks to see if the return code was OK, and, if so,
						;**	continues along.  If an error occurs, the loop exits
						;**	immediately.
						;**
		
						(while (&& (! ret_code) (strlen passes))
							(
								(if (= loc (search_string "[~\\\\]\\c;" passes))
									(
										(= command_line (substr passes 1 (- loc 1)))
										(= passes (substr passes (+ loc 1)))
									)
								;else
									(
										(= command_line passes)
										(= passes "")
									)
								)

                        ;;* Original line is below
								;;* (+= command_line (+ " >&" error_file))

                        ;;**** Change Begins ****
                        ;;* If we're not compiling a Clarion .CLA
                        ;;*  source code file, we want to redirect
                        ;;*  the standard error output to a .ERR file.
                        ;;* The Clarion compiler will do the redirection
                        ;;*  automatically for us if there are compile
                        ;;*  time errors

                        (if (!= (upper extension) "CLA")
                           (
								     (+= command_line (+ " >&" error_file))
                           )
                        )
                        ;;* Change ends

								(while (= loc (search_string "\\\\;" command_line))
									(= command_line (+ (substr command_line 1 (- loc 1)) (substr command_line (+ loc 1))))
								)
								(sprintf command_line command_line file_name file_name file_name file_name file_name file_name file_name)
								(message command_line)
								(= ret_code (dos command_line 0))
							)
						)

                  ;;* Since the Clarion Compiler doesn't return an errorcode,
                  ;;* we need to check to see if an error file was created by
                  ;;* the compiler. If the error file exists, then there were 
                  ;;* compile time errors so we must manually set the 
                  ;;* returncode to a non-zero value.

						(if (== (upper extension) "CLA")
                     (
                        (if (exist error_file) (= ret_code 1) (= ret_code 0))
                     )
                  )
                  ;;* Change Ends

						;**
						;**		Finally, we restore the old directory.  If the
						;**	compilation did not succeed, the next_error macro
						;**	is called to place the cursor under the error.
						;**
						;**		Otherwise, the temporary file is deleted and a
						;**	message is printed.
						;**
		
						(if (> ret_code 0)
							(next_error)
						;else
							(
								(if (|| (< ret_code 0) (|| (! check_warnings) (! (next_error 2))))
									(
										(del error_file)

										(if (== ret_code 0)
											(message "Compilation successful.")
										)
									)
								)
							)
						)
						(cd (substr old_path 3))
						(cd (substr old_path 1 2))
					)
				)
			)
		;else
			(error "Current buffer is not a .%s file." passes)
		)
		(returns ret_code)
	)
)
