Shareware Overload/ShartewareOverload.cdr/database/db3brief.zip/DBASE.M

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." )
        )
    )
)