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

Text File | 1991-03-21 | 9.1 KB | 301 lines

;dBRIEF Display - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro disp
    (
        (string        _dbr_parm1
                        _dbr_parm2
                        _dbr_parm3
        )
        (if (get_parm 0 temp_str "Display [stat,stru,dial,grap,apx]: ")
            (
                (if (< (strlen temp_str) 4)
                    (+= temp_str " ")
                )
                (switch (substr (upper temp_str) 1 4)
                    "APX "
                        (_display_apx_file)
                    "GRAP"
                        (_display_graphics_mode dbr_graphics)
                    "LIBR"
                        (_display_library)
                    "DIAL"
                        (_display_dialect)
                    "STAT"
                        (_status)
                    "TABL"    NULL
                    "STRU"
                        (if (_get_dialect_info dbr_dialect 6)
                            (
                                (if (get_parm 3 _dbr_parm3)
                                    (
                                        (get_parm 1 _dbr_parm1)
                                        (get_parm 2 _dbr_parm2)
                                        (_structure NULL _dbr_parm1 _dbr_parm2 _dbr_parm3)
                                    )
                                ;else
                                    (if (get_parm 2 _dbr_parm2)
                                        (
                                            (get_parm 1 _dbr_parm1)
                                            (_structure NULL _dbr_parm1 _dbr_parm2)
                                        )
                                    ;else
                                        (if (get_parm 1 _dbr_parm1)
                                            (_structure NULL _dbr_parm1 NULL)
                                        ;else
                                            (_structure NULL NULL NULL)
                                        )
                                    )
                                )
                            )
                        ;else
                            (_display_popup_message "DISPLAY STRUCTURE not supported in %s!" (_get_dialect_info dbr_dialect 1) 1)
                        )
                    NULL
                        (if (strlen (trim temp_str))
                            (_display_popup_message "%s is not a valid DISPLAY argument!" (upper temp_str) 1)
                        ;else
                            (_display_popup_message "DISPLAY command requires an argument!" "" 1)
                        )
                )
            )
        )
    )
)
(macro _display_graphics_mode
    (
        (int                graphics_mode
        )
        (get_parm 0 graphics_mode)
        (switch graphics_mode
            1
                (_display_popup_message "Graphics mode is NORMAL." "" 0)
            2
                (_display_popup_message "Graphics mode is DOUBLE." "" 0)
            3
                (_display_popup_message "Graphics mode is COMBINATION." "" 0)
            4
                (_display_popup_message "Graphics mode is SPECIAL." "" 0)
        )
        (return graphics_mode)
    )
)
(macro _display_library
    (_display_popup_message "SourceView library is %s." (upper dbr_library) 0)
)
(macro _display_dialect
    (_display_popup_message "Dialect is %s." (_get_dialect_info dbr_dialect 1) 0)
)
(macro _status
    (
        (int            setcmds_buffer
        )
        (= dbr_current_buffer (inq_buffer))
        (= setcmds_buffer (create_buffer "Status" NULL 1))
        (set_buffer setcmds_buffer)
        (if (>= (version) 310)
            (execute_macro "db_hide 1")
        )
        (create_window 8 21 72 1 "SET Command Status  -  [press any key]")
        (if (>= (version) 310)
            (execute_macro "db_show 1")
        )
        (attach_buffer setcmds_buffer)
        (insert      "Current Status                            Set Commands\n")
        (insert      "───────────────────────────────  ──────────────────────────────\n")
        (if (== dbr_auto_indent 1)
            (insert "        Auto indent: ON                set indent [on,off]\n")
        ;else
            (insert "        Auto indent: OFF                set indent [on,off]\n")
        )
        (if (== dbr_auto_header 1)
            (insert "        Auto header: ON                set header [on,off]\n")
        ;else
            (insert "        Auto header: OFF                set header [on,off]\n")
        )
        (if (== dbr_set_ext 1)
            (insert "        Default Ext: ON                set extension [on,off]\n")
        ;else
            (insert "        Default Ext: OFF                set extension [on,off]\n")
        )
        (if (== dbr_template 1)
            (insert " Template editing: ON                set template [on,off]\n")
        ;else
            (insert " Template editing: OFF                set template [on,off]\n")
        )
        (sprintf temp_str " Language Dialect: %s  set dialect to ...\n" (substr (+ (_get_dialect_info dbr_dialect 1) "                  ") 1 12))
        (insert temp_str)
        (switch dbr_graphics
            1
                (insert "     Graphics mode: NORMAL            set graphics to <spec>\n")
            2
                (insert "     Graphics mode: DOUBLE            set graphics to <spec>\n")
            3
                (insert "     Graphics mode: COMBINATION    set graphics to <spec>\n")
            4
                (insert "     Graphics mode: SPECIAL            set graphics to <spec>\n")
        )
        (sprintf temp_str "        Indent level: %d                  set indent to ...\n" dbr_indent_level)
        (insert temp_str)
        (sprintf temp_str "         Comment tab: %d                 set comment to ...\n" dbr_comment_tab)
        (insert temp_str)
        (sprintf temp_str "              Library: %s  set library to ...\n" (substr dbr_library 1 12))
        (insert temp_str)
        (if (== dbr_comment_lines 1)
            (insert " Comment line #'s: ON                set comment lines [on,off]\n")
        ;else
            (insert " Comment line #'s: OFF                set comment lines [on,off]\n")
        )
        (if (== dbr_proc_indent 1)
            (insert " Procedure indent: ON                set procedure indent [on,off]\n")
        ;else
            (insert " Procedure indent: OFF                set procedure indent [on,off]\n")
        )
        (insert "───────────────────────── Constants ───────────────────────────\n")
        (sprintf temp_str "                Author: %s\n" dbr_author)
        (insert temp_str)
        (sprintf temp_str "            Copyright: %s\n" dbr_copyright)
        (insert temp_str)
        (sprintf temp_str " Memvar lead char: %s\n" dbr_mem_lead)
        (insert temp_str)
        (sprintf temp_str "Memvar trail char: %s\n" dbr_mem_trail)
        (insert temp_str)
        (sprintf temp_str "Default extension: %s\n" (_get_dialect_info dbr_dialect 3))
        (insert temp_str)
        (top_of_buffer)
        (refresh)
        (_pause_for_seconds dbr_scr_seconds)
        (delete_window)
        (delete_buffer setcmds_buffer)
        (set_buffer dbr_current_buffer)
        (attach_buffer dbr_current_buffer)
    )
)
(macro _display_procedure
    (
        (int                    pop_current_buffer
                                pop_display_buffer
                                line_position
                                col_position
                                proc_line
        )
        (string                program_name
                                procedure_name
                                procedure_parms
                                private_parms
                                public_parms
                                routine_type
                                pop_display_prompt
                                pop_temp_str
                                select_area
                                use_dbf
                                filter
        )
        (inq_position line_position col_position)
        (inq_names NULL NULL program_name)
        (if (search_back (+ "<\\c" (+ (_beg_of_rout_scan) "*{ @}|{\\t@}")) 1 0)
            (
                (inq_position proc_line NULL)
                (= procedure_name (trim (upper (read))))
                (if (index (_beg_of_proc_scan) (upper (substr procedure_name 1 4)))
                    (= routine_type "  Procedure")
                ;else
                    (= routine_type "      Function")
                )
                (= procedure_name (substr procedure_name (+ (index procedure_name " ") 1)))
            )
        ;else
            (
                (= routine_type "  Procedure")
                (= procedure_name (upper program_name))
                (= proc_line 1)
            )
        )
        (= procedure_parms (_seek_keyword "PARA" proc_line line_position "PARA"))
        (= private_parms (_seek_keyword "PRIV" proc_line line_position "PRIV"))
        (= public_parms (_seek_keyword "PUBL" proc_line line_position "PUBL"))
        (= select_area (_seek_keyword "SELE" proc_line line_position "SELE"))
        (= use_dbf (_seek_keyword "USE " proc_line line_position "USE "))
        (= filter (_seek_keyword "SET FILT" proc_line line_position " TO "))
        (sprintf pop_display_prompt "Program: %s  [press any key]" (upper program_name))
        (= pop_current_buffer (inq_buffer))
        (= pop_display_buffer (create_buffer "Stats" NULL 1))
        (if (>= (version) 310)
            (execute_macro "db_hide 1")
        )
        (create_window 16 21 76 09 pop_display_prompt)
        (if (>= (version) 310)
            (execute_macro "db_show 1")
        )
        (set_buffer pop_display_buffer)
        (attach_buffer pop_display_buffer)
        (sprintf pop_temp_str "Program Status At Line %d." line_position)
        (move_abs 2 3)
        (insert pop_temp_str)
        (move_abs 3 3)
        (insert "───────────────────────────────────────────────────────")
        (sprintf pop_temp_str "%s: %s  at line # %d" routine_type procedure_name proc_line)
        (move_abs 4 3)
        (insert pop_temp_str)
        (sprintf pop_temp_str " Parameters: %s " procedure_parms)
        (move_abs 5 3)
        (insert pop_temp_str)
        (sprintf pop_temp_str "        Publics: %s " public_parms)
        (move_abs 6 3)
        (insert pop_temp_str)
        (sprintf pop_temp_str "      Privates: %s " private_parms)
        (move_abs 7 3)
        (insert pop_temp_str)
        (sprintf pop_temp_str "Select area: %s " select_area)
        (move_abs 8 3)
        (insert pop_temp_str)
        (sprintf pop_temp_str "      Database: %s " use_dbf)
        (move_abs 9 3)
        (insert pop_temp_str)
        (sprintf pop_temp_str "         Filter: %s " filter)
        (move_abs 10 3)
        (insert pop_temp_str)
        (refresh)
        (_pause_for_seconds dbr_scr_seconds)
        (delete_window)
        (set_buffer pop_current_buffer)
        (attach_buffer pop_current_buffer)
        (delete_buffer pop_display_buffer)
        (move_abs line_position col_position)
    )
)
(macro _seek_keyword
    (
        (int                key_start_line
                            key_end_line
        )
        (string            key_string
                            key_temp_string
                            key_beg_string
        )
        (get_parm 0 key_string)
        (get_parm 1 key_start_line)
        (get_parm 2 key_end_line)
        (get_parm 3 key_beg_string)
        (move_abs key_start_line 1)
        (drop_anchor)
        (move_abs key_end_line 0)
        (end_of_line)
        (if (search_back (+ (+ "<{ @}|{\\t@}{" key_string) "}*{ @}|{\\t@}") 1 0 1)
            (
                (search_fwd key_beg_string 1 0)
                (= key_temp_string (trim (ltrim (read))))
                (= key_temp_string (substr key_temp_string (+ (index key_temp_string " ") 1)))
            )
        ;else
            (= key_temp_string "Unknown.")
        )
        (raise_anchor)
        (if (index key_temp_string "&&")
            (= key_temp_string (trim (substr key_temp_string 1 (- (index key_temp_string "&&") 1))))
        )
        (return (substr key_temp_string 1 42))
    )
)