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

Text File | 1991-03-21 | 12.8 KB | 416 lines

;Object Editing System - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro _explode_object_window
    (
        (int                object_buffer
                            obj_buffer_search
                            _bcol
                            _ecol
                            _blin
                            _elin
                            _parse
                            obj_in_memory
                            apx_program_buffer
                            apx_start_buffer
        )
        (string            object_name
                            object_file
                            object_label
                            current_buffer_name
                            _object
                            _file_extension
                            apx_program_name
        )
        (global            object_name
                            object_buffer
                            obj_in_memory
        )
        (if (== dbr_auto_header 1)
            (= dbr_auto_header 99)
        )
        (message "Searching for object...")
        (drop_bookmark 0 "y")
        (inq_names NULL _file_extension NULL)
        (= _file_extension (upper (+ "." _file_extension)))
        (if (inq_marked _blin _bcol _elin _ecol)
            (if (== _blin _elin)
                (
                    (raise_anchor)
                    (move_abs _blin _bcol)
                    (= _object (upper (ltrim (trim (read (+ (- _ecol _bcol) 1))))))
                    (= object_name _object)
                    (= _parse 1)
                )
            ;else
                (
                    (raise_anchor)
                    (_display_popup_message "Improper block marked!" "" 1)
                    (= _object "No Object")
                    (= _parse 0)
                )
            )
        ;else
            (
                (beginning_of_line)
                (= _object (upper (ltrim (trim (read)))))
                (= _parse 0)
                (if (search_string (+ (_comment_character 1) "*-\\>") _object NULL 1)
                    (
                        (= object_file (substr _object (search_string (+ (_comment_character 1) "*-\\>") _object NULL 1)))
                        (= object_file (ltrim (substr object_file (+ (index object_file "->") 2))))
                    )
                ;else
                    (= object_file "")
                )
                (if (index _object (_comment_character 1))
                    (= _object (trim (substr _object 1 (- (index _object (_comment_character 1)) 1))))
                )
                (if (== (substr _object 1 8) "#INCLUDE")
                    (
                        (= object_file _object)
                        (= object_file (ltrim (trim (substr object_file 9))))
                        (if (index object_file "\>")
                            (
                                (= object_file (substr object_file 2))
                                (= object_file (substr object_file 1 (- (index object_file "\>") 1)))
                            )
                        ;else
                            (if (index object_file "\"")
                                (
                                    (= object_file (substr object_file 2))
                                    (= object_file (substr object_file 1 (- (index object_file "\"") 1)))
                                )
                            ;else
                                (= object_file (trim (substr object_file 1 (+ (index object_file ".") 3))))
                            )
                        )
                        (= object_name object_file)
                        (if (exist (+ (+ (inq_environment "INCLUDE") "\\") object_name))
                            (= object_name (+ (+ (inq_environment "INCLUDE") "\\") object_name))
                        )
                        (= object_file object_name)
                        (= _file_extension (substr object_name (+ (index object_name ".") 1)))
                        (= _parse 1)
                    )
                )
                (if (== (substr _object 1 5) "PLAY ")
                    (
                        (= object_file (ltrim (trim (substr _object 6))))
                        (= object_name object_file)
                        (if (exist (+ object_name ".SC"))
                            (= _file_extension ".SC")
                        ;else
                            (= _file_extension "")
                        )
                        (= _parse 1)
                    )
                )
                (if (== (substr _object 1 (strlen (_execute_command))) (upper (_execute_command)))
                    (
                        (= object_name (substr _object (+ (strlen (_execute_command)) 1)))
                        (if (index object_name " WITH ")
                            (= object_name (substr object_name 1 (- (index object_name " WITH ") 1)))
                        )
                        (= _parse 1)
                    )
                )
                (if (&& (== (substr _object 1 8) "SET PROC")(index _object " TO "))
                    (
                        (= object_name (substr _object (+ (index _object "TO ") 3)))
                        (= _parse 1)
                    )
                )
                (if (&& (== (substr _object 1 8) "SET FORM")(index _object " TO "))
                    (
                        (= object_name (substr _object (+ (index _object "TO ") 3)))
                        (= _file_extension ".FMT")
                        (= _parse 1)
                    )
                )
                (if (index _object "(")
                    (
                        (= object_name (substr _object 1 (- (index _object "(") 1)))
                        (if (index object_name "=")
                            (= object_name (ltrim (substr object_name (+ (index object_name "=") 1))))
                        )
                        (if (== (upper (substr object_name 1 4)) "STOR")
                            (= object_name (ltrim (substr object_name (index object_name " "))))
                        )
                        (if (index object_name " ")
                            (= _parse 0)
                        ;else
                            (= _parse 1)
                        )
                    )
                )
            )
        )
        (= object_name (ltrim (trim object_name)))
        (if (== _parse 1)
            (
                (if (|| (exist object_name)(exist (+ object_name _file_extension)))
                    (
                        (if (! (index object_name (upper _file_extension)))
                            (+= object_name _file_extension)
                        )
                        (inq_names NULL NULL current_buffer_name)
                        (if (== object_name (upper current_buffer_name))
                            (_display_popup_message "Can't explode an object with the same name as the current buffer!" "" 1)
                        ;else
                            (
                                (int msg_level)
                                (if (index object_name "\\")
                                    (= object_label (substr object_name (+ (rindex object_name "\\") 1)))
                                ;else
                                    (= object_label object_name)
                                )
                                (= msg_level (inq_msg_level))
                                (set_msg_level 3)
                                (= dbr_current_buffer (inq_buffer))
                                (= obj_in_memory (edit_file object_name))
                                (= temp_int (inq_buffer))
                                (if (inq_modified)
                                    (write_buffer)
                                )
                                (if (&& (!= 0 temp_int)(!= dbr_current_buffer temp_int))
                                    (delete_buffer temp_int)
                                )
                                (set_msg_level msg_level)
                                (set_buffer dbr_current_buffer)
                                (attach_buffer dbr_current_buffer)
                                (if (>= (version) 310)
                                    (execute_macro "db_hide 4 _object_action")
                                )
                                (create_window 18 (_menu_lines 50) 76 2 (+ object_label ": Ctrl-O To Save and Close Object"))
                                (if (exist (+ (substr object_name 1 (- (index object_name ".") 1)) ".OBK"))
                                    (del (+ (substr object_name 1 (- (index object_name ".") 1)) ".OBK"))
                                )
                                (= object_buffer (create_buffer (+ (substr object_label 1 (- (index object_label ".") 1)) ".OBK") (+ (substr object_name 1 (- (index object_name ".") 1)) ".OBK") 0))
                                (attach_buffer object_buffer)
                                (read_file object_name)
                                (top_of_buffer)
                                (write_buffer)
                                (use_local_keyboard _obk_smart)
                                (refresh)
                                (message "")
                            )
                        )
                    )
                ;else
                    (
                        (= obj_buffer_search 1)
                        (= dbr_current_buffer (inq_buffer))
                        (if (&& (strlen object_file)(exist object_file))
                            (
                                (= obj_in_memory (edit_file object_file))
                                (= temp_int (inq_buffer))
                                (set_buffer dbr_current_buffer)
                                (attach_buffer dbr_current_buffer)
                                (set_buffer temp_int)
                            )
                        ;else
                            (
                                (= obj_in_memory 0)
                                (set_buffer dbr_current_buffer)
                                (attach_buffer dbr_current_buffer)
                            )
                        )
                        (while obj_buffer_search
                            (
                                (inq_names NULL NULL current_buffer_name)
                                (message "Searching %s..." (upper current_buffer_name))
                                (drop_bookmark 2 "y")
                                (top_of_buffer)
                                (if (search_fwd (+ (+ "<\\c" (+ (_beg_of_rout_scan) "*{ @}|{\\t@}")) (+ object_name "[{\\n}|{\\t@}|{ @}|{(}]")) 1 0)
                                    (
                                        (message "")
                                        (= object_buffer (inq_buffer))
                                        (= obj_buffer_search 0)
                                        (beginning_of_line)
                                        (drop_bookmark 1 "y")
                                        (drop_anchor 4)
                                        (if (search_fwd (+ "<" (_end_of_rout_syntax)) 1 0)
                                            (
                                                (move_rel 1 0)
                                                (cut 0)
                                                (goto_bookmark 0)
                                                (+= object_name ".OBK")
                                                (if (>= (version) 310)
                                                    (execute_macro "db_hide 4 _object_action")
                                                )
                                                (create_window 18 (_menu_lines 50) 76 2 (+ (substr object_name 1 (- (index object_name ".") 1)) ": Ctrl-O To Save and Close Object"))
                                                (if (exist object_name)
                                                    (del object_name)
                                                )
                                                (edit_file object_name)
                                                (refresh)
                                                (paste)
                                                (delete_line)
                                                (top_of_buffer)
                                                (write_buffer)
                                            )
                                        ;else
                                            (
                                                (raise_anchor)
                                                (_display_popup_message "Object has no %s statement!" (_end_of_rout_syntax) 1)
                                            )
                                        )
                                    )
                                ;else
                                    (
                                        (goto_bookmark 2)
                                        (set_buffer (next_buffer))
                                        (if (== dbr_current_buffer (inq_buffer))
                                            (if dbr_apx_file_id
                                                (
                                                    (= obj_buffer_search 1)
                                                    (= apx_start_buffer (inq_buffer))
                                                    (set_buffer dbr_apx_file_id)
                                                    (top_of_buffer)
                                                    (while (&& (search_fwd ";" 1 0)(== obj_buffer_search 1))
                                                        (
                                                            (beginning_of_line)
                                                            (= apx_program_name (read))
                                                            (= apx_program_name (trim (substr apx_program_name 50)))
                                                            (= obj_in_memory (edit_file apx_program_name))
                                                            (= apx_program_buffer (inq_buffer))
                                                            (inq_names NULL NULL current_buffer_name)
                                                            (message "Searching %s..." (upper current_buffer_name))
                                                            (drop_bookmark 2 "y")
                                                            (top_of_buffer)
                                                            (if (search_fwd (+ (+ "<\\c" (+ (_beg_of_rout_scan) "*{ @}|{\\t@}")) (+ object_name "[{\\n}|{\\t@}|{ @}|{(}]")) 1 0)
                                                                (
                                                                    (message "")
                                                                    (= object_buffer (inq_buffer))
                                                                    (= obj_buffer_search 0)
                                                                    (beginning_of_line)
                                                                    (drop_bookmark 1 "y")
                                                                    (drop_anchor 4)
                                                                    (if (search_fwd (+ "<" (_end_of_rout_syntax)) 1 0)
                                                                        (
                                                                            (move_rel 1 0)
                                                                            (cut 0)
                                                                            (goto_bookmark 0)
                                                                            (+= object_name ".OBK")
                                                                            (if (>= (version) 310)
                                                                                (execute_macro "db_hide 4 _object_action")
                                                                            )
                                                                            (create_window 18 (_menu_lines 50) 76 2 (+ (substr object_name 1 (- (index object_name ".") 1)) ": Ctrl-O To Save and Close Object"))
                                                                            (if (exist object_name)
                                                                                (del object_name)
                                                                            )
                                                                            (edit_file object_name)
                                                                            (refresh)
                                                                            (paste)
                                                                            (delete_line)
                                                                            (top_of_buffer)
                                                                            (write_buffer)
                                                                        )
                                                                    ;else
                                                                        (
                                                                            (raise_anchor)
                                                                            (_display_popup_message "Object has no %s statement!" (_end_of_rout_syntax) 1)
                                                                        )
                                                                    )
                                                                )
                                                            ;else
                                                                (
                                                                    (set_buffer dbr_apx_file_id)
                                                                    (if (== obj_in_memory 2)
                                                                        (delete_buffer apx_program_buffer)
                                                                    )
                                                                    (move_rel 1 0)
                                                                )
                                                            )
                                                        )
                                                    )
                                                    (if obj_buffer_search
                                                        (
                                                            (set_buffer apx_start_buffer)
                                                            (attach_buffer apx_start_buffer)
                                                            (_display_popup_message "%s object NOT found!" object_name 1)
                                                            (= obj_buffer_search 0)
                                                            (goto_bookmark 0)
                                                        )
                                                    )
                                                )
                                            ;else
                                                (
                                                    (_display_popup_message "%s object NOT found!" object_name 1)
                                                    (= obj_buffer_search 0)
                                                    (goto_bookmark 0)
                                                )
                                            )
                                        )
                                    )
                                )
                                (message "")
                            )
                        )
                    )
                )
            )
        ;else
            (
                (_display_popup_message "No object call on this line!" "" 1)
                (goto_bookmark 0)
            )
        )
        (if (== dbr_auto_header 99)
            (= dbr_auto_header 1)
        )
    )
)
(macro _implode_object_window
    (
        (message "Replacing object changes...")
        (if (>= (version) 310)
            (execute_macro "db_show 4")
        )
        (if (index object_name ".OBK")
            (
                (if (inq_modified)
                    (write_buffer)
                )
                (delete_window)
                (delete_buffer (inq_buffer))
                (set_buffer object_buffer)
                (goto_bookmark 1)
                (read_file object_name)
                (write_buffer)
                (goto_bookmark 2)
                (if (== dbr_object_backup_flag 0)
                    (del object_name)
                )
                (attach_buffer dbr_current_buffer)
                (message "Object changes to %s complete." (upper (substr object_name  1 (- (index object_name ".") 1))))
            )
        ;else
            (
                (if (inq_modified)
                    (write_buffer)
                )
                (output_file object_name)
                (insert " ")
                (move_rel 0 -1)
                (delete_char)
                (write_buffer)
                (use_local_keyboard _prg_smart)
                (delete_window)
                (set_buffer dbr_current_buffer)
                (attach_buffer dbr_current_buffer)
                (if (== dbr_object_backup_flag 0)
                    (del (+ (substr object_name 1 (- (index object_name ".") 1)) ".OBK"))
                )
                (message "Object changes to %s complete." (upper object_name))
            )
        )
        (if (== obj_in_memory 2)
            (delete_buffer object_buffer)
        )
        (goto_bookmark 0)
    )
)