home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
brief
/
dbase.m
< prev
next >
Wrap
Text File
|
1986-09-26
|
11KB
|
328 lines
;** 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." )
)
)
)
