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

Text File | 1991-03-21 | 16.2 KB | 568 lines

;dBRIEF Scanner - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
#define  PrevScanMenu                "prevscan.txt"
(macro tag
    (
        (save_position)
        (beginning_of_line)
        (= temp_str (read))
        (if (index temp_str (+ (_comment_character 1) " dBRIEF Tag..."))
            (
                (move_abs 0 1)
                (delete_to_eol)
                (insert (trim (substr temp_str 1 (- (index temp_str (+ (_comment_character 1) " dBRIEF Tag...")) 1))))
                (message "Tag removed.")
            )
        ;else
            (
                (if (> (strlen (trim temp_str)) dbr_comment_tab)
                    (end_of_line)
                ;else
                    (move_abs 0 dbr_comment_tab)
                )
                (insert (+ (_comment_character 1) " dBRIEF Tag..."))
                (message "Tag placed.")
            )
        )
        (restore_position)
    )
)
(macro unta
    (
        (save_position)
        (top_of_buffer)
        (= temp_int 0)
        (while (search_fwd (+ (_comment_character 1) " dBRIEF Tag...") 0)
            (
                (delete_to_eol)
                (message "Tags removed: %d" (++ temp_int))
            )
        )
        (restore_position)
    )
)
(macro scan
    (
        (extern            _reg_exp
        )
        (int                scan_global_flag
                            _temp_reg_exp
                            _temp_case
                            _invalid_buffer
        )
        (string            scan_search_str
                            tmp_path
        )
        (= _temp_reg_exp _reg_exp)
        (= _temp_case (search_case 1))
        (if _reg_exp
            (= temp_str "Text to scan for [expr=on]: ")
        ;else
            (= temp_str "Text to scan for [expr=off]: ")
        )
        (if (get_parm 0 scan_search_str temp_str)
            (
                (if (== (upper (substr scan_search_str 1 4)) "GLOB")
                    (
                        (get_parm 1 scan_search_str)
                        (= scan_global_flag 1)
                    )
                ;else
                    (= scan_global_flag 0)
                )
                (if (&& (== _reg_exp 0)(index "UDFS~UDCS~UDPS~ROUT~PROC~FUNC~COMM~APX" (upper (substr scan_search_str 1 4))))
                    (= _reg_exp 1)
                )
                (= tmp_path (inq_environment "BTMP"))
                (if (! (strlen tmp_path))
                    (= tmp_path (inq_environment "TMP"))
                )
                (if (! (strlen tmp_path))
                    (= tmp_path PrevScanMenu)
                ;else
                    (if (! (rindex "\\/" (substr tmp_path (strlen tmp_path) 1)))
                        (+= tmp_path (+ "\\" PrevScanMenu))
                    ;else
                        (+= tmp_path PrevScanMenu)
                    )
                )
                (= _invalid_buffer (create_buffer "Scanner" tmp_path 1))
                (if (! _invalid_buffer)
                    (= tmp_path PrevScanMenu)
                ;else
                    (delete_buffer _invalid_buffer)
                )
                (if (&& (exist tmp_path)(!= (upper (substr scan_search_str 1 4)) "PREV"))
                    (del tmp_path)
                )
                (switch (upper (substr scan_search_str 1 4))
                    "SIZE"
                        (_scan_source "SIZE" "<~.~.~." scan_global_flag tmp_path)
                    "UDCS"
                        (_scan_source "UDCs" "#command" scan_global_flag tmp_path)
                    "ROUT"
                        (_scan_source "ROUTINES" (+ "<" (_beg_of_rout_scan)) scan_global_flag tmp_path)
                    "UDPS"    NULL
                    "PROC"
                        (_scan_source "PROCEDURES" (+ "<" (_beg_of_proc_scan)) scan_global_flag tmp_path)
                    "UDFS"    NULL
                    "FUNC"
                        (_scan_source "FUNCTIONS" (+ "<" (_beg_of_func_scan)) scan_global_flag tmp_path)
                    "COMM"
                        (_scan_source "COMMENTS" (_comment_character 1) scan_global_flag tmp_path)
                    "NOTE"
                        (_scan_source "NOTES" (+ "< @\t@" (_comment_character 2)) scan_global_flag tmp_path)
                    "TAGS"
                        (_scan_source "TAGS" (+ (_comment_character 1)" dBRIEF Tag...") scan_global_flag tmp_path)
                    "APX"
                        (if dbr_apx_file_id
                            (
                                (get_parm 1 scan_search_str "Text to scan APX for: ")
                                (switch (upper (substr scan_search_str 1 4))
                                    "ROUT"
                                        (_scan_apx_programs_r)
                                    "PROC"
                                        (_scan_apx_programs_p)
                                    "FUNC"
                                        (_scan_apx_programs_f)
                                    NULL
                                        (
                                            (if (!= dbr_apx_file_id 0)
                                                (_apx_scan_menu scan_search_str (upper scan_search_str))
                                            ;else
                                                (_display_popup_message "APX file not loaded!" "" 1)
                                            )
                                        )
                                )
                            )
                        ;else
                            (_display_popup_message "APX file not open!" "" 1)
                        )
                    "PREV"
                        (if (&& (== dbr_previous_scan 1)(exist tmp_path))
                            (_scan_source "" "" scan_global_flag tmp_path)
                        ;else
                            (if (== dbr_previous_scan 1)
                                (_display_popup_message "No previous scan available!" "" 1)
                            ;else
                                (_display_popup_message "SCAN PREVIOUS command not enabled!" "" 1)
                            )
                        )
                    NULL
                        (if (strlen scan_search_str)
                            (
                                (search_case _temp_case)
                                (_scan_source (upper scan_search_str) scan_search_str scan_global_flag tmp_path)
                            )
                        ;else
                            (_display_popup_message "No text to scan!" "" 1)
                        )
                )
                (= _reg_exp _temp_reg_exp)
                (search_case _temp_case)
            )
        )
    )
)
(macro _scan_source
    (
        (extern _pick_menu
        )
        (int        program_line
                    menu_buffer
                    glb_buffer_search
                    glb_start_buffer
                    glb_scan_line
                    glb_scan_col
                    glb_search_flag
                    glb_line_count
                    glb_byte_count
                    tmp_line_count
                    tmp_byte_count
                    bb_line
                    eb_line
        )
        (string  _search_lbl
                    _search_str
                    menu_line
                    routine_name
                    glb_buffer_name
                    glb_file_name
                    tmp_path
        )
        (get_parm 0 _search_lbl)
        (get_parm 1 _search_str)
        (get_parm 2 glb_search_flag)
        (get_parm 3 tmp_path)
        (= temp_int 0)
        (if (inq_marked)
            (inq_marked bb_line NULL eb_line NULL)
        )
        (= dbr_current_buffer (inq_buffer))
        (= glb_start_buffer (inq_buffer))
        (if (exist tmp_path)
            (= glb_buffer_search 0)
        ;else
            (= glb_buffer_search 1)
        )
        (= menu_buffer (create_buffer "Scanner" tmp_path 1))
        (while glb_buffer_search
            (
                (inq_names glb_buffer_name NULL glb_file_name)
                (inq_position glb_scan_line glb_scan_col)
                (top_of_buffer)
                (if (== glb_search_flag 1)
                    (if (== _search_lbl "SIZE")
                        (
                            (= tmp_byte_count (_number_bytes))
                            (= tmp_line_count (_number_lines))
                            (+= glb_byte_count tmp_byte_count)
                            (+= glb_line_count tmp_line_count)
                            (sprintf menu_line "─── %s %s# Lines: %07d  # Bytes: %07d        |GLOBAL||%s\n" (upper glb_file_name) (_replicate " " (- 15 (strlen glb_file_name))) tmp_line_count tmp_byte_count glb_buffer_name)
                        )
                    ;else
                          (sprintf menu_line "────── %s ──────%s|GLOBAL||%s\n" (upper glb_file_name) (_replicate " " 45) glb_buffer_name)
                        ;(sprintf menu_line "────── %s ──────%s|GLOBAL||%s\n" (upper glb_file_name) (_replicate " " (- (inq_line_length) 90)) glb_buffer_name)
                    )
                )
                (set_buffer menu_buffer)
                (insert menu_line)
                (set_buffer dbr_current_buffer)
                (message "Scanning %s for %s..." (upper glb_file_name) _search_lbl)
                (while (&& (search_fwd _search_str _reg_exp)(! (inq_kbd_char)))
                    (
                        (beginning_of_line)
                        (= routine_name (ltrim (read)))
                        (if (== _search_lbl "COMMENTS")
                            (if (index routine_name (_comment_character 1))
                                (= routine_name (substr routine_name (index routine_name (_comment_character 1))))
                            )
                        )
                        (if (strlen routine_name)
                            (
                                (++ temp_int)
                                (message "Scanning %s for %s [#%d]..." (upper glb_file_name) _search_lbl temp_int)
                                (inq_position program_line)
                                (if (&& (>= program_line bb_line)(<= program_line eb_line))
                                    ;(sprintf menu_line "%05d< %s ||%s\n" program_line (substr (_pad_right routine_name (- (inq_line_length) 68)) 1 (- (inq_line_length) 68)) glb_buffer_name)
                                    (sprintf menu_line "%05d< %s ||%s\n" program_line (substr (_pad_right routine_name 53) 1 53) glb_buffer_name)
                                ;else
                                    (sprintf menu_line "%05d: %s ||%s\n" program_line (substr (_pad_right routine_name 53) 1 53) glb_buffer_name)
                                    ;(sprintf menu_line "%05d: %s ||%s\n" program_line (substr (_pad_right routine_name (- (inq_line_length) 68)) 1 (- (inq_line_length) 68)) glb_buffer_name)
                                )
                                (set_buffer menu_buffer)
                                (insert menu_line)
                                (set_buffer dbr_current_buffer)
                            )
                        )
                        (move_rel 1 0)
                        (move_abs 0 1)
                    )
                )
                (move_abs glb_scan_line glb_scan_col)
                (if glb_search_flag
                    (
                        (set_buffer (next_buffer))
                        (if (== glb_start_buffer (inq_buffer))
                            (= glb_buffer_search 0)
                        )
                        (= dbr_current_buffer (inq_buffer))
                    )
                ;else
                    (= glb_buffer_search 0)
                )
            )
        )
        (keyboard_flush)
        (= temp_int 0)
        (set_buffer menu_buffer)
        (if (&& (== dbr_previous_scan 1)(inq_modified))
            (write_buffer)
        )
        (end_of_buffer)
        (delete_line)
        (inq_position program_line)
        (top_of_buffer)
        (set_buffer glb_start_buffer)
        (if (> program_line 1)
            (
                (if glb_search_flag
                    (if (== _search_lbl "SIZE")
                        (
                            (sprintf _search_lbl "Lines = %d  Bytes = %d" glb_line_count glb_byte_count)
                            (_pick_menu "" "" 15 (_menu_lines program_line) 76 3 "_scan_jump" menu_buffer (+  _search_lbl " <Grey[-] to Print>"))
                        )
                    ;else
                        (_pick_menu "" "" 15 (_menu_lines program_line) 76 3 "_scan_jump" menu_buffer (+ (+ "Global Scan: " (trim (substr _search_lbl 1 32))) " <Grey[-] to Print>"))
                    )
                ;else
                    (
                        (_pick_menu "" "" 15 (_menu_lines program_line) 76 3 "_scan_jump" menu_buffer (+ "Local Scan: " (trim (substr _search_lbl 1 32))))
                    )
                )
                (if (!= temp_str "NULL")
                    (
                        (if (inq_marked)
                            (raise_anchor)
                        )
                        (if (strlen (trim temp_str))
                            (edit_file temp_str)
                        )
                        (if temp_int
                            (goto_line temp_int)
                        )
                    )
                )
            )
        ;else
            (
                (_display_popup_message "Scan for %s unsuccessful." _search_lbl 1)
                (delete_buffer menu_buffer)
            )
        )
    )
)
(macro _scan_jump
    (
        (int                scan_event_type
        )
        (string            scan_event_string
                            print_output
                            destination_file
        )
        (get_parm 0 scan_event_type)
        (get_parm 1 scan_event_string)
        (switch scan_event_type
            45
                (
                    (get_parm 2 print_output "Print to Printer or File [Pf]: " 1 "P")
                    (if (== (upper print_output) "F")
                        (if (! (get_parm 3 destination_file "Output file name: "))
                            (return 0)
                        )
                    )
                    (top_of_buffer)
                    (if (search_fwd "|GLOBAL||" 0)
                        (
                            (translate "[ \t]@\\|GLOBAL*>" "" 1 -1 0)
                            (translate "[ \t]@\\|\\|*>" "" 1 -1 0)
                            (top_of_buffer)
                            (insert "Global Scan Print\n")
                            (insert (+ (_replicate "-" 50) "\n"))
                            (insert "Line#  Source Line\n")
                            (insert (+ "----- " (+ (_replicate "-" 44) "\n")))
                            (end_of_buffer)
                            (insert "\n\n")
                            (top_of_buffer)
                            (drop_anchor)
                            (end_of_buffer)
                            (if (== (upper print_output) "P")
                                (print)
                            ;else
                                (if (&& (strlen destination_file)(== (upper print_output) "F"))
                                    (
                                        (copy)
                                        (if (exist destination_file)
                                            (del destination_file)
                                        )
                                        (edit_file destination_file)
                                        (paste)
                                        (write_buffer)
                                        (delete_buffer (inq_buffer))
                                    )
                                )
                            )
                        )
                    ;else
                        (_display_popup_message "Print scan is only available with SCAN GLOBAL and SCAN APX options!" "" 1)
                    )
                    (= temp_int 0)
                    (= temp_str "NULL")
                    (exit)
                )
            27
                (
                    (= temp_int 0)
                    (= temp_str "NULL")
                    (exit)
                )
            13
                (
                    (if (index scan_event_string "|GLOBAL||")
                        (
                            (= temp_int 0)
                            (= temp_str (trim (substr scan_event_string (+ (index scan_event_string "||") 2))))
                        )
                    ;else
                        (
                            (= temp_int (atoi (substr scan_event_string 1 5)))
                            (= temp_str (trim (substr scan_event_string (+ (index scan_event_string "||") 2))))
                        )
                    )
                    (exit)
                )
            03        NULL
            02        NULL
            00        NULL
            01
                (if (index scan_event_string "|GLOBAL||")
                    (message "Jump to %s" (trim (upper (substr scan_event_string (+ (index scan_event_string "||") 2)))))
                ;else
                    (message "Jump to line %s in %s" (substr scan_event_string 1 5) (trim (upper (substr scan_event_string (+ (index scan_event_string "||") 2)))))
                )
        )
        (return 1)
    )
)
(macro repl
    (
        (int                repl_global_flag
                            repl_start_buffer
                            repl_buffer_search
                            repl_scan_line
                            repl_scan_col
                            repl_count
                            repl_abort_flag
                            apx_not_in_memory
                            apx_program_buffer
        )
        (string            repl_search_str
                            repl_replace_str
                            repl_action
                            repl_prompt
                            repl_buffer_name
                            apx_program_name
        )
        (if (! (get_parm 0 repl_action "Global or APX [Ga]: " 6 "Global"))
            (return 0)
        )
        (if (! (get_parm 1 repl_search_str "Text to replace: "))
            (return 0)
        )
        (if (! (get_parm 3 repl_replace_str "Text to replace with: "))
            (return 0)
        )
        (if (! (get_parm 4 repl_prompt "Prompt each replacement? [yN]: " 1 "N"))
            (return 0)
        )
        (if (get_parm 5 temp_str "Replace not undo-able, continue? [yN]: " 1 "N")
            (if (!= (upper temp_str) "Y")
                (return 0)
            )
        )
        (if (== (substr (upper repl_action) 1 1) "G")
            (
                (= repl_buffer_search 1)
                (= repl_start_buffer (inq_buffer))
                (while repl_buffer_search
                    (
                        (inq_position repl_scan_line repl_scan_col)
                        (top_of_buffer)
                        (if (== (upper repl_prompt) "N")
                            (if (! (inq_kbd_char))
                                (+= repl_count (translate repl_search_str repl_replace_str 1 0 NULL 0 1))
                            ;else
                                (
                                    (= repl_buffer_search 0)
                                    (= repl_abort_flag 1)
                                )
                            )
                        ;else
                            (+= repl_count (translate repl_search_str repl_replace_str NULL NULL NULL 0 1))
                        )
                        (move_abs repl_scan_line repl_scan_col)
                        (set_buffer (next_buffer))
                        (if (== repl_start_buffer (inq_buffer))
                            (= repl_buffer_search 0)
                        )
                        (= dbr_current_buffer (inq_buffer))
                        (attach_buffer dbr_current_buffer)
                        (refresh)
                        (inq_names NULL NULL repl_buffer_name)
                        (message "%d replacements in %s." repl_count repl_buffer_name 0)
                    )
                )
                (keyboard_flush)
                (set_buffer repl_start_buffer)
                (attach_buffer repl_start_buffer)
                (sprintf temp_str "%d" repl_count)
                (if repl_count
                    (if repl_abort_flag
                        (_display_popup_message "%s replacements before user abort!" temp_str 1)
                    ;else
                        (_display_popup_message "%s replacements." temp_str 0)
                    )
                ;else
                    (_display_popup_message "Pattern %s not found!" repl_search_str 1)
                )
            )
        ;else
            (if (== (substr (upper repl_action) 1 1) "A")
                (if dbr_apx_file_id
                    (
                        (= repl_buffer_search 1)
                        (= repl_start_buffer (inq_buffer))
                        (set_buffer dbr_apx_file_id)
                        (top_of_buffer)
                        (while (&& (&& (search_fwd ";" 1 0)(! (inq_kbd_char)))(== repl_buffer_search 1))
                            (
                                (beginning_of_line)
                                (= apx_program_name (read))
                                (= apx_program_name (trim (substr apx_program_name 50)))
                                (= apx_not_in_memory (edit_file apx_program_name))
                                (= apx_program_buffer (inq_buffer))
                                (inq_position repl_scan_line repl_scan_col)
                                (top_of_buffer)
                                (if (== (upper repl_prompt) "N")
                                    (if (! (inq_kbd_char))
                                        (+= repl_count (translate repl_search_str repl_replace_str 1 NULL NULL 0 1))
                                    ;else
                                        (
                                            (= repl_buffer_search 0)
                                            (= repl_abort_flag 1)
                                        )
                                    )
                                ;else
                                    (+= repl_count (translate repl_search_str repl_replace_str NULL NULL NULL 0 1))
                                )
                                (move_abs repl_scan_line repl_scan_col)
                                (inq_names NULL NULL repl_buffer_name)
                                (message "%d replacements in %s." repl_count repl_buffer_name 0)
                                (if (inq_modified)
                                    (write_buffer)
                                )
                                (set_buffer dbr_apx_file_id)
                                (if (== apx_not_in_memory 2)
                                    (
                                        (delete_buffer apx_program_buffer)
                                    )
                                )
                                (move_rel 1 0)
                            )
                        )
                        (keyboard_flush)
                        (set_buffer repl_start_buffer)
                        (attach_buffer repl_start_buffer)
                        (sprintf temp_str "%d" repl_count)
                        (if repl_count
                            (if repl_abort_flag
                                (_display_popup_message "%s replacements before user abort!" temp_str 1)
                            ;else
                                (_display_popup_message "%s replacements." temp_str 0)
                            )
                        ;else
                            (_display_popup_message "Pattern %s not found!" repl_search_str 1)
                        )
                    )
                ;else
                    (_display_popup_message "APX file not loaded!" "" 1)
                )
            ;else
                (_display_popup_message "Invalid option %s!" repl_action 1)
            )
        )
    )
)