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

Text File | 1991-03-21 | 7.6 KB | 293 lines

;dBRIEF Comment - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro comm
    (
        (string            comment_character
        )
        (if (get_parm 0 temp_str "Comment Conditionals, Prog, Block [Cpb]:" 1 "C")
            (switch (upper (substr temp_str 1 1))
                "C"
                    (_comment_conditionals)
                "P"
                    (_comment_program)
                "B"
                    (
                        (if (get_parm 1 comment_character)
                            (_comment_block comment_character)
                        ;else
                            (_comment_block)
                        )
                    )
            )
        )
    )
)
(macro unco
    (
        (string            comment_character
        )
        (if (get_parm 0 temp_str "Uncomment Conditionals, Prog, or Block [Cpb]:" 1 "C")
            (
                (switch (upper (substr temp_str 1 1))
                    "C"
                        (_uncomment_conditionals 1)
                    "P"
                        (_remove_same_line_comments)
                    "B"
                        (
                            (if (get_parm 1 comment_character)
                                (_uncomment_block comment_character)
                            ;else
                                (_uncomment_block)
                            )
                        )
                )
            )
        )
    )
)
(macro _comment_block
    (
        (int                first_line
                            first_column
                            last_line
        )
        (string            comment_type
                            comment_prompt
        )
        (if (inq_marked first_line first_column last_line NULL)
            (
                (sprintf comment_prompt "%s or %s [%s%s]: " (_comment_character 2) (_comment_character 3) (lower (substr (_comment_character 2) 1 1)) (_comment_character 3))
                (if (get_parm 0 comment_type comment_prompt 1 (_comment_character 3))
                    (
                        (= temp_int (- first_line 1))
                        (raise_anchor)
                        (while (<= (++ temp_int) last_line)
                            (
                                (move_abs temp_int first_column)
                                (if (== (upper (substr comment_type 1 1)) (substr (_comment_character 2) 1 1))
                                    (= comment_type (_comment_character 2))
                                ;else
                                    (= comment_type (_comment_character 3))
                                )
                                (insert (+ comment_type (_replicate " " dbr_comment_spaces)))
                            )
                        )
                    )
                )
            )
        ;else
            (_display_popup_message "No marked block!" "" 1)
        )
    )
)
(macro _uncomment_block
    (
        (int                first_line
                            first_col
                            last_line
        )
        (string            comment_type
                            comment_prompt
                            comment_temp_string
        )
        (if (inq_marked first_line first_col last_line NULL)
            (
                (sprintf comment_prompt "%s or %s [%s%s]: " (_comment_character 2) (_comment_character 3) (lower (substr (_comment_character 2) 1 1)) (_comment_character 3))
                (if (get_parm 0 comment_type comment_prompt 1 (_comment_character 3))
                    (
                        (= temp_int (- first_line 1))
                        (raise_anchor)
                        (if (== (upper (substr comment_type 1 1)) (substr (_comment_character 2) 1 1))
                            (= comment_type (_comment_character 2))
                        ;else
                            (= comment_type (_comment_character 3))
                        )
                        (while (<= (++ temp_int) last_line)
                            (
                                (move_abs temp_int 1)
                                (switch (upper (substr comment_type 1 1))
                                    (upper (substr (_comment_character 2) 1 1))
                                        (if (index (read) (_comment_character 2))
                                            (
                                                (move_abs 0 first_col)
                                                (delete_char (+ (strlen (_comment_character 2)) dbr_comment_spaces))
                                            )
                                        )
                                    NULL
                                        (
                                            (sprintf comment_temp_string "{<[ \t]@\\%s}" comment_type)
                                            (if (search_string comment_temp_string (read))
                                                (
                                                    (move_abs 0 first_col)
                                                    (delete_char (+ (strlen (_comment_character 3)) dbr_comment_spaces))
                                                )
                                            )
                                        )
                                )
                            )
                        )
                    )
                )
            )
        ;else
            (_display_popup_message "No marked block!" "" 1)
        )
    )
)
(macro _same_line_comment
    (
        (save_position)
        (beginning_of_line)
        (= temp_str (read))
        (if (|| (== temp_str " ")(== temp_str "\n"))
            (
                (restore_position)
                (delete_to_eol)
                (insert (+ (_comment_character 2) " "))
            )
        ;else
            (
                (restore_position 0)
                (if (|| (== dbr_comment_tab 0)(> (strlen temp_str) dbr_comment_tab))
                    (
                        (end_of_line)
                        (right)
                        (right)
                    )
                ;else
                    (move_abs 0 dbr_comment_tab)
                )
                (delete_to_eol)
                (insert (+ (_comment_character 1) " "))
            )
        )
    )
)
(macro _comment_program
    (
        (int            comm_last_line
                        comm_current_line
                        comm_current_buffer
                        comm_text_buffer
        )
        (string        comm_srce_line
                        comm_token
                        comm_token_line
                        comm_temp_string
                        comm_pattern
        )
        (save_position)
        (= comm_current_buffer (inq_buffer))
        (if (inq_marked comm_current_line NULL comm_last_line NULL)
            (raise_anchor)
        ;else
            (
                (end_of_buffer)
                (inq_position comm_last_line)
                (top_of_buffer)
                (inq_position comm_current_line)
            )
        )
        (-= comm_current_line 2)
        (while (&& (<= (++ comm_current_line) comm_last_line)(! (inq_kbd_char)))
            (
                (move_abs comm_current_line 1)
                (= comm_srce_line (read))
                (if (! (index comm_srce_line (_comment_character 1)))
                    (
                        (= comm_token_line (upper (ltrim (trim comm_srce_line))))
                        (if (&& (!= (substr comm_token_line 1 1)(_comment_character 3))(strlen comm_token_line))
                            (
                                (if dbr_two_word_comments
                                    (
                                        (if (index comm_token_line " ")
                                            (
                                                (= comm_token (substr comm_token_line 1 1))
                                                (+= comm_token (substr comm_token_line (+ (index comm_token_line " ") 1) 3))
                                            )
                                        ;else
                                            (= comm_token (substr comm_token_line 1 4))
                                        )
                                    )
                                ;else
                                    (
                                        (= comm_token (substr comm_token_line 1 4))
                                        (if (index comm_token " ")
                                            (
                                                (= comm_token (substr comm_token_line 1 1))
                                                (+= comm_token (substr comm_token_line (+ (index comm_token_line " ") 1) 3))
                                            )
                                        )
                                    )
                                )
                                (message "Reviewing line %d, any key to abort..." comm_current_line)
                                (if comm_text_buffer
                                    (set_buffer comm_text_buffer)
                                ;else
                                    (= comm_text_buffer (create_buffer "Comments" (search_path  (inq_environment "BPATH") "comments.cfg") 1))
                                )
                                (top_of_buffer)
                                (sprintf comm_pattern "<{%02d %s}|{00 %s}" dbr_dialect comm_token comm_token)
                                (if (search_fwd comm_pattern 1 0)
                                    (
                                        (move_abs 0 4)
                                        (= comm_temp_string (read))
                                        (= comm_temp_string (+ (+ (_comment_character 1) " ") (ltrim (trim (substr comm_temp_string 5)))))
                                    )
                                ;else
                                    (= comm_temp_string "")
                                )
                                (set_buffer comm_current_buffer)
                                (if (strlen (trim comm_temp_string))
                                    (
                                        (if (< (strlen (trim comm_srce_line)) dbr_comment_tab)
                                            (
                                                (move_abs 0 dbr_comment_tab)
                                                (delete_to_eol)
                                            )
                                        ;else
                                            (
                                                (end_of_line)
                                                (move_rel 0 2)
                                            )
                                        )
                                        (if (> (atoi (ltrim comm_srce_line) 0) 95)
                                            (insert (lower comm_temp_string))
                                        ;else
                                            (insert (upper comm_temp_string))
                                        )
                                    )
                                )
                            )
                        )
                        (beginning_of_line)
                        (refresh)
                    )
                )
            )
        )
        (if comm_text_buffer
            (delete_buffer comm_text_buffer)
        )
        (keyboard_flush)
        (restore_position)
        (if (< comm_current_line comm_last_line)
            (_display_popup_message "Automatic commenting aborted!" "" 1)
        ;else
            (_display_popup_message "Automatic commenting complete." "" 0)
        )
    )
)
(macro _remove_same_line_comments
    (
        (save_position)
        (top_of_buffer)
        (translate (+ (_comment_character 1) "*>") "" 1 1 0)
        (restore_position)
        (_display_popup_message "Program uncommenting complete." "" 0)
    )
)