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

Text File | 1991-03-21 | 6.7 KB | 252 lines

;dBRIEF Indenter - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro _prg_indent
    (
        (if (inq_mode)
            (
                (int            dbr_curr_col
                                dbr_insert_col
                                c_col
                                p_col
                )
                (string        orig_line
                                token
                )
                (inq_position dbr_curr_line dbr_curr_col)
                (insert "~|")
                (beginning_of_line)
                (= orig_line (trim (ltrim (read))))
                (= temp_int (index orig_line "~|"))
                (= orig_line (+ (+ (substr orig_line 1 (- temp_int 1)) "\n") (substr orig_line (+ temp_int 2))))
                (= token (substr (upper orig_line) 1 4))
                (if (= temp_int (search_string "[ \\t]" token NULL 1))
                    (= token (substr token 1 (-- temp_int)))
                )
                (if (< (strlen orig_line) 1)
                    (= dbr_insert_col dbr_curr_col)
                ;else
                    (
                        (if (search_back "<*\\c[~ \\t\\n]")
                            (
                                (inq_position NULL c_col)
                                (move_rel -1 0)
                                (end_of_line)
                                (search_back "<*\\c[~ \\t\\n]")
                                (inq_position NULL p_col)
                                (= temp_str (upper (trim (read))))
                                (if (&& (index (_backdenting_conditionals) token)(>= p_col c_col))
                                    (if (&& (== p_col c_col)(index temp_str (_do_case_syntax 1)))
                                        (= dbr_insert_col (+ c_col dbr_indent_level))
                                    ;else
                                        (= dbr_insert_col p_col)
                                    )
                                ;else
                                    (if (&& (== token (_do_case_syntax 2)) (< p_col c_col))
                                        (if (== (+ p_col (* dbr_indent_case dbr_indent_level)) c_col)
                                            (= dbr_insert_col c_col)
                                        ;else
                                            (= dbr_insert_col (+ c_col dbr_indent_level))
                                        )
                                    ;else
                                        (if (&& (&& (== dbr_indent_case 1)(== p_col c_col))(index (upper token) "CASE"))
                                            (= dbr_insert_col (+ c_col dbr_indent_level))
                                        ;else
                                            (= dbr_insert_col c_col)
                                        )
                                    )
                                )
                            )
                        ;else
                            (= dbr_insert_col 1)
                        )
                    )
                )
                (= curr_indent_col dbr_insert_col)
                (if (== (strlen (trim token)) 3)
                    (= token (+ (trim token) " "))
                ;else
                    (+= token " ")
                )
                (if (&& (strlen token) (index (_dialect_table) token))
                    (= dbr_insert_col (_indent_shift (trim token) orig_line dbr_insert_col))
                )
                (move_abs dbr_curr_line dbr_curr_col)
                (beginning_of_line)
                (delete_to_eol)
                (move_abs 0 dbr_insert_col)
                (insert orig_line)
                (beginning_of_line)
                (= temp_str (read))
                (delete_to_eol)
                (move_abs 0 curr_indent_col)
                (insert (substr temp_str 1 (- (strlen temp_str) 1)))
                (move_abs 0 curr_indent_col)
            )
        ;else
            (
                (down)
                (beginning_of_line)
                (search_fwd "<*\\c[~ \\t\\n]")
            )
        )
    )
)
(macro rein
    (
        (int            dbr_insert_col
                        last_line
                        n1r
                        n1c
                        n2r
                        n2c
                        col
                        line_continue_flag
                        refresh_flag
        )
        (string        orig_line
                        token
                        comment_string
                        cmd_temp_str
        )
        (= refresh_flag 1)
        (= dbr_return_flag 0)
        (= line_continue_flag 0)
        (get_parm 0 refresh_flag)
        (message "Indenting, press any key to abort...")
        (if (inq_marked dbr_curr_line curr_indent_col last_line NULL)
            (
                (raise_anchor)
                (move_abs dbr_curr_line curr_indent_col)
                (save_position)
                (move_abs dbr_curr_line 1)
            )
        ;else
            (
                (save_position)
                (end_of_buffer)
                (inq_position last_line)
                (top_of_buffer)
                (inq_position dbr_curr_line)
                (= dbr_insert_col 1)
                (= curr_indent_col 1)
            )
        )
        (while (&& (<= dbr_curr_line last_line)(! (inq_kbd_char)))
            (
                (= dbr_text_flag 0)
                (= orig_line (trim (ltrim (read))))
                (= token (substr (upper orig_line) 1 4))
                (if (= dbr_insert_col (search_string "[ \\t]" token NULL 1))
                    (= token (substr token 1 (-- dbr_insert_col)))
                )
                (= dbr_insert_col curr_indent_col)
                (if (&& (strlen token) (index (_dialect_table) (+ token " ")))
                    (
                        (= dbr_insert_col (_indent_shift token orig_line dbr_insert_col))
                        (if dbr_text_flag
                            (= orig_line (trim (ltrim (read))))
                        )
                    )
                )
                (if dbr_indent_continuation_lines
                    (if (== (_last_character orig_line) (_continuation_character))
                        (if (== line_continue_flag 0)
                            (
                                (= line_continue_flag 1)
                                (+= curr_indent_col (* dbr_indent_level dbr_ext_ind_level))
                            )
                        )
                    )
                )
                (if dbr_indent_margin_comments
                    (if (|| (== (substr orig_line  1 4) "*<<<")(== (substr orig_line  1 4) "*+++"))
                        (if (index orig_line "\*+++")
                            (
                                (= dbr_insert_col 1)
                                (= curr_indent_col (+ dbr_indent_level 1))
                            )
                        ;else
                            (if (index orig_line ">>>\*")
                                (= dbr_insert_col (- 40 (/ (strlen orig_line) 2)))
                            ;else
                                (= dbr_insert_col 1)
                            )
                        )
                    )
                )
                (delete_to_eol)
                (if (&& (== dbr_dialect 9)(== (substr orig_line 1 1) "|"))
                    (
                        (save_position)
                        (search_back "<*\\c\\|" 1 0)
                        (inq_position NULL dbr_insert_col)
                        (restore_position)
                    )
                )
                (move_abs 0 dbr_insert_col)
                (insert orig_line)
                (if dbr_indent_continuation_lines
                    (if (&& (!= (_last_character orig_line) (_continuation_character))(== line_continue_flag 1))
                        (
                            (= line_continue_flag 0)
                            (-= curr_indent_col (* dbr_indent_level dbr_ext_ind_level))
                        )
                    )
                )
                (if dbr_indent_same_line_comments
                    (if (&& (!= (index (ltrim orig_line) (_comment_character 1)) 1) (&& (search_string (_comment_character 1) orig_line) (!= dbr_comment_tab 0)))
                        (
                            (beginning_of_line)
                            (= cmd_temp_str (read))
                            (beginning_of_line)
                            (delete_to_eol)
                            (insert (trim (substr cmd_temp_str 1 (- (index cmd_temp_str (_comment_character 1)) 1))))
                            (end_of_line)
                            (inq_position NULL col)
                            (if (< col (- dbr_comment_tab 1))
                                (move_abs 0 dbr_comment_tab)
                            ;else
                                (
                                    (end_of_line)
                                    (move_rel 0 2)
                                )
                            )
                            (insert (trim (substr cmd_temp_str (index cmd_temp_str (_comment_character 1)))))
                        )
                    )
                )
                (move_abs (++ dbr_curr_line) 1)
                (if refresh_flag
                    (refresh)
                )
            )
        )
        (keyboard_flush)
        (restore_position)
        (if refresh_flag
            (if (> dbr_curr_line last_line)
                (_display_popup_message "Indenting complete." "" 0)
            ;else
                (_display_popup_message "Indenting aborted." "" 1)
            )
        ;else
            (message "")
        )
    )
)
(macro _last_character
    (
        (string            temp_string
        )
        (get_parm 0 temp_string)
        (if (index temp_string (_comment_character 1))
            (= temp_string (trim (substr temp_string 1 (- (index temp_string (_comment_character 1)) 1))))
        ;else
            (= temp_string (trim temp_string))
        )
        (return (substr temp_string (strlen temp_string) 1))
    )
)