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

Text File | 1991-03-21 | 7.9 KB | 308 lines

;dBRIEF Dialect (dbXL/Quicksilver Support) - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
#include "common.h"
(macro _dialect_table
    (
        (returns "DO W ENDD IF ELSE ENDI PROC FUNC RETU DO CASE OTHE ENDC TEXT FOR NEXT ")
    )
)
(macro _indenting_conditionals
    (
        (return "FOR  IF     DO W DO C ")
    )
)
(macro _reseting_conditionals
    (
        (return "ELSE ")
    )
)
(macro _outdenting_conditionals
    (
        (return "NEXT ENDD ENDC ENDI ")
    )
)
(macro _backdenting_conditionals
    (
        (returns "ENDI ELSE ENDD ENDC OTHE CASE NEXT ")
    )
)
(macro _matching_conditional
    (
        (string            _match_token
        )
        (get_parm 0 _match_token)
        (switch _match_token
            "IF "
                (return "ENDIF")
            "PROC"
                (return "RETURN")
            "FUNC"
                (return dbr_udf_return)
            "DO W"
                (return "ENDDO")
            "DO C"
                (return "ENDCASE")
            "FOR "
                (return "NEXT")
            NULL
                (return "")
        )
    )
)
(macro _complete_cond_table
    (
        (return "IF~PR~FU~DO~FO~")
    )
)
(macro _adjust_indent_level
    (
        (int                adj_indent_column
                            adj_previous_line
        )
        (string            eval_string
        )
        (get_parm 0 eval_string)
        (get_parm 1 adj_indent_column)
        (switch (substr eval_string 1 4)
            "DO W"
                (+= adj_indent_column dbr_indent_level)
            "RETU"
                (
                    (-= adj_indent_column dbr_indent_level)
                    (= adj_previous_line (* dbr_indent_level -1))
                )
            "DO C"
                (+= adj_indent_column (* dbr_indent_level dbr_indent_case))
            "OTHE"
                (= adj_previous_line (* dbr_indent_level -1))
            "ENDC"
                (
                    (-= adj_indent_column (* dbr_indent_level dbr_indent_case))
                    (= adj_previous_line (* dbr_indent_level (* dbr_indent_case -1)))
                )
        )
        (move_abs 0 adj_indent_column)
        (return adj_previous_line)
    )
)
;dbXL/Quicksilver Reindenting Macros
(macro _indent_shift
    (
        (string            token
                            orig_line
        )
        (int                dbr_insert_col
        )
        (get_parm 0 token)
        (get_parm 1 orig_line)
        (get_parm 2 dbr_insert_col)
        (switch token
            "DO"
                (
                    (if (search_string "DO[ \t]+WHIL" orig_line NULL 1 0)
                        (+= curr_indent_col dbr_indent_level)
                    )
                    (if (search_string "DO[ \t]+CASE" orig_line NULL 1 0)
                        (+= curr_indent_col (* dbr_indent_level dbr_indent_case))
                    )
                )
            "PROC"    NULL
            "FUNC"
                (if dbr_proc_indent
                    (
                        (= dbr_return_flag 1)
                        (+= curr_indent_col dbr_indent_level)
                    )
                ;else
                    (= dbr_return_flag 0)
                )
            "FOR"        NULL
            "IF"
                (+= curr_indent_col dbr_indent_level)
            "ENDC"
                (= dbr_insert_col (-= curr_indent_col (* dbr_indent_level dbr_indent_case)))
            "NEXT"    NULL
            "ENDI"    NULL
            "ENDD"
                (= dbr_insert_col (-= curr_indent_col dbr_indent_level))
            "RETU"
                (if (&& (== dbr_return_flag 1)(== (substr (upper orig_line) 1 6) "RETURN"))
                    (
                        (= dbr_return_flag 0)
                        (= dbr_insert_col (-= curr_indent_col dbr_indent_level))
                    )
                )
            "CASE" NULL
            "ELSE" NULL
            "OTHE"
                (-= dbr_insert_col dbr_indent_level)
            "TEXT"
                (if (== (inq_called) "rein")
                    (_find_matching_endtext)
                )
        )
        (returns dbr_insert_col)
    )
)
;dbXL/Quicksilver Template Abbreviations
(macro _command_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~APP APPEND ~ASS ASSIST ~AVE AVERAGE ~BRO BROWSE ~CCA CCALL ~CHA CHANGE ~CLE CLEAR ~CLA CLEAR AUTOMEM ~COU COUNT ~CRL CREATE ~CRE CREATE LABEL ~CRR CREATE REPORT ~")
            2
                (return "~DEC DECLARE ~DIM DIMENSION ~DIS DISPLAY ~DSM DISPLAY MEMORY ~DSS DISPLAY STATUS ~DST DISPLAY STRUCTURE ~DOC DO CASE~DOS DOSINT ~DOW DO WHILE .T.~~DNS DOWNSCROLL ")
            3
                (return "~EDI EDIT ~ENC ENDCASE~EXP EXPORT ~FOR FOR...NEXT ~GRA GRAPH FORM  ~HEL HELP ~IND INDEX  ~INS INSERT ~LIS LIST STATUS ~MOD MODIFY ~ONE ON EVENT ~ONK ON KEY ~")
            4
                (return "~OTH OTHERWISE~OUT OUT ~REL RELEASE ~REP REPLACE ~RES RESTORE GRAPH ~SKI SKIP ~SLE SLEEP ~STO STORE ~SUM SUM ~UPS UP SCROLL ~USE USE ~WAB WABANDON ~WAC WACTIVE  ~")
            5
                (return "~WCL WCLOSE ~WCO WCOPY ~WDI WDISPLAY ~WMO WMOVE ~WRL WRELEASE ~WRS WRESTORE  ~WSA WSAVE ~WSE WSELECT ~WSFR WSET FRAME ~WSSI WSET SIZE ~WSTI WSET TILTLE ~WSWI WSET WINDOW ~")
            6
                (return "~WSWF WSET WINFILE  ~WUS WUSE ~")
            NULL
                (return 6)
        )
    )
)
(macro _function_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~BIT BITSET()~CEI CEIL()~CEN CENTER()~DES DESEND()~DTO DTOS()~EMP EMPTY()~ERR ERROR()~FCO FCOL()~FLO FLOOR()~FRO FROW()~HTO HTOI()~ITO ITOH()~LOG LOG 10()~")
            2
                (return "~MEM MEMORY()~PRI PRINTER()~PRO PROPER()~SEL SELECT()~SIN SINKEY()~SOU SOUNDEX()~WAC WACTIVE()~WSE WSELECT ()")
            NULL
                (return 2)
        )
    )
)
(macro _set_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~SCAR SET CARRY ~SCOL SET COLOR TO ~SCUR SET CURSOR MOVE ~SDBF SET DBF TO ~SDEB SET DEBUG ~SDEV SET DEVICE TO ~SECH SET ECHO ~SEDI SET EDITOR TO ~SEVE SET EVENT TO ~")
            2
                (return "~SFEE SET FEED ~SFUN SET FUNCTION ~SHEA SET HEADING ~SHEL SET HELP ~SIND SET INDEX TO ~SMEN SET MENU ~SNDX SET NDX TO ~SPAT SET PATH TO ~SPRI SET PRINTER TO ~")
            3
                (return "~SREL SET RELATION TO ~SRET SET RETRACE ~SSAF SET SAFETY ~SSTE SET STEP ~STAL SET TALK ~STIM SET TIME TO ~SUSE SET USER HELP TO ~")
            NULL
                (return 3)
        )
    )
)
;dbXL/Quicksilver Commenting Macros
(macro _uncomment_conditionals
    (
        (int                display_messages
        )
        (get_parm 0 display_messages)
        (if display_messages
            (message "Uncommenting conditional statements...")
        )
        (save_position)
        (translate "&& for*>" "" 1 1 0)
        (translate "&& if*>" "" 1 1 0)
        (translate "&& do w*>" "" 1 1 0)
        (translate "&& do c*>" "" 1 1 0)
        (restore_position)
        (if display_messages
            (_display_popup_message "Uncommenting complete." "" 0)
        )
    )
)
;dbXL/Quicksilver Conditional Graphics Macros
(macro _insert_graphics
    (
        (int            dbr_insert_col
                        kk
        )
        (string        orig_line
                        token
                        sql_extension
                        _numbers
                        _graphics
        )
        (get_parm 0 _numbers)
        (get_parm 1 orig_line)
        (get_parm 2 _graphics)
        (= token (substr (upper orig_line) 1 4))
        (if (= dbr_insert_col (search_string "[ \\t]" token NULL 1))
            (= token (substr token 1 (-- dbr_insert_col)))
        )
        (= dbr_insert_col curr_indent_col)
        (if (&& (strlen token) (index (_dialect_table) (+ token " ")))
            (= dbr_insert_col (_indent_shift token orig_line dbr_insert_col))
        )
        (delete_to_eol)
        (beginning_of_line)
        (insert _numbers)
        (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
        (insert orig_line)
        (if (== (upper _graphics) "Y")
            (
                (if (> (strlen token) 0)
                    (
                        (if (index "PROC~FUNC~IF~CASE~OTHE~FOR" token)
                            (
                                (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                                (insert "┌")
                            )
                        )
                        (if (index "DO" token)
                            (
                                (if (|| (search_string "DO[ \t]+WHIL" orig_line NULL 1 0)(search_string "DO[ \t]+CASE" orig_line NULL 1 0))
                                    (
                                        (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                                        (insert "┌")
                                    )
                                )
                            )
                        )
                        (if (index "ELSE" token)
                            (
                                (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                                (insert "├")
                            )
                        )
                        (if (index "ENDI~ENDD~ENDC~NEXT" token)
                            (
                                (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                                (insert "└")
                            )
                        )
                        (if (== (substr (upper orig_line) 1 6) "RETURN")
                            (
                                (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                                (insert "└")
                            )
                        )
                    )
                )
                (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                (= kk (+ (strlen _numbers) dbr_insert_col))
                (while (> kk (+ (strlen _numbers) dbr_indent_level))
                    (
                        (-= kk dbr_indent_level)
                        (move_abs 0 kk)
                        (insert "│")
                    )
                )
            )
        )
        (move_rel 1 0)
        (beginning_of_line)
    )
)