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

Text File | 1991-03-21 | 17.0 KB | 575 lines

;dBRIEF Setcmds - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro setu
    (
        (if (== (inq_assignment "_implode_object_window" 1) "")
            (
                (message "Please wait...")
                (string  _dbr_author
                            _dbr_copyright
                            _dbr_mem_lead
                            _dbr_mem_trail
                            _dbrief_dir
                )
                (int        box_buffer
                )
                (= dbr_current_buffer (inq_buffer))
                (= _dbrief_dir (search_path  (inq_environment "BPATH") "dbrief.h"))
                (= dbr_current_window (create_buffer "dbrief.h" _dbrief_dir 1))
                (= _dbr_author dbr_author)
                (= _dbr_copyright dbr_copyright)
                (= _dbr_mem_lead dbr_mem_lead)
                (= _dbr_mem_trail dbr_mem_trail)
                (= box_buffer (create_buffer "Setup" NULL 1))
                (set_buffer box_buffer)
                (insert "Text(1,1) \"        Auto Indent:\"\n")
                (if (== dbr_auto_indent 1)
                    (insert "List(1,20) \"(On)Off\"\n")
                ;else
                    (insert "List(1,20) \"On(Off)\"\n")
                )
                (insert "Text(2,1) \"        Auto Header:\"\n")
                (if (== dbr_auto_header 1)
                    (insert "List(2,20) \"(On)Off\"\n")
                ;else
                    (insert "List(2,20) \"On(Off)\"\n")
                )
                (insert "Text(3,1) \"        Default Ext:\"\n")
                (if (== dbr_set_ext 1)
                    (insert "List(3,20) \"(On)Off\"\n")
                ;else
                    (insert "List(3,20) \"On(Off)\"\n")
                )
                (insert "Text(4,1) \" Template editing:\"\n")
                (if (== dbr_template 1)
                    (insert "List(4,20) \"(On)Off\"\n")
                ;else
                    (insert "List(4,20) \"On(Off)\"\n")
                )
                (insert "Text(5,1) \" Language Dialect:\"\n")
                (sprintf temp_str "String(5,20) \"%s\"\n" (_get_dialect_info dbr_dialect 1))
                (insert temp_str)
                (insert "Text(6,1) \"     Graphics Mode:\"\n")
                (switch dbr_graphics
                    1
                        (insert "List(6,20) \"(Normal)Double\tCombination\tSpecial\"\n")
                    2
                        (insert "List(6,20) \"Normal(Double)Combination\tSpecial\"\n")
                    3
                        (insert "List(6,20) \"Normal\tDouble(Combination)Special\"\n")
                    4
                        (insert "List(6,20) \"Normal\tDouble\tCombination(Special)\"\n")
                    NULL
                        (insert "List(6,20) \"(Normal)Double\tCombination\tSpecial\"\n")
                )
                (insert "Text(7,1) \"        Comment tab:\"\n")
                (sprintf temp_str "Integer(7,20) \"%d\"\n" dbr_comment_tab)
                (insert temp_str)
                (insert "Text(8,1) \"             Library:\"\n")
                (sprintf temp_str "String(8,20) \"%s\"\n" dbr_library)
                (insert temp_str)
                (insert "Text(9,1) \" Comment line #'s:\"\n")
                (if (== dbr_comment_lines 1)
                    (insert "List(9,20) \"(On)Off\"\n")
                ;else
                    (insert "List(9,20) \"On(Off)\"\n")
                )
                (insert "Text(10,1) \" Procedure indent:\"\n")
                (if (== dbr_proc_indent 1)
                    (insert "List(10,20) \"(On)Off\"\n")
                ;else
                    (insert "List(10,20) \"On(Off)\"\n")
                )
                (insert "Text(11,1) \"                Author:\"\n")
                (sprintf temp_str "String(11,20) \"%s\"\n" _dbr_author)
                (insert temp_str)
                (insert "Text(12,1) \"            Copyright:\"\n")
                (sprintf temp_str "String(12,20) \"%s\"\n" _dbr_copyright)
                (insert temp_str)
                (insert "Text(13,1) \" Memvar lead char:\"\n")
                (sprintf temp_str "String(13,20) \"%s\"\n" _dbr_mem_lead)
                (insert temp_str)
                (insert "Text(14,1) \"Memvar trail char:\"\n")
                (sprintf temp_str "String(14,20) \"%s\"\n" _dbr_mem_trail)
                (insert temp_str)
                (_process_dialog_box 8 17 72 2 "dBRIEF Setup" " - -     F10 to save" NULL box_buffer "_action")
                (set_buffer dbr_current_buffer)
                (attach_buffer dbr_current_buffer)
                (delete_buffer dbr_current_window)
                (delete_buffer box_buffer)
                (call_registered_macro 6)
                (call_registered_macro 1)
            )
        ;else
            (_display_popup_message "Setup unavailable during object edit!" "" 1)
        )
    )
)
(macro _action
    (
        (int        event_type
                    line_no
                    macro_buffer
        )
        (string  button_text
                    _dbrief_dir
        )
        (get_parm 0 event_type)
        (switch event_type
            -8
                (
                    (get_parm 1 line_no)
                    (get_parm 2 button_text)
                    (switch line_no
                        1
                            (switch button_text
                                "On"
                                    (= dbr_auto_indent 1)
                                "Off"
                                    (= dbr_auto_indent 0)
                            )
                        2
                            (switch button_text
                                "On"
                                    (= dbr_auto_header 1)
                                "Off"
                                    (= dbr_auto_header 0)
                            )
                        3
                            (switch button_text
                                "On"
                                    (= dbr_set_ext 1)
                                "Off"
                                    (= dbr_set_ext 0)
                            )
                        4
                            (switch button_text
                                "On"
                                    (= dbr_template 1)
                                "Off"
                                    (= dbr_template 0)
                            )
                        6
                            (switch button_text
                                "Normal"
                                    (= dbr_graphics 1)
                                "Double"
                                    (= dbr_graphics 2)
                                "Combination"
                                    (= dbr_graphics 3)
                                "Special"
                                    (= dbr_graphics 4)
                                NULL
                                    (= dbr_graphics 1)
                            )
                        9
                            (switch button_text
                                "On"
                                    (= dbr_comment_lines 1)
                                "Off"
                                    (= dbr_comment_lines 0)
                            )
                        10
                            (switch button_text
                                "On"
                                    (= dbr_proc_indent 1)
                                "Off"
                                    (= dbr_proc_indent 0)
                            )
                    )
                )
            -7
                (
                    (get_parm 1 line_no)
                    (get_parm 2 button_text)
                    (switch line_no
                        5
                            (switch (upper button_text)
                                "CLIPPER"
                                    (_switch_dialect dbr_dialect 1 0)
                                "FORCE"
                                    (_switch_dialect dbr_dialect 2 0)
                                "DBASE3"
                                    (_switch_dialect dbr_dialect 3 0)
                                "DBASE"    NULL
                                "DBASE4"
                                    (_switch_dialect dbr_dialect 4 0)
                                "FOXBASE"
                                    (_switch_dialect dbr_dialect 5 0)
                                "FOX"        NULL
                                "FOXPRO"
                                    (_switch_dialect dbr_dialect 6 0)
                                "VULCAN"
                                    (_switch_dialect dbr_dialect 7 0)
                                "QUICKSILVER"    NULL
                                "DBXL"
                                    (_switch_dialect dbr_dialect 8 0)
                                "PARADOX"
                                    (_switch_dialect dbr_dialect 9 0)
                                "RBASE"
                                    (_switch_dialect dbr_dialect 10 0)
                                "SQL"
                                    (_switch_dialect dbr_dialect 11 0)
                                "CLIPPER5"
                                    (_switch_dialect dbr_dialect 12 0)
                            )
                        7
                            (= dbr_comment_tab (atoi button_text))
                        8
                            (= dbr_library button_text)
                        11
                            (_change_header "dbr_author              " button_text 7)
                        12
                            (_change_header "dbr_copyright          " button_text 8)
                        13
                            (_change_header "dbr_mem_lead              " (trim button_text) 9)
                        14
                            (_change_header "dbr_mem_trail          " (trim button_text) 10)
                    )
                )
            -11
                (
                    (message "Reconfiguring macro's, please wait...")
                    (= _dbrief_dir (search_path (inq_environment "BPATH") "dbrief.m"))
                    (= macro_buffer (create_buffer "dbrief.m" _dbrief_dir 1))
                    (set_buffer macro_buffer)
                    (if (search_fwd ";*** Default Settings" 0)
                        (
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_auto_indent %d)             ;*** auto indent ON=1, OFF=0" dbr_auto_indent)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_auto_header %d)             ;*** auto header ON=1, OFF=0" dbr_auto_header)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_set_ext %d)                 ;*** auto default extension ON=1, OFF=0" dbr_set_ext)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_template %d)                 ;*** template editing ON=1, OFF=0" dbr_template)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_dialect %02d)                 ;*** dialect code" dbr_dialect)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_graphics %d)                 ;*** graphics mode 1-Normal, 2-Double, 3-Special, 4-Combination" dbr_graphics)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_comment_tab %d)            ;*** comment tab column" dbr_comment_tab)
                            (move_rel 1 0)
                            (beginning_of_line)
                            (delete_to_eol)
                            (sprintf temp_str "         (= dbr_library \"%s\")  ;*** sourceview library" dbr_library)
                            (insert temp_str)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_comment_lines %d)         ;*** conditional comment line numbers 1=ON, 0=OFF" dbr_comment_lines)
                            (move_rel 1 0)
                            (_replace_source "        (= dbr_proc_indent %d)             ;*** procedure/function indenting ON=1, OFF=0" dbr_proc_indent)
                        )
                    )
                    (if (|| (inq_modified macro_buffer) (inq_modified dbr_current_window))
                        (
                            (if (inq_modified dbr_current_window)
                                (
                                    (set_buffer dbr_current_window)
                                    (write_buffer)
                                    (_setup_compile (search_path (inq_environment "BPATH") "generate.m"))
                                    (_setup_compile (search_path (inq_environment "BPATH") "setcmds.m"))
                                    (_setup_compile (search_path (inq_environment "BPATH") "header.m"))
                                    (_setup_compile (search_path (inq_environment "BPATH") "display.m"))
                                )
                            )
                            (if (inq_modified macro_buffer)
                                (
                                    (set_buffer macro_buffer)
                                    (write_buffer)
                                )
                            )
                            (_setup_compile (search_path (inq_environment "BPATH") "dbrief.m"))
                        )
                    )
                    (set_buffer dbr_current_buffer)
                    (delete_buffer macro_buffer)
                )
        )
        (return 1)
    )
)
(macro _setup_compile
    (
        (string            _dbrief_macro
        )
        (get_parm 0 _dbrief_macro)
        (message "Compiling %s." (upper _dbrief_macro))
        (= _dbrief_macro (substr _dbrief_macro 1 (- (index (upper _dbrief_macro) ".M") 1)))
        (sprintf temp_str "cm %s >&NUL" _dbrief_macro)
        (dos temp_str)
    )
)
(macro _replace_source
    (
        (int                replace_source_int
        )
        (string            replace_source_str
                            replace_temp_str
        )
        (get_parm 0 replace_source_str)
        (get_parm 1 replace_source_int)
        (beginning_of_line)
        (delete_to_eol)
        (sprintf replace_temp_str replace_source_str replace_source_int)
        (insert replace_temp_str)
    )
)
(macro _change_header
    (
        (string            parm1_
                            parm2_
                            _change_str
        )
        (int                parm3_
                            _change_buffer
        )
        (get_parm 0 parm1_)
        (get_parm 1 parm2_)
        (get_parm 2 parm3_)
        (= _change_buffer (inq_buffer))
        (set_buffer dbr_current_window)
        (move_abs parm3_ 1)
        (delete_to_eol)
        (sprintf _change_str "#define  %s    \"%s\"" parm1_ parm2_)
        (insert _change_str)
        (set_buffer _change_buffer)
    )
)
(macro set
    (
        (int                set_command_int
        )
        (string            set_command_str
                            set_temp_str
        )
        (if (get_parm 0 set_command_str)
            (switch (upper (substr set_command_str 1 4))
                "FUNC"    NULL
                "PROC"
                    (if (get_parm 2 set_command_str "Procedure/function indenting [on/off]: ")
                        (= dbr_proc_indent (_set_command_toggle "Procedure/function indenting is %s." set_command_str NULL NULL 1))
                    )
                "COND"
                    (if (get_parm 2 set_command_str "Conditional line #'s [on/off]: ")
                        (= dbr_proc_indent (_set_command_toggle "Conditional line numbers are %s." set_command_str NULL NULL 1))
                    )
                "DRAW"
                    (if (get_parm 1 set_command_str "Graphics draw mode [on/off]: ")
                        (if (== (upper set_command_str) "ON")
                            (
                                (_cursor)
                                (_control_key)
                            )
                        ;else
                            (_set_command_toggle "Graphics draw mode is %s." set_command_str "draw" "nodr" 0)
                        )
                    )
                "HEAD"
                    (if (get_parm 1 set_command_str "Auto header [on/off]: ")
                        (= dbr_auto_header (_set_command_toggle "Auto header is %s." set_command_str NULL NULL 1))
                    )
                "EXTE"
                    (if (get_parm 1 set_command_str "Default extension [on/off]: ")
                        (
                            (sprintf set_temp_str "Default extension of %s is " (_get_dialect_info dbr_dialect 3))
                            (= dbr_set_ext (_set_command_toggle (+ set_temp_str "%s.") set_command_str NULL NULL 1))
                        )
                    )
                "TEMP"
                    (if (get_parm 1 set_command_str "Template editing [on/off]: ")
                        (= dbr_template (_set_command_toggle "Template editing is %s." set_command_str NULL NULL 1))
                    )
                "INDE"
                    (if (== (upper (get_parm 1 set_command_str)) "TO")
                        (if (get_parm 2 set_command_int "Indent level: ")
                            (
                                (= dbr_indent_level set_command_int)
                                (if (> dbr_indent_level 0)
                                    (tabs (+ dbr_indent_level 1) (+ (* dbr_indent_level 2) 1))
                                )
                                (sprintf set_command_str "%d" dbr_indent_level)
                                (_display_popup_message "Indent level is %s." set_command_str 0)
                            )
                        )
                    ;else
                        (if (get_parm 1 set_command_str "Auto indent [on/off]: ")
                            (= dbr_auto_indent (_set_command_toggle "Auto indenting is %s." set_command_str NULL NULL 1))
                        )
                    )
                "COMM"
                    (if (get_parm 2 set_command_int "Comment tab: ")
                        (
                            (if (>= set_command_int 0)
                                (= dbr_comment_tab set_command_int)
                            )
                            (sprintf set_command_str "%d" dbr_comment_tab)
                            (_display_popup_message "Comment tab is %s." set_command_str 0)
                        )
                    )
                "LIBR"
                    (if (get_parm 2 set_command_str "Library [default=SRC]: ")
                        (
                            (if (index set_command_str ".")
                                (= set_command_str (+  (substr (upper set_command_str) 1 (index set_command_str ".")) "SRC"))
                            ;else
                                (= set_command_str (+ (upper set_command_str) ".SRC"))
                            )
                            (if (exist set_command_str)
                                (
                                    (= dbr_library set_command_str)
                                    (= dbr_current_buffer (inq_buffer))
                                    (= library_buffer (create_buffer "Library" dbr_library 1))
                                    (set_buffer library_buffer)
                                    (set_buffer dbr_current_buffer)
                                    (_display_popup_message "Library set to %s." dbr_library 0)
                                )
                            ;else
                                (_display_popup_message "Library %s not found!" set_command_str 1)
                            )
                        )
                    )
                "GRAP"
                    (if (get_parm 2 set_command_str "Graphics mode [norm/doub/spec/comb]: ")
                        (
                            (= temp_int dbr_graphics)
                            (switch (substr (upper set_command_str) 1 4)
                                "NORM"
                                    (= dbr_graphics 1)
                                "DOUB"
                                    (= dbr_graphics 2)
                                "COMB"
                                    (= dbr_graphics 3)
                                "SPEC"
                                    (= dbr_graphics 4)
                                NULL
                                    (= dbr_graphics 0)
                            )
                            (if (! (_display_graphics_mode dbr_graphics))
                                (
                                    (_display_popup_message "Invalid argument - %s!" (upper set_command_str) 1)
                                    (= dbr_graphics temp_int)
                                )
                            )
                        )
                    )
                "DIAL"
                    (if (get_parm 2 set_command_str "Dialect: ")
                        (
                            (message "Please wait...")
                            (switch (upper set_command_str)
                                "CLIPPER"
                                    (_switch_dialect dbr_dialect 1 1)
                                "FORCE"
                                    (_switch_dialect dbr_dialect 2 1)
                                "DBASE3"
                                    (_switch_dialect dbr_dialect 3 1)
                                "DBASE"    NULL
                                "DBASE4"
                                    (_switch_dialect dbr_dialect 4 1)
                                "FOXBASE"
                                    (_switch_dialect dbr_dialect 5 1)
                                "FOX"        NULL
                                "FOXPRO"
                                    (_switch_dialect dbr_dialect 6 1)
                                "VULCAN"
                                    (_switch_dialect dbr_dialect 7 1)
                                "QUICKSILVER"    NULL
                                "DBXL"
                                    (_switch_dialect dbr_dialect 8 1)
                                "PARADOX"
                                    (_switch_dialect dbr_dialect 9 1)
                                "RBASE"
                                    (_switch_dialect dbr_dialect 10 1)
                                "SQL"
                                    (_switch_dialect dbr_dialect 11 1)
                                "CLIPPER5"
                                    (_switch_dialect dbr_dialect 12 1)
                                NULL
                                    (_display_popup_message "Dialect %s is not a supported language!" (upper set_command_str) 1)
                            )
                        )
                    )
            )
        ;else
            (if (== (inq_assignment "_implode_object_window" 1) "")
                (_status)
            ;else
                (_display_popup_message "Setup unavailable during object edit!" "" 1)
            )
        )
    )
)
(macro _set_command_toggle
    (
        (int                _set_command_dis
        )
        (string            _set_command_str
                            _set_command_msg
                            _set_command_ex0
                            _set_command_ex1
        )
        (get_parm 0 _set_command_msg)
        (get_parm 1 _set_command_str)
        (get_parm 3 _set_command_ex1)
        (get_parm 4 _set_command_dis)
        (= _set_command_str (upper _set_command_str))
        (if (index "ON~OFF~" _set_command_str)
            (if _set_command_dis
                (_display_popup_message _set_command_msg _set_command_str 0)
            )
        ;else
            (_display_popup_message "Invalid argument - %s!" _set_command_str 1)
        )
        (if (&& (== _set_command_str "ON") (get_parm 2 _set_command_ex0))
            (execute_macro _set_command_ex0)
        )
        (if (&& (== _set_command_str "OFF") (get_parm 3 _set_command_ex1))
            (execute_macro _set_command_ex1)
        )
        (if (== _set_command_str "ON")
            (returns 1)
        ;else
            (returns 0)
        )
    )
)
(macro _switch_dialect
    (
        (int            current_dialect
                        new_dialect
                        display_message
        )
        (get_parm 0 current_dialect)
        (get_parm 1 new_dialect)
        (get_parm 2 display_message)
        (if (!= current_dialect new_dialect)
            (
                (set_msg_level 3)
                (delete_macro (search_path (inq_environment "BPATH") (+ (lower (_get_dialect_info new_dialect 2)) ".CM")))
                (if (> (load_macro (lower (_get_dialect_info new_dialect 2))) 0)
                    (
                        (= dbr_dialect new_dialect)
                        (if display_message
                            (_display_popup_message "Dialect is %s." (_get_dialect_info dbr_dialect 1) 0)
                        )
                    )
                ;else
                    (
                        (load_macro (lower (_get_dialect_info dbr_dialect 2)))
                        (if display_message
                            (_display_popup_message "Unable to load %s support, previous dialect reinstated!" (_get_dialect_info new_dialect 1) 1)
                        )
                    )
                )
                (set_msg_level 0)
            )
        ;else
            (if display_message
                (_display_popup_message "Dialect already is %s." (_get_dialect_info dbr_dialect 1) 1)
            )
        )
    )
)