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

Text File | 1991-03-21 | 12.7 KB | 373 lines

;dBRIEF Dialect (FoxPro Support) - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
#include "common.h"
(macro _dialect_table
    (
        (returns "PRIN ENDP FOR ENDF DO W ENDD IF ELSE ENDI FUNC PROC RETU DO CASE OTHE ENDC TEXT SCAN ENDS ")
    )
)
(macro _indenting_conditionals
    (
        (return "SCAN PRIN IF    DO W DO C FOR  ")
    )
)
(macro _reseting_conditionals
    (
        (return "ELSE ")
    )
)
(macro _outdenting_conditionals
    (
        (return "ENDS ENDP ENDF ENDD ENDC ENDI ")
    )
)
(macro _backdenting_conditionals
    (
        (returns "ENDP ENDF ENDD ELSE ENDI CASE OTHE ENDC ENDS ")
    )
)
(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")
            "SCAN"
                (return "ENDSCAN")
            "FOR "
                (return "ENDFOR")
            "PRIN"
                (return "ENDPRINTJOB")
            NULL
                (return "")
        )
    )
)
(macro _complete_cond_table
    (
        (return "IF~PR~FU~DO~SC~FO~PR~")
    )
)
(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)
            "PRIN"    NULL
            "SCAN"    NULL
            "DO W"
                (+= adj_indent_column dbr_indent_level)
            "ENDP"    NULL
            "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)
    )
)
;FoxPro 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))
                    )
                )
            "FUNC" NULL
            "PROC"
                (if dbr_proc_indent
                    (
                        (= dbr_return_flag 1)
                        (+= curr_indent_col dbr_indent_level)
                    )
                ;else
                    (= dbr_return_flag 0)
                )
            "PRIN"    NULL
            "FOR"        NULL
            "SCAN"    NULL
            "IF"
                (+= curr_indent_col dbr_indent_level)
            "ENDC"
                (= dbr_insert_col (-= curr_indent_col (* dbr_indent_level dbr_indent_case)))
            "ENDI"    NULL
            "ENDD"    NULL
            "ENDP"    NULL
            "ENDS"    NULL
            "ENDF"
                (= 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)
    )
)
;FoxPro Template Abbreviations
(macro _command_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~ACM ACTIVATE MENU ~ACP ACTIVATE POPUP ~ACS ACTIVATE SCREEN ~ACW ACTIVATE WINDOW ~AFA APPEND FROM ARRAY ~APF APPEND FROM ~APM APPEND MEMO ~APB APPEND BLANK ~")
            2
                (return "~CAL CALCULATE ~CLA CLEAR ALL ~CLF CLEAR FIELDS ~CLG CLEAR GETS ~CLM CLEAR MEMORY ~CLP CLEAR PROGRAM ~CLT CLEAR TYPEAHEAD ~CLW CLEAR WINDOWS ~CLD CLOSE DATABASE ~")
            3
                (return "~CLI CLOSE INDEX ~COF COPY FILE ~COM COPY MEMO ~COS COPY STRUCTURE ~COT COPY TO ~CTA COPY TO ARRAY ~CRL CREATE LABEL ~CRR CREATE REPORT ~CRV CREATE VIEW ~")
            4
                (return "~DAM DEACTIVATE MENU ~DEP DEACTIVATE POPUP ~DEW DEACTIVATE WINDOW ~DEB DEFINE BAR ~DEL DELETE ~DEM DEFINE MENU ~DBX DEFINE BOX FROM ~DEF DELETE FILE ~")
            5
                (return "~DIR DIRECTORY ~DIF DISPLAY FILES ~DIM DISPLAY MEMORY ~DIS DISPLAY STATUS TO ~DOC DO CASE~DOW DO WHILE .T. ~ENC ENDCASE~EJP EJECT PAGE ~ENP ENDPRINTJOB~")
            6
                (return "~GAT GATHER FROM MEMVER ~HIM HIDE MENU ~HIP HIDE POPUP ~HIW HIDE WINDOW ~LBL LABEL FORM ~LIF LIST FILES ~LIM LIST MEMORY ~LIS LIST STATUS ~LOF LOCATE FOR ~")
            7
                (return "~MOC MODIFY COMMAND ~MOL MODIFY LABEL ~MOM MODIFY MEMO ~MOR MODIFY REPORT ~MVW MOVE WINDOW ~ONE ON ERROR ~ONS ON ESCAPE ~ONR ON READERROR ~OTH OTHERWISE~")
            8
                (return "~OPA ON SELECTION PAD ~OPO ON SELECTION POPUP ~PAR PARAMETERS ~PRA PRIVATE ALL ~PRJ PRINTJOB~REC RECALL ~REL RELEASE ~RET RETURN ~REP REPLACE ~RFM REPORT FORM ~")
            9
                (return "~RIN REINDEX ~RFR RESTORE FROM ~RSM RESTORE MACROS FROM ~RSC RESTORE SCREEN ~RWI RESTORE WINDOW ~SVM SAVE MACROS TO ~SSC SAVE SCREEN ~SVT SAVE TO ~")
            10
                (return "~SVW SAVE WINDOW ~SCA SCATTER ~SHM SHOW MENU ~SHP SHOW POPUP ~SHW SHOW WINDOW ~SUS SUSPEND ~TTL TOTAL TO ~UPD UPDATE ON ~")
            NULL
                (return 10)
        )
    )
)
(macro _function_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~ABS ABS(expN)~ACO ACOS(expN)~ALI ALIAS(expN)~ALT ALLTRIM(expC)~ASC ASC(expC)~ASI ASIN(expN)~ATA ATAN(expN)~ATC ATC(expC1,expC2,expN)~ACL ATCLINE(expC1,expC2)~")
            2
                (return "~ATL ATLINE(expC1,expC2)~ATN ATN2(expN1,expN2)~BAR BAR()~BET BETWEEN(expr1,expr2,expr3)~BOF BOF(alias)~CAP CAPSLOCK(expL)~CDO CDOW(expD)~CEI CEILING(expN)~")
            3
                (return "~CHR CHR(expN)~CHS CHRSAW(expN)~CHT CHRTRAN(expC1,expC2,expC3)~CMO CMONTH(expD)~COL COL()~COS COS(expN)~CTO CTOD(expC)~CUR CURDIR(expC)~DAT DATE()~DAY DAY(expD)~")
            4
                (return "~DBF DBF(alias)~DEL DELETED(alias)~DIF DIFFERENCE(expC1,expC2)~DIS DISKSPACE()~DMY DMY(expD)~DOW DOW(expD)~DTC DTOC(expD)~DTR DTOR(expN)~DTS DTOS(expD)~EMP EMPTY(expr)~")
            5
                (return "~FCL FCLOSE(expN)~FCO FCOUNT(alias)~FCR FCREATE(expC,expN)~FEO FOEF(expN)~FER FERROR()~FFL FFLUSH(expN)~FGE FGETS(expN1,expN2)~FIE FIELD(expN1,alias)~FIL FILE(expC)~")
            6
                (return "~FLT FILTER(alias)~FKL FKLABEL(expN)~FLO FLOOR(expN)~FOP FOPEN(expC,expN)~FOU FOUND(alias)~FPU FPUTS(expN1,expC,expN2)~FRE FREAD(expN1,expN2)~")
            7
                (return "~FSE FSEEK(expN1,expN2,expN3)~FSI FSIZE(fields,alias)~FUL FULLPATH(file,1)~FWR FWRITE(expN1,expC,expN2)~GEN GETENV(expC)~GEF GETFILE(expC1,expC2)~GOM GOMONTH(expD,expN)~")
            8
                (return "~HEA HEADER(alias)~IIF IIF(expL,expr1,expr2)~INK INKEY(expN,expC)~INL INLIST(expr1,expr2,expr3)~INS INSMODE(expL)~INT INT(expN)~ISA ISALPHA(expC)~ISC ISCOLOR()~")
            9
                (return "~ISD ISDIGIT(expC)~ISL ISLOWER(expC)~ISU ISUPPER(expC)~KEY KEY(expN,alias)~LAS LASTKEY()~LEF LEFT(expC,expN)~LEN LEN(expC)~LIK LIKE(expC1,expC2)~LIN LINENO()~")
            10
                (return "~LOG LOG(expN)~LOG LOG10(expN)~LOW LOWER(expC)~LTR LTRIM(expC)~LUP LUPDATE(alias)~MAX MAX(expr1,expr2,expr3)~MCO MCOL(expC)~MDO MDOWN()~MDY MDY(expD)~")
            11
                (return "~MML MEMLINES(memofields)~MEM MEMORY()~MEN MENU()~MES MESSAGE(1)~MIN MIN(expr1,expr2,expr3)~MLI MLINE(memoield,expN)~MOD MOD(expN1,expN2)~MON MONTH(expD)~")
            12
                (return "~MRO MROW(expC)~NDX NDX(expN,alias)~NUM NUMLOCK(expL)~OCC OCCURS(expC1,expC2)~ORD ORDER(alias)~PAD PAD()~PDC PADC(expr,expN,expC)~PDL PADL(expr,expN,expC)~")
            13
                (return "~PDR PADR(expr,expN,expC)~PRM PARAMETERS()~PAY PAYMENT(expN1,expN2,expN3)~PCO PCOL()~POP POPUP()~PRI PRINTSTATUS()~PRG PROGRAM(expN)~PRM PROMPT()~PRP PROPER(expC)~")
            14
                (return "~PRW PROW()~PUT PUTFILE(expC1,expC2,expC3)~RAN RAND(expN)~RAT RAT(expC1,expC2,expN)~RTL RATLINE(expC1,expC2)~REA READKEY()~RCO RECOUNT(alias)~RNO RECNO(alias)~")
            15
                (return "~RSI RECSIZE(alias)~REL RELATION(expN,alias)~REP REPLICATE(expC,expN)~RIG RIGHT(expC,expN)~ROU ROUND(expN1,expN2)~ROW ROW()~RTO RTOD(expN)~RTR RTRIM(expC)~")
            16
                (return "~SCH SCHEME(expN1,expN2)~SCO SCOLS()~SEC SECONDS()~SEE SEEK(expr,alias)~SEL SELECT()~STT SET(expC,1)~SIG SIGN(expN)~SIN SIN(expN)~SOU SOUNDEX(expC)~SPA SPACE(expN)~")
            17
                (return "~SQR SQRT(expN)~SRO SROWS()~STR STR(expN1,expN2,expN3)~STT STRTRAN(expC1,expC2,expC3,expN1,expN2)~STU STUFF(expC1,expN1,expN2,expC2)~SUB SUBSTR(expC,expN1,expN2)~")
            18
                (return "~TAN TAN(expN)~TAR TARGET(expN,expr)~TIM TIME(expN)~TRA TRANSFORM(expr,expC)~TRI TRIM(expC)~TYP TYPE(expC)~UPD UPDATED()~UPP UPPER(expC)~USD USED(alias)~")
            19
                (return "~VAL VAL(expC)~VAR VARREAD()~VER VERSION()~WCO WCOLS(expC)~WEX WEXIST(expC)~WLC WLCOL(expC)~WLR WLROW(expC)~WON WONTOP(expC)~WOU WOUTPUT(expC)~WRO WROWS(expC)~")
            20
                (return "~WVI WVISIBLE(expC)~YEA YEAR(expD)~")
            NULL
                (return 20)
        )
    )
)
(macro _set_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~SALT SET ALTERNATE ~SBEL SET BELL ~SBLO SET BLOCKSIZE ~SBOR SET BORDER TO ~SCAR SET CARRY ~SCEN SET CENTURY ~SCOL SET COLOR TO ~SCUR SET CURRENCY TO ~")
            2
                (return "~SCON SET CONSOLE ~SDEB SET DEBUG ~SDEC SET DECIMALS TO ~SDEF SET DEFAULT TO ~SDEL SET DELETED ~SDEV SET DEVICE TO ~SDIS SET DISPLAY TO ~SDOH SET DOHISTORY ~")
            3
                (return "~SESC SET ESCAPE ~SENC SET ENCRYPTION ~SEXC SET EXCLUSIVE ~SEXA SET EXACT ~SFIE SET FIELDS TO ~SFIL SET FILTER TO ~SFOR SET FORMAT TO ~SFUL SET FULLPATH ~")
            4
                (return "~SFUN SET FUNCTION ~SHEA SET HEADING ~SHIS SET HISTORY ~SHOU SET HOURS TO ~SIND SET INDEX TO ~SINT SET INTENSITY ~SLOG SET LOGERRORS ~SMAR SET MARGIN TO ~")
            5
                (return "~SMEM SET MEMOWIDTH TO ~SMES SET MESSAGE TO ~SNEA SET NEAR ~SODO SET ODOMETER TO ~SORD SET ORDER TO ~SPAT SET PATH TO ~SPOI SET POINT TO ~SPRI SET PRINTER ~")
            6
                (return "~SPRN SET PRINTER TO ~SPRO SET PROCEDURE TO ~SREL SET RELATION TO ~SRES SET RESOURCE ~SSAF SET SAFETY ~SSCO SET SCOREBOARD ~SSEP SET SEPARATOR ~SSHA SET SHADOWS ~")
            7
                (return "~SSPA SET SPACE ~SSTA SET STATUS ~SSTI SET STICKY ~STYP SET TYPEAHEAD TO ~SUNI SET UNIQUE ~SVIE SET VIEW TO ~SWIN SET WINDOW OF MEMO TO ~")
            NULL
                (return 7)
        )
    )
)
;FoxPro Commenting Macros
(macro _uncomment_conditionals
    (
        (int                display_messages
        )
        (get_parm 0 display_messages)
        (if display_messages
            (message "Uncommenting conditional statements...")
        )
        (save_position)
        (translate "&& scan*>" "" 1 1 0)
        (translate "&& if*>" "" 1 1 0)
        (translate "&& do w*>" "" 1 1 0)
        (translate "&& do c*>" "" 1 1 0)
        (translate "&& for*>" "" 1 1 0)
        (translate "&& prin*>" "" 1 1 0)
        (restore_position)
        (if display_messages
            (_display_popup_message "Uncommenting complete." "" 0)
        )
    )
)
;FoxPro 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~RETU~IF~CASE~OTHE~FOR~PRIN~SCAN" 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~ENDF~ENDP~ENDS" 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)
    )
)