Piper's Pit BBS/FTP: ibm 0040 - 0049/ibm0040-0049/ibm0040.tar/ibm0040/DBRIEF.ZIP/SOURCE/PREPROC.M

Text File | 1991-03-21 | 10.2 KB | 381 lines

;dBRIEF Pre-Processor - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro pre
    (
        (int                dpp_start_buffer
                            dpp_flag
        )
        (string            dpp_extension
                            dpp_buffer
                            dpp_argument
        )
        (if (get_parm 0 dpp_argument "Preprocess current or all PRE buffers? [cA]: " 1 "A")
            (
                (_sv)
                (= dpp_flag 1)
                (= dpp_start_buffer (inq_buffer))
                (while (== dpp_flag 1)
                    (
                        (inq_names NULL dpp_extension dpp_buffer)
                        (if (== (upper dpp_extension) "PRE")
                            (
                                (= dbr_current_buffer (inq_buffer))
                                (_preprocess)
                                (set_buffer dbr_current_buffer)
                                (attach_buffer dbr_current_buffer)
                            )
                        )
                        (set_buffer (next_buffer))
                        (attach_buffer (inq_buffer))
                        (if (|| (== dpp_start_buffer (inq_buffer))(== (upper dpp_argument) "C"))
                            (= dpp_flag 0)
                        )
                    )
                )
                (if (== dpp_extension "pre")
                    (_display_popup_message "Preprocessing completed." "" 0)
                ;else
                    (if (== (upper dpp_argument) "C")
                        (_display_popup_message "Unable to preprocess %s extension." (upper dpp_extension) 1)
                    ;else
                        (_display_popup_message "Preprocessing completed." "" 0)
                    )
                )
                (set_buffer dpp_start_buffer)
                (attach_buffer dpp_start_buffer)
            )
        )
    )
)
(macro _preprocess
    (
        (string            dpp_full_name
                            dpp_extension
                            dpp_buffer_name
                            dpp_prg_name
        )
        (inq_names dpp_full_name dpp_extension dpp_buffer_name)
        (message "Preprocessing %s..." (upper dpp_buffer_name))
        (if (inq_modified)
            (write_buffer)
        )
        (= dpp_prg_name (+ (substr dpp_buffer_name 1 (- (index dpp_buffer_name ".") 1)) (+ "." (_get_dialect_info dbr_dialect 3))))
        (if (exist dpp_prg_name)
            (del dpp_prg_name)
        )
        (edit_file dpp_prg_name)
        (top_of_buffer)
        (drop_anchor)
        (end_of_buffer)
        (delete_block)
        (read_file dpp_full_name)
        (top_of_buffer)
        (_import_includes dpp_buffer_name)
        (_translate_defines dpp_buffer_name)
        (_translate_ifdefs dpp_buffer_name)
        (_translate_objects dpp_buffer_name)
    )
)
(macro _import_includes
    (
        (string            dpp_include_file
                            dpp_buffer_name
        )
        (get_parm 0 dpp_buffer_name)
        (top_of_buffer)
        (while (search_fwd "<{ @}|{\\t@}#include " 1 0)
            (
                (= temp_str (ltrim (read)))
                (= temp_str (substr temp_str (+ (index temp_str "\"") 1)))
                (= dpp_include_file (substr temp_str 1 (- (index temp_str "\"") 1)))
                (message "Preprocessing %s..." (+ (+ (upper dpp_buffer_name) ": ") dpp_include_file))
                (beginning_of_line)
                (delete_to_eol)
                (insert (+ "*     dPP Included: " dpp_include_file))
                (beginning_of_line)
                (save_position)
                (move_rel 1 0)
                (insert "#beginning_of_include\n")
                (read_file dpp_include_file)
                (insert "#end_of_include\n")
                (restore_position)
            )
        )
    )
)
(macro _translate_defines
    (
        (int                dpp_x
                            dpp_y
        )
        (string            dpp_symbol
                            dpp_constant
                            dpp_parameter
                            dpp_formula
                            dpp_define
                            dpp_pattern
                            dpp_param
                            dpp_buffer_name
                            dpp_symbol_new
                            temp_str_c
                            symbol
        )
        (get_parm 0 dpp_buffer_name)
        (top_of_buffer)
        (while (search_fwd "<{ @}|{\\t@}#define " 1 0)
            (
                (= temp_str (ltrim (read)))
                (= temp_str (ltrim (substr temp_str (index temp_str " "))))
                (= dpp_define temp_str)
                (delete_line)
                (save_position)
                (= dpp_symbol (trim (substr temp_str 1 (- (index temp_str " ") 1))))
                (if (index dpp_symbol "(")
                    (
                        (= dpp_parameter (substr dpp_symbol (+ (index dpp_symbol "(") 1)))
                        (= dpp_parameter (substr dpp_parameter 1 (- (index dpp_parameter ")") 1)))
                        (= dpp_symbol (substr dpp_symbol 1 (index temp_str "(")))
                        (= dpp_formula (trim (ltrim (substr temp_str (index temp_str " ")))))
                        (= dpp_pattern (+ dpp_symbol "\\c"))
                        (message "Preprocessing %s..." (+ (+ (upper dpp_buffer_name) ": ") (+ dpp_symbol ")")))
                        (while (search_fwd dpp_pattern 1 0)
                            (
                                (= dpp_param (read))
                                (= dpp_param (substr dpp_param 1 (- (index dpp_param ")") 1)))
                                (beginning_of_line)
                                (= temp_str_c (read))
                                (drop_anchor)
                                (end_of_line)
                                (translate (+ (+ dpp_symbol "*") ")") dpp_formula 1 1 1 1 0)
                                (end_of_line)
                                (translate dpp_parameter dpp_param 1 1 1 1 0)
                                (raise_anchor)
                                (inq_position dpp_x dpp_y)
                                (beginning_of_line)
                                (= temp_str (read))
                                (beginning_of_line)
                                (if (&& (index temp_str "&&")(!= dbr_comment_tab 0))
                                    (
                                        (delete_to_eol)
                                        (insert (trim (substr temp_str 1 (- (index temp_str "&&") 1))))
                                        (if (<  (strlen (trim (substr temp_str 1 (- (index temp_str "&&") 1)))) dbr_comment_tab)
                                            (move_abs 0 dbr_comment_tab)
                                        ;else
                                            (
                                                (end_of_line)
                                                (move_rel 0 2)
                                            )
                                        )
                                        (insert (trim (substr temp_str_c (index temp_str_c "&&"))))
                                    )
                                )
                                (if (|| (== (substr (ltrim temp_str_c) 1 1) "*") (== (substr (ltrim (upper temp_str_c)) 1 4) "NOTE"))
                                    (
                                        (insert (trim temp_str_c))
                                        (delete_to_eol)
                                    )
                                )
                                (move_abs dpp_x dpp_y)
                            )
                        )
                    )
                ;else (it must be a constant #define)
                    (
                        (= dpp_constant (trim (ltrim (substr temp_str (index temp_str " ")))))
                        (message "Preprocessing %s..." (+ (+ (upper dpp_buffer_name) ": ") dpp_symbol))
                        (sprintf symbol "<|[ +/=*\\t]\\c%s[ +/=*\\t\\n]" (trim dpp_symbol))
                        (while (search_fwd symbol 1 0)
                            (
                                ;(beginning_of_line)
                                ;(= temp_str_c (read))
                                (drop_anchor)
                                (end_of_line)
                                (translate (trim dpp_symbol) dpp_constant 1 1 1 1)
                                (raise_anchor)
                                (inq_position dpp_x dpp_y)
                                (beginning_of_line)
                                (= temp_str (read))
                                (if (&& (index temp_str "&&")(!= dbr_comment_tab 0))
                                    (
                                        (beginning_of_line)
                                        (delete_to_eol)
                                        (insert (trim (substr temp_str 1 (- (index temp_str "&&") 1))))
                                        (if (< (strlen (trim (substr temp_str 1 (- (index temp_str "&&") 1)))) dbr_comment_tab)
                                            (move_abs 0 dbr_comment_tab)
                                        ;else
                                            (
                                                (end_of_line)
                                                (move_rel 0 2)
                                            )
                                        )
                                        (insert (trim (substr temp_str_c (index temp_str_c "&&"))))
                                    )
                                )
                                (if (|| (== (substr (ltrim temp_str_c) 1 1) "*") (== (substr (ltrim (upper temp_str_c)) 1 4) "NOTE"))
                                    (
                                        (insert (trim temp_str_c))
                                        (delete_to_eol)
                                    )
                                )
                                (move_abs dpp_x dpp_y)
                            )
                        )
                    )
                )
                (restore_position)
                (insert (+ "* dPP Translated: " dpp_define))
                (beginning_of_line)
            )
        )
        (top_of_buffer)
        (while (search_fwd "#beginning_of_include" 0 0)
            (
                (drop_anchor)
                (search_fwd "#end_of_include" 0 0)
                (end_of_line)
                (delete_block)
            )
        )
    )
)
(macro _translate_ifdefs
    (
        (string            dpp_buffer_name
                            dpp_end_str
        )
        (get_parm 0 dpp_buffer_name)
        (top_of_buffer)
        (while (search_fwd "<{ @}|{\\t@}#ifdef " 1 0 0)
            (
                (move_rel 0 7)
                (= temp_str (ltrim(read)))
                (= temp_str (substr temp_str 1 (- (strlen temp_str) 1)))
                (message "Preprocessing %s... " (+ "ifdef: " temp_str))
                (= temp_str (substr temp_str 1 1))
                (delete_line)
                (if (== temp_str "1")
                    (
                        (search_fwd "<{ @}|{\\t@}#e" 1 0 0)
                        (= dpp_end_str (ltrim(read)))
                        (delete_line)
                        (= dpp_end_str (substr dpp_end_str 1 5))
                        (if (== (upper dpp_end_str) "#ELSE")
                            (
                                (beginning_of_line)
                                (drop_anchor)
                                (if (search_fwd "<{ @}|{\\t@}#end" 1 0 0)
                                    (
                                        (end_of_line)
                                        (delete_block)
                                    )
                                ;else
                                    (raise_anchor)
                                )
                            )
                        )
                    )
                ;else
                    (
                        (beginning_of_line)
                        (drop_anchor)
                        (search_fwd "<{ @}|{\\t@}#e" 1 0 0)
                        (= dpp_end_str (ltrim(read)))
                        (= dpp_end_str (substr dpp_end_str 1 5))
                        (end_of_line)
                        (delete_block)
                        (if (== (upper dpp_end_str) "#ELSE")
                            (
                                (search_fwd "<{ @}|{\\t@}#end" 1 0 0)
                                (delete_line)
                            )
                        )
                    )
                )
            )
        )
        (top_of_buffer)
        (while (search_fwd "<{ @}|{\\t@}#ifndef " 1 0 0)
            (
                (move_rel 0 8)
                (= temp_str (ltrim(read)))
                (message "Preprocessing %s... " (+ "ifndef: " temp_str))
                (= temp_str (substr temp_str 1 1))
                (delete_line)
                (if (!= temp_str "1")
                    (
                        (search_fwd "<{ @}|{\\t@}#e" 1 0)
                        (= dpp_end_str (ltrim(read)))
                        (delete_line)
                        (= dpp_end_str (substr dpp_end_str 1 5))
                        (if (== (upper dpp_end_str) "#ELSE")
                            (
                                (beginning_of_line)
                                (drop_anchor)
                                (search_fwd "<{ @}|{\\t@}#end" 1 0 0)
                                (end_of_line)
                                (delete_block)
                            )
                        )
                    )
                )
            ;else
                (
                    (beginning_of_line)
                    (drop_anchor)
                    (search_fwd "<{ @}|{\\t@}#e" 1 0 0)
                    (= dpp_end_str (ltrim(read)))
                    (= dpp_end_str (substr dpp_end_str 1 5))
                    (end_of_line)
                    (delete_block)
                    (if (== (upper dpp_end_str) "#ELSE")
                        (
                            (search_fwd "<{ @}|{\\t@}#end" 1 0 0)
                            (delete_line)
                        )
                    )
                )
            )
        )
    )
)
(macro _translate_objects
    (
        (int            dpp_prg_buffer
        )
        (string        dpp_buffer_name
                        dpp_object_name
        )
        (get_parm 0 dpp_buffer_name)
        (= dpp_prg_buffer (inq_buffer))
        (top_of_buffer)
        (while (search_fwd "<{ @}|{\\t@}#" 1 0)
            (
                (= dpp_object_name (substr (ltrim (read)) 2))
                (= dpp_object_name (substr (trim dpp_object_name) 1 (- (strlen dpp_object_name) 1)))
                (message "Preprocessing %s..." (+ (+ (upper dpp_buffer_name) ": ") dpp_object_name))
                (set_buffer library_buffer)
                (top_of_buffer)
                (if (search_fwd (+ "\\* " dpp_object_name) 1 0)
                    (
                        (beginning_of_line)
                        (drop_anchor)
                        (search_fwd "{note}|{\\* eof}" 1 0)
                        (move_rel -1 0)
                        (end_of_line)
                        (copy)
                        (set_buffer dpp_prg_buffer)
                        (delete_to_eol)
                        (paste)
                    )
                ;else
                    (
                        (error "Library object %s not found." dpp_object_name)
                    )
                )
            )
        )
    )
)