;**   Last revision: September 26, 1986 at 15:44

;**
;**  This file contains the dBASE specific routines and are auto loaded
;**  in the extended.m file.  The first just runs dBASE all by it's self
;**  while the next 3 run either dFLOW of dBASE with the current buffer
;**  as the command line, it does check if .PRG is the file name for the
;**  current buffer.
;**
;**  NOTE: the autoload for including in extended.m is:
;**  (autoload "dbase" "dbase" "drun" "dflow" "dpp" "dchk" "dstru")
;**
(macro dbase
   (_run "dbase")
)
;**
;** This macro Pretty Prints a .prg file using dFLOW. It calls the
;** _run macro which calls dFLOW progname.prg DF(progname.prg) 
;**
(macro dpp
   (
     (_run "dpp")
     (message "Pretty printed using dFLOW")
   )
)
   ;**
   ;** the following two macros call either dFLOW or dBASE
   ;** with the program name on the command line via the 
   ;** _run macro which checks for .prg buffer.
   ;**
(macro drun
   (_run "drun")
)
(macro dflow
   (_run "dflow")
)
;**
;**		This routine runs the file in the current buffer using dBASE
;**   or dFLOW 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!
;**

(macro _run
	(
		(string	   full_name         ;** Path + name of the file we're running
                  extension         ;** The file name extension
                  prog_name			;** The file name alone
						path					;** The path of the file we're compiling.
						old_path				;** The original path we were on.
                  task              ;** The passed parameter = what to run
						command_line  		;** The DOS dBASE/dFLOW command
		)
      (int        dos_err
                  ret_code
                  line
                  col
      )
		;**
		;**		We get the  name of the file from inq_names
		;**
		(inq_names full_name extension prog_name)
      ;**
      ;** Check that buffer is a prg file
      ;**
      (if (== extension "prg") 
			(
            (get_parm 0 task)
   			;**
   			;**	If the file has been modified, we want to make sure the current
   			;**	version gets run, so we write it to disk.
   			;**
   			(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. 
            		;**
            		(= path (substr full_name 1 (rindex full_name (substr full_name 3 1))))
            		(if (> (strlen path) 3)
            			(= path (substr path 1 (- (strlen path) 1)))
            		)
      				;**
      				;**   We want use dBASE/dFLOW in the same directory as 
      				;**   the program, so we change to the directory where
      				;**	the file is, saving the current directory.
      				;**
      				(getwd path old_path)
      				(cd path)
                  (if (== task "dflow")
                     (sprintf command_line "dFLOW %s" prog_name)
                  ;else
                     (if (== task "drun")
                       (sprintf command_line "dBASE %s" prog_name)
                     ;else
                        (if (== task "dpp")
                           (
                              (sprintf command_line "dFLOW %s DF(" prog_name)
                              (+= command_line prog_name)
                              (+= command_line ")")
                           )
                        ;else
                           (if (== task "dbase")
                              (= command_line "dbase")
                           ;else
                              (error "Improper task in _run macro")
                           )
                        )
                     )
                  )
                  ;**
                  ;**  Since it is possible that some of these run tasks
                  ;**  will delete our file and make a new one, lets delete
                  ;**  the current buffer and reopen it after the DOS cmd.
                  ;**  save and restore current cursor position
                  ;**
              		(inq_position line col)
               	(delete_buffer (inq_buffer))
                  (message command_line)
      				(= dos_err (dos command_line ))
               	(edit_file full_name)
         			(move_abs line col)
                  (center_window_line)
                  ;**
                  ;**  now back to our original path
                  ;**
      				(cd old_path)
               )
            )
         )
		;else
			(error "Current buffer is not a .prg file.")
		)
	)
)
;**   This macro uses dFLOW to make a syntax check on dBASE pgms.

(macro dchk
	(
		(string		file_name			;** The name of the file we're dFLOW chking
						command_line		;** The compile command line.
						path					;** The path of the file we're working on
						old_path				;** The original path we were on.
		)
		(int			loc					;** Generic index place holder.
						ret_code				;** Return code from DOS.
                  err_buf_open
                  err_found
                  err_count
		)
      (global     err_buf_open
                  err_found
                  err_count
      )
		;**
		;**		We get the name of the file from inq_names (the extension is
		;**	put in the command_line variable so we didn't have to declare too
		;**	many strings) and check to see if it is a .prg file.
		;**

		(inq_names path command_line file_name)
		(if (== command_line "prg")
			(
   			;**
   			;**	If the file has been modified, write it to disk.
   			;**
   			(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.
         			;**

         			(= path (substr path 1 (rindex path (substr path 3 1))))
         			(if (> (strlen path) 3)
         				(= path (substr path 1 (- (strlen path) 1)))
         			)
         			(= loc (index file_name "."))
         			(= file_name (+ (substr path 1 2) (substr file_name 1 (- loc 1))))

         			;**
         			;**		We want the .err file to end up in the file's
         			;**	directory, so we change to the directory where the
         			;**	file is, saving the current directory.
         			;**

         			(getwd path old_path)
         			(cd path)

         			;**
         			;**		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.
         			;**
         			(delete_buffer (create_buffer "C Errors" (+ file_name ".err") 1))

                  (if (exist (+ file_name ".err"))
                     (del (+ file_name ".err"))
                  )
         			;**
         			;**   Now call dFLOW to check for errors. Note that dFLOW writes
                  ;**   to std err and we will get messages on screen.
                  ;**
                  (sprintf command_line "dFLOW %s EF(" file_name)
                  (+= command_line file_name)
                  (+= command_line ".err)") 
         		   (message command_line)
         		  	(= ret_code (dos command_line 0))

         			;**
         			;**	dFLOW doesn't know enough to set an error return
         			;**	code, we call next error which will check and if
                  ;**   error found it places the cursor on the error line.
         			;**
         			;**		Otherwise, the temporary file is deleted. Next
               	;**	error macro prints a message telling number of errors
                  ;**   found.
         			;**
                  (= err_found 0)
                  (= err_buf_open 0)
                  (= err_count 0)
                  (next_error)
                  (= prior_msg "No previous error")
                  (if err_found
                     (= err_buf_open 0)
                     (del (+ file_name ".err"))
                  )
                  ;**		Finally, we restore the old directory
                  (cd old_path)
               )
		   	)
         )
		;else
			(error "Current buffer is not a .prg file." )
		)
	)
)

;**
;** A macro to get the .DBF file structure into a filename.stu and
;** load it into a window
;**
(macro dstru
	(
		(string		file_name			;** The name of the file we're dFLOW chking
						command_line		;** The compile command line.
                  full_name
		)
		(int			loc					;** Generic index place holder.
                  found
		)
		;**
		;**		We get the name of the file from inq_names (the extension is
		;**	put in the command_line variable so we didn't have to declare too
		;**	many strings) and check to see if it is a .prg file.
		;**

		(inq_names NULL command_line NULL)
		(if (== command_line "prg")
			(
            (= found 0)
            (while (! found)
               (
                  (get_parm NULL file_name "DBF File: " 30)
                  ;** if we got extension, parse it off
         			(= loc (index file_name "."))
         			(= full_name (substr file_name 1 (- loc 1)))
                  (if (|| (exist (+ full_name ".dbf")) (== file_name ""))
                    (= found  1)
                  )
               )
            )
            ;**
   			;**		We want the .stu file to end up in the file's
   			;**	directory, so we force user to specify path
   			;**	to the dbf file and put filename.stu in that dir.
            ;**   We will use a utility "STRUCTU.EXE" to list the
            ;**   structure an redirect it to a .stu file, the
            ;**    load that file and switch to it...
            ;**
            (if (&& found (!= file_name ""))
                (
                   (= file_name (+ full_name ".stu"))
                   (if (! (exist file_name ))
                     (
                         (sprintf command_line "structur %s >&" full_name)
                         (+= command_line file_name)
                         (message command_line)
                         (dos command_line 0)  
                     )
                   )
                   (edit_file file_name)
                   (message "DBF structure displayed")
                )
            ;else
                (error "Attempt to get structure abandoned ")
            )
   		)
		;else
			(error "Current buffer is not a .prg file." )
		)
	)
)



