home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / db3brief.zip / DBASE.M < prev    next >
Text File  |  1986-09-26  |  11KB  |  328 lines

  1. ;**   Last revision: September 26, 1986 at 15:44
  2.  
  3. ;**
  4. ;**  This file contains the dBASE specific routines and are auto loaded
  5. ;**  in the extended.m file.  The first just runs dBASE all by it's self
  6. ;**  while the next 3 run either dFLOW of dBASE with the current buffer
  7. ;**  as the command line, it does check if .PRG is the file name for the
  8. ;**  current buffer.
  9. ;**
  10. ;**  NOTE: the autoload for including in extended.m is:
  11. ;**  (autoload "dbase" "dbase" "drun" "dflow" "dpp" "dchk" "dstru")
  12. ;**
  13. (macro dbase
  14.    (_run "dbase")
  15. )
  16. ;**
  17. ;** This macro Pretty Prints a .prg file using dFLOW. It calls the
  18. ;** _run macro which calls dFLOW progname.prg DF(progname.prg) 
  19. ;**
  20. (macro dpp
  21.    (
  22.      (_run "dpp")
  23.      (message "Pretty printed using dFLOW")
  24.    )
  25. )
  26.    ;**
  27.    ;** the following two macros call either dFLOW or dBASE
  28.    ;** with the program name on the command line via the 
  29.    ;** _run macro which checks for .prg buffer.
  30.    ;**
  31. (macro drun
  32.    (_run "drun")
  33. )
  34. (macro dflow
  35.    (_run "dflow")
  36. )
  37. ;**
  38. ;**        This routine runs the file in the current buffer using dBASE
  39. ;**   or dFLOW and the BRIEF DOS command.  It needs a lot of memory to
  40. ;**   run (you should have at least 256K and start with -M20) so be careful!
  41. ;**
  42.  
  43. (macro _run
  44.     (
  45.         (string       full_name         ;** Path + name of the file we're running
  46.                   extension         ;** The file name extension
  47.                   prog_name            ;** The file name alone
  48.                         path                    ;** The path of the file we're compiling.
  49.                         old_path                ;** The original path we were on.
  50.                   task              ;** The passed parameter = what to run
  51.                         command_line          ;** The DOS dBASE/dFLOW command
  52.         )
  53.       (int        dos_err
  54.                   ret_code
  55.                   line
  56.                   col
  57.       )
  58.         ;**
  59.         ;**        We get the  name of the file from inq_names
  60.         ;**
  61.         (inq_names full_name extension prog_name)
  62.       ;**
  63.       ;** Check that buffer is a prg file
  64.       ;**
  65.       (if (== extension "prg") 
  66.             (
  67.             (get_parm 0 task)
  68.                ;**
  69.                ;**    If the file has been modified, we want to make sure the current
  70.                ;**    version gets run, so we write it to disk.
  71.                ;**
  72.                (if (inq_modified)
  73.                (
  74.                      (int            old_msg_level)
  75.  
  76.                         (= old_msg_level (inq_msg_level))
  77.                         (set_msg_level 0)
  78.                         (= ret_code (write_buffer))
  79.                         (set_msg_level old_msg_level)
  80.                )
  81.             )
  82.                 (if (>= ret_code 0)
  83.                     (
  84.                     ;**
  85.                     ;**        Now we parse the filename off the path string,
  86.                     ;**    making sure to handle the possible presence of forward
  87.                     ;**    and backward slash characters. 
  88.                     ;**
  89.                     (= path (substr full_name 1 (rindex full_name (substr full_name 3 1))))
  90.                     (if (> (strlen path) 3)
  91.                         (= path (substr path 1 (- (strlen path) 1)))
  92.                     )
  93.                       ;**
  94.                       ;**   We want use dBASE/dFLOW in the same directory as 
  95.                       ;**   the program, so we change to the directory where
  96.                       ;**    the file is, saving the current directory.
  97.                       ;**
  98.                       (getwd path old_path)
  99.                       (cd path)
  100.                   (if (== task "dflow")
  101.                      (sprintf command_line "dFLOW %s" prog_name)
  102.                   ;else
  103.                      (if (== task "drun")
  104.                        (sprintf command_line "dBASE %s" prog_name)
  105.                      ;else
  106.                         (if (== task "dpp")
  107.                            (
  108.                               (sprintf command_line "dFLOW %s DF(" prog_name)
  109.                               (+= command_line prog_name)
  110.                               (+= command_line ")")
  111.                            )
  112.                         ;else
  113.                            (if (== task "dbase")
  114.                               (= command_line "dbase")
  115.                            ;else
  116.                               (error "Improper task in _run macro")
  117.                            )
  118.                         )
  119.                      )
  120.                   )
  121.                   ;**
  122.                   ;**  Since it is possible that some of these run tasks
  123.                   ;**  will delete our file and make a new one, lets delete
  124.                   ;**  the current buffer and reopen it after the DOS cmd.
  125.                   ;**  save and restore current cursor position
  126.                   ;**
  127.                       (inq_position line col)
  128.                    (delete_buffer (inq_buffer))
  129.                   (message command_line)
  130.                       (= dos_err (dos command_line ))
  131.                    (edit_file full_name)
  132.                      (move_abs line col)
  133.                   (center_window_line)
  134.                   ;**
  135.                   ;**  now back to our original path
  136.                   ;**
  137.                       (cd old_path)
  138.                )
  139.             )
  140.          )
  141.         ;else
  142.             (error "Current buffer is not a .prg file.")
  143.         )
  144.     )
  145. )
  146. ;**   This macro uses dFLOW to make a syntax check on dBASE pgms.
  147.  
  148. (macro dchk
  149.     (
  150.         (string        file_name            ;** The name of the file we're dFLOW chking
  151.                         command_line        ;** The compile command line.
  152.                         path                    ;** The path of the file we're working on
  153.                         old_path                ;** The original path we were on.
  154.         )
  155.         (int            loc                    ;** Generic index place holder.
  156.                         ret_code                ;** Return code from DOS.
  157.                   err_buf_open
  158.                   err_found
  159.                   err_count
  160.         )
  161.       (global     err_buf_open
  162.                   err_found
  163.                   err_count
  164.       )
  165.         ;**
  166.         ;**        We get the name of the file from inq_names (the extension is
  167.         ;**    put in the command_line variable so we didn't have to declare too
  168.         ;**    many strings) and check to see if it is a .prg file.
  169.         ;**
  170.  
  171.         (inq_names path command_line file_name)
  172.         (if (== command_line "prg")
  173.             (
  174.                ;**
  175.                ;**    If the file has been modified, write it to disk.
  176.                ;**
  177.                (if (inq_modified)
  178.                    (
  179.                        (int            old_msg_level)
  180.  
  181.                        (= old_msg_level (inq_msg_level))
  182.                        (set_msg_level 0)
  183.                        (= ret_code (write_buffer))
  184.                        (set_msg_level old_msg_level)
  185.                    )
  186.                )
  187.                (if (>= ret_code 0)
  188.                    (
  189.                      ;**
  190.                      ;**        Now we parse the filename off the path string,
  191.                      ;**    making sure to handle the possible presence of forward
  192.                      ;**    and backward slash characters.
  193.                      ;**
  194.  
  195.                      (= path (substr path 1 (rindex path (substr path 3 1))))
  196.                      (if (> (strlen path) 3)
  197.                          (= path (substr path 1 (- (strlen path) 1)))
  198.                      )
  199.                      (= loc (index file_name "."))
  200.                      (= file_name (+ (substr path 1 2) (substr file_name 1 (- loc 1))))
  201.  
  202.                      ;**
  203.                      ;**        We want the .err file to end up in the file's
  204.                      ;**    directory, so we change to the directory where the
  205.                      ;**    file is, saving the current directory.
  206.                      ;**
  207.  
  208.                      (getwd path old_path)
  209.                      (cd path)
  210.  
  211.                      ;**
  212.                      ;**        If there is already a buffer for the error file, we
  213.                      ;**    "create" it (create_buffer returns the ID of a buffer
  214.                      ;**    that already existed) and then delete it immediately.
  215.                      ;**
  216.                      (delete_buffer (create_buffer "C Errors" (+ file_name ".err") 1))
  217.  
  218.                   (if (exist (+ file_name ".err"))
  219.                      (del (+ file_name ".err"))
  220.                   )
  221.                      ;**
  222.                      ;**   Now call dFLOW to check for errors. Note that dFLOW writes
  223.                   ;**   to std err and we will get messages on screen.
  224.                   ;**
  225.                   (sprintf command_line "dFLOW %s EF(" file_name)
  226.                   (+= command_line file_name)
  227.                   (+= command_line ".err)") 
  228.                     (message command_line)
  229.                        (= ret_code (dos command_line 0))
  230.  
  231.                      ;**
  232.                      ;**    dFLOW doesn't know enough to set an error return
  233.                      ;**    code, we call next error which will check and if
  234.                   ;**   error found it places the cursor on the error line.
  235.                      ;**
  236.                      ;**        Otherwise, the temporary file is deleted. Next
  237.                    ;**    error macro prints a message telling number of errors
  238.                   ;**   found.
  239.                      ;**
  240.                   (= err_found 0)
  241.                   (= err_buf_open 0)
  242.                   (= err_count 0)
  243.                   (next_error)
  244.                   (= prior_msg "No previous error")
  245.                   (if err_found
  246.                      (= err_buf_open 0)
  247.                      (del (+ file_name ".err"))
  248.                   )
  249.                   ;**        Finally, we restore the old directory
  250.                   (cd old_path)
  251.                )
  252.                )
  253.          )
  254.         ;else
  255.             (error "Current buffer is not a .prg file." )
  256.         )
  257.     )
  258. )
  259.  
  260. ;**
  261. ;** A macro to get the .DBF file structure into a filename.stu and
  262. ;** load it into a window
  263. ;**
  264. (macro dstru
  265.     (
  266.         (string        file_name            ;** The name of the file we're dFLOW chking
  267.                         command_line        ;** The compile command line.
  268.                   full_name
  269.         )
  270.         (int            loc                    ;** Generic index place holder.
  271.                   found
  272.         )
  273.         ;**
  274.         ;**        We get the name of the file from inq_names (the extension is
  275.         ;**    put in the command_line variable so we didn't have to declare too
  276.         ;**    many strings) and check to see if it is a .prg file.
  277.         ;**
  278.  
  279.         (inq_names NULL command_line NULL)
  280.         (if (== command_line "prg")
  281.             (
  282.             (= found 0)
  283.             (while (! found)
  284.                (
  285.                   (get_parm NULL file_name "DBF File: " 30)
  286.                   ;** if we got extension, parse it off
  287.                      (= loc (index file_name "."))
  288.                      (= full_name (substr file_name 1 (- loc 1)))
  289.                   (if (|| (exist (+ full_name ".dbf")) (== file_name ""))
  290.                     (= found  1)
  291.                   )
  292.                )
  293.             )
  294.             ;**
  295.                ;**        We want the .stu file to end up in the file's
  296.                ;**    directory, so we force user to specify path
  297.                ;**    to the dbf file and put filename.stu in that dir.
  298.             ;**   We will use a utility "STRUCTU.EXE" to list the
  299.             ;**   structure an redirect it to a .stu file, the
  300.             ;**    load that file and switch to it...
  301.             ;**
  302.             (if (&& found (!= file_name ""))
  303.                 (
  304.                    (= file_name (+ full_name ".stu"))
  305.                    (if (! (exist file_name ))
  306.                      (
  307.                          (sprintf command_line "structur %s >&" full_name)
  308.                          (+= command_line file_name)
  309.                          (message command_line)
  310.                          (dos command_line 0)  
  311.                      )
  312.                    )
  313.                    (edit_file file_name)
  314.                    (message "DBF structure displayed")
  315.                 )
  316.             ;else
  317.                 (error "Attempt to get structure abandoned ")
  318.             )
  319.            )
  320.         ;else
  321.             (error "Current buffer is not a .prg file." )
  322.         )
  323.     )
  324. )
  325.  
  326.  
  327.  
  328.