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

Text File | 1991-03-21 | 6.5 KB | 242 lines

;Crossreferencing System - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro _find_constant
    (
        (int buf_start_buffer
              buf_buffer_search
              row
              col
              token_loc
              incl_row
              incl_in_memory
              include_buffer
              search_buffer
        )
        (string constant
                  value
                  msge
                  file_name
                  include_file
        )
        (inq_position row col)
        (search_back "{<}|{[!\*()=+ \t]}\\c")
        (= msge (trim (ltrim (read))))
        (= token_loc (search_string "[!\*()=+ \t]" msge))
        (if token_loc
            (= constant (substr msge 1 (- token_loc 1)))
        ;else
            (= constant msge)
        )
        (= msge "")
        (= incl_row row)
        (if (strlen constant)
            (
                (message "Searching for constant definition...")
                (= buf_start_buffer (inq_buffer))
                (= buf_buffer_search 1)
                (while buf_buffer_search
                    (
                        (inq_names NULL NULL file_name)
                        (if (search_back (+ "#define[ \t]@" (+ constant "\\c")) 1 1)
                            (
                                 (= value (trim (ltrim (read))))
                                (message "")
                                (if (== "\"" (substr value 1 1))
                                    (= value (substr value 2 (- (rindex value "\"") 2)))
                                )
                                (= search_buffer (inq_buffer))
                                (if (!= search_buffer buf_start_buffer)
                                    (
                                        (restore_position)
                                        (if (!= incl_in_memory 1)
                                            (delete_buffer search_buffer)
                                        )
                                    )
                                )
                                (set_buffer buf_start_buffer)
                                (move_abs row col)
                                (= buf_buffer_search 0)
                            )
                        ;else
                            (
                                (= search_buffer (inq_buffer))
                                (if (!= search_buffer buf_start_buffer)
                                    (
                                        (restore_position)
                                        (if (!= incl_in_memory 1)
                                            (delete_buffer search_buffer)
                                        )
                                    )
                                )
                                (set_buffer buf_start_buffer)
                                (move_abs incl_row NULL)
                                (if (! (move_rel -1 0))
                                    (
                                        (= buf_buffer_search 0)
                                        (= value "")
                                        (break)
                                    )
                                )
                                (if (search_back "<[ \t]@#include\\c")
                                    (
                                        (inq_position incl_row NULL)
                                        (= include_file (trim (ltrim (read))))
                                        (if (index include_file ">")
                                             (= include_file (substr include_file 2 (- (index include_file ">") 2)))
                                        ;else
                                            (if (index include_file "\"")
                                                (= include_file (substr include_file 2 (- (rindex include_file "\"") 2)))
                                            ;else
                                                (= include_file (trim (substr include_file 1 (+ (index include_file ".") 3))))
                                            )
                                        )
                                        (= value include_file)
                                        (= include_file (search_path (inq_environment "INCLUDE") include_file))
                                        (if (strlen include_file)         ; if the include file object exists
                                            (
                                                (= incl_in_memory (edit_file include_file))     ; edit the file to see if it's already in memory
                                                (= include_buffer (inq_buffer))     ; get the file id
                                                (save_position)
                                                (= value "")
                                                (end_of_buffer)
                                            )
                                        ;else
                                            (
                                                (_display_popup_message "Unable to locate %s!" (upper value) 1)
                                                (= value "")
                                                (break)
                                                (_pause_for_seconds dbr_msg_seconds)
                                            )
                                        )
                                    )
                                ;else
                                    (
                                        (= buf_buffer_search 0)
                                        (= value "")
                                        (break)
                                        (move_abs row col)
                                    )
                                )
                            )
                        )
                    )
                )
                (set_buffer buf_start_buffer)
                (attach_buffer buf_start_buffer)
                (refresh)
                (if (strlen value)                            ; if we really did find something worth reporting
                    (
                        (sprintf msge "%s = %s" constant value) ; build the result display
                        (_display_constant msge "" 0 file_name) ; display the constant value
                    )
                ;else                                                ; no value discernable
                    (_display_constant "%s not found!" (trim constant) 1 "[press any key]")
                )
            )
        ;else
            (_display_popup_message "Is this a constant?" "" 1)
        )
        (move_abs row col)
    )
)
(macro _display_constant
    (
        (int pop_error)
        (string pop_message_string
                  pop_message_parm
                  found_file_name
        )
        (get_parm 0 pop_message_string)
        (get_parm 1 pop_message_parm)
        (get_parm 2 pop_error)
        (get_parm 3 found_file_name)
        (int pop_current_buffer
              pop_display_buffer
              pop_screen_lines
              pop_screen_height
              pop_window_width
              pop_beep_count
        )
        (string pop_temp_str
                  _line_1
                  _line_2
        )
        (if (> (strlen pop_message_parm) 40)
            (= pop_message_parm (trim (substr pop_message_parm 1 40)))
        )
        (if (index pop_message_string "\n")
            (
                (= pop_screen_height 9)
                (= _line_1 (substr pop_message_string 1 (index pop_message_string "\n")))
                (sprintf _line_1 _line_1 pop_message_parm)
                (= _line_2 (substr pop_message_string (+ (index pop_message_string "\n") 1)))
                (sprintf _line_2 _line_2 pop_message_parm)
            )
        ;else
            (
                (= pop_screen_height 8)
                (sprintf _line_1 pop_message_string pop_message_parm)
                (= _line_2 "")
            )
        )
        (if (> (strlen (+ _line_1 pop_message_parm)) (strlen _line_2))
            (
                (= pop_window_width (+ (strlen (+ _line_1 pop_message_parm)) 8))
                (= pop_message_string _line_1)
            )
        ;else
            (
                (= pop_window_width (+ (strlen _line_2) 10))
                (= pop_message_string _line_2)
            )
        )
        (if (> pop_window_width 72)
            (= pop_window_width 72)
        )
        (inq_screen_size pop_screen_lines NULL)
        (= pop_current_buffer (inq_buffer))
        (if pop_error
            (
                (while (<= (++ pop_beep_count) 2)
                    (beep)
                    )
                (= pop_display_buffer (create_buffer "ConstantXRef" NULL 1))
            )
        ;else
            (= pop_display_buffer (create_buffer "ConstantXRef" NULL 1))
        )
        (if (>= (version) 310)
            (execute_macro "db_hide 1")
        )
        (create_window (- 80 pop_window_width) (- pop_screen_lines 4) 75 (- pop_screen_lines pop_screen_height) found_file_name)
        (if (>= (version) 310)
            (execute_macro "db_show 1")
        )
        (set_buffer pop_display_buffer)
        (attach_buffer pop_display_buffer)
        (if (== pop_screen_height 8)
            (
                (move_abs 2 (- (/ (- pop_window_width (strlen _line_1)) 2) 2))
                (insert _line_1)
            )
        ;else
            (
                (move_abs 2 (- (/ (- pop_window_width (strlen _line_1)) 2) 2))
                (insert _line_1)
                (move_abs 3 (- (/ (- pop_window_width (strlen _line_2)) 2) 2))
                (insert _line_2)
            )
        )
        (beginning_of_line)
        (top_of_buffer)
        (refresh)
        (_pause_for_seconds dbr_msg_seconds)
        (delete_window)
        (set_buffer pop_current_buffer)
        (attach_buffer pop_current_buffer)
        (delete_buffer pop_display_buffer)
    )
)