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

Text File | 1991-03-21 | 8.7 KB | 298 lines

;dBRIEF Template - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro _prg_template
    (
        (int                constant_position
                            template_counter
                            template_case
                            command_type
        )
        (string            template_token
        )
        (if (&& (== (read 1) "\n")(== dbr_template 1))
            (
                (save_position)
                (beginning_of_line)
                (= temp_str (+ (trim (ltrim (read))) " "))
                (if (< (atoi (substr temp_str 1 1) 0) 97)
                    (= template_case 1)
                )
                (restore_position)
                (if (&& (! (index " \t\n" (substr temp_str 1 1))) (&& (strlen temp_str) (< (strlen temp_str) 6)))
                    (switch (trim (upper temp_str))
                        (_do_case_syntax 0)
                            (
                                (inq_position NULL curr_indent_col)
                                (-= curr_indent_col 4)
                                (_case_insert (+ (_do_case_syntax 1) "\n") 0 4 template_case)
                                (= template_counter 0)
                                (while (< (++ template_counter) 4)
                                    (
                                        (if (== dbr_indent_case 2)
                                            (move_abs 0 (+ curr_indent_col dbr_indent_level))
                                        ;else
                                            (move_abs 0 curr_indent_col)
                                        )
                                        (_case_insert (+ (_do_case_syntax 2) " \n") 0 0 template_case)
                                        (move_abs 0 (+ curr_indent_col (* dbr_indent_level dbr_indent_case)))
                                        (_case_insert (+ (_do_case_syntax 3) "\n") 0 0 template_case)
                                    )
                                )
                                (if (== dbr_indent_case 2)
                                    (move_abs 0 (+ curr_indent_col dbr_indent_level))
                                ;else
                                    (move_abs 0 curr_indent_col)
                                )
                                (_case_insert (+ (_do_case_syntax 4) "\n") 0 0 template_case)
                                (move_abs 0 (+ curr_indent_col (* dbr_indent_level dbr_indent_case)))
                                (_case_insert (+ (_do_case_syntax 3) "\n") 0 0 template_case)
                                (move_abs 0 curr_indent_col)
                                (if (index (upper temp_str) (+ (_do_case_syntax 0) " "))
                                    (_case_insert (+ (_do_case_syntax 5) "\n") 0 0 template_case)
                                )
                                (delete_line)
                                (move_rel -9 0)
                                (end_of_line)
                                (delete_to_eol)
                            )
                        (_do_while_syntax 0)
                            (
                                (inq_position NULL curr_indent_col)
                                (-= curr_indent_col 4)
                                (save_position)
                                (_case_insert (+ (_do_while_syntax 1) "\n\n") 0 4 template_case)
                                (restore_position)
                                (save_position)
                                (move_rel 2 0)
                                (_case_insert (+ (_do_while_syntax 2) "\n") 0 4 template_case)
                                (delete_line)
                                (restore_position)
                                (+= curr_indent_col dbr_indent_level)
                                (down)
                                (move_abs 0 curr_indent_col)
                            )
                        NULL
                            (if (|| (== (strlen (trim temp_str)) 3)(== (strlen (trim temp_str)) 4))
                                (_evaluate_expansion_table temp_str (_command_table 0) (_function_table 0) (_set_table 0))
                            ;else
                                (self_insert)
                            )
                    )
                ;else
                    (self_insert)
                )
            )
        ;else
            (self_insert)
        )
    )
)
(macro _evaluate_expansion_table
    (
        (int                constant_position
                            template_counter
                            command_type
                            command_table_elements
                            function_table_elements
                            set_table_elements
        )
        (string            command_string
        )
        (get_parm 0 command_string)
        (get_parm 1 command_table_elements)
        (get_parm 2 function_table_elements)
        (get_parm 3 set_table_elements)
        (= constant_position 0)
        (= template_counter 0)
        (switch (strlen command_string)
            4
                (
                    (if (index (+ (+ (substr (_beg_of_proc_scan) 2 3) "~")(+ (substr (_beg_of_func_scan) 2 3) "~"))(trim (upper command_string)))
                        (if (== (upper command_string) (+ (substr (_beg_of_proc_scan) 2 3) " "))
                            (if (< (atoi (substr command_string 1 1) 0) 97)
                                (_procedure_header (substr (_beg_of_proc_scan) 2 (- (index (_beg_of_proc_scan) "}") 2)) (_end_of_rout_syntax) "prochead.cfg")
                            ;else
                                (_procedure_header (lower (substr (_beg_of_proc_scan) 2 (- (index (_beg_of_proc_scan) "}") 2))) (lower (_end_of_rout_syntax)) "prochead.cfg")
                            )
                        ;else
                            (if (< (atoi (substr command_string 1 1) 0) 97)
                                (_procedure_header (substr (_beg_of_func_scan) 2 (- (index (_beg_of_func_scan) "}") 2)) (+ (_end_of_rout_syntax) "(.T.)") "funchead.cfg")
                            ;else
                                (_procedure_header (lower (substr (_beg_of_func_scan) 2 (- (index (_beg_of_func_scan) "}") 2))) (lower (+ (_end_of_rout_syntax) "(.T.)")) "funchead.cfg")
                            )
                        )
                    ;else
                        (
                            (while (&& (== constant_position 0) (<= (+= template_counter 1) command_table_elements))
                                (if (= constant_position (search_string (+ "~" (upper command_string)) (_command_table template_counter) NULL 0))
                                    (= command_type 0)
                                )
                            )
                            (if (== constant_position 0)
                                (
                                    (= template_counter 0)
                                    (while (&& (== constant_position 0) (<= (+= template_counter 1) function_table_elements))
                                        (if (= constant_position (search_string (+ "~" (upper command_string)) (_function_table template_counter) NULL 0))
                                            (= command_type 1)
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            5
                (while (&& (== constant_position 0) (<= (+= template_counter 1) set_table_elements))
                    (if (= constant_position (search_string (+ "~" (upper command_string)) (_set_table template_counter) NULL 0))
                        (= command_type 2)
                    )
                )
            NULL
                (self_insert)
        )
        (if constant_position
            (_parse_and_expand command_type template_counter constant_position)
        ;else
            (self_insert)
        )
    )
)
(macro _parse_and_expand
    (
        (int                command_type
                            table_number
                            command_position
                            more_syntax
        )
        (string            command
                            command_string
        )
        (get_parm 0 command_type)
        (get_parm 1 table_number)
        (get_parm 2 command_position)
        (switch command_type
            0
                (= command_string (_command_table table_number))
            1
                (= command_string (_function_table table_number))
            2
                (= command_string (_set_table table_number))
        )
        (= command (substr command_string (+ command_position 5)))
        (if (== (substr command (- (index command "~") 1) 1) " ")
            (= more_syntax 1)
        )
        (= command (trim (substr command 1 (- (index command "~") 1))))
        (if (&& (! dbr_expr_expansion)(== command_type 1))
            (if (! (index command "^UX"))
                (= command (+ (substr command 1 (index command "(")) (substr command (index command ")"))))
            )
        )
        (switch command_type
            0
                (_command_insert command more_syntax 3)
            1
                (_function_insert command 3)
            2
                (_command_insert (ltrim command) more_syntax 4)
        )
    )
)
(macro _command_insert
    (
        (int            relational_move
                        additional_syntax
                        current_indent_column
                        adjust_indent
        )
        (string        insert_string
        )
        (get_parm 0 insert_string)
        (get_parm 1 additional_syntax)
        (get_parm 2 relational_move)
        (move_rel 0 (* -1 relational_move))
        (inq_position NULL current_indent_column)
        (if (< (atoi (read 1) 0) 97)
            (= insert_string (upper insert_string))
        ;else
            (= insert_string (lower insert_string))
        )
        (delete_to_eol)
        (insert insert_string)
        (if additional_syntax
            (self_insert)
        ;else
            (
                (insert "\n")
                (= adjust_indent (_adjust_indent_level (upper insert_string) current_indent_column))
                (if adjust_indent
                    (
                        (save_position)
                        (search_back "<*\\c[~ \\t\\n]")
                        (= insert_string (trim (read)))
                        (delete_to_eol)
                        (move_rel 0 adjust_indent)
                        (insert insert_string)
                        (restore_position)
                    )
                )
            )
        )
    )
)
(macro _function_insert
    (
        (string        insert_string
        )
        (int            relational_move
        )
        (get_parm 0 insert_string)
        (get_parm 1 relational_move)
        (move_rel 0 (* -1 relational_move))
        ; (= insert_string (+ (substr insert_string 1 (index insert_string "("))) (substr insert_string (+ (index insert_string "(") 1)))
        (if (< (atoi (read 1) 0) 97)
            (= insert_string (upper insert_string))
        ;else
            (= insert_string (lower insert_string))
        )
        (delete_to_eol)
        (insert insert_string)
        (move_rel 0 (* (- (strlen insert_string) (index insert_string "(")) -1))
        (if (== dbr_dialect 10)
            (
                (search_fwd "(")
                (move_rel 0 1)
            )
        )
    )
)
(macro expa
    (
        (int                constant_position
                            template_counter
        )
        (string            command_string
                            trailing_text
        )
        (= trailing_text (trim (read)))
        (delete_to_eol)
        (move_rel 0 -3)
        (= command_string (+ (read 3) " "))
        (end_of_line)
        (= constant_position 0)
        (= template_counter 0)
        (while (&& (== constant_position 0) (<= (+= template_counter 1) (_function_table 0)))
            (= constant_position (search_string (+ "~" (upper command_string)) (_function_table template_counter) NULL 0))
        )
        (if constant_position
            (_parse_and_expand 1 template_counter constant_position)
        )
        (save_position)
        (end_of_line)
        (insert trailing_text)
        (restore_position)
    )
)