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

Text File | 1991-03-21 | 11.5 KB | 368 lines

;dBRIEF Dialect (Clipper Support) - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
#include "common.h"
(macro _dialect_table
    (
        (return "FOR NEXT WHIL DO W ENDD BEGI END IF ELSE ENDI LOCA STAT FUNC PROC RETU DO CASE OTHE ENDC TEXT ")
    )
)
(macro _indenting_conditionals
    (
        (return "BEGI IF   WHIL DO W DO C FOR  ")
    )
)
(macro _reseting_conditionals
    (
        (return "ELSE ")
    )
)
(macro _outdenting_conditionals
    (
        (return "NEXT END ENDI ENDD ENDC ")
    )
)
(macro _backdenting_conditionals
    (
        (return "NEXT END ENDI ELSE ENDD CASE ENDC OTHE ")
    )
)
(macro _matching_conditional
    (
        (string            _match_token
        )
        (get_parm 0 _match_token)
        (switch _match_token
            "FOR "
                (return "NEXT")
            "IF "
                (return "ENDIF")
            "PROC"
                (return "RETURN")
            "FUNC"
                (return dbr_udf_return)
            "BEGI"
                (return "END")
            "WHIL"
                (return "ENDDO")
            "DO W"
                (return "ENDDO")
            "DO C"
                (return "ENDCASE")
            NULL
                (return "")
        )
    )
)
(macro _complete_cond_table
    (
        (return "FO~IF~ST~LO~PR~FU~DO~BE~WH~")
    )
)
(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)
            "BEGI"    NULL
            "WHIL"    NULL
            "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)
    )
)
;Clipper 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))
                    )
                )
            "LOCA"    NULL
            "STAT"    NULL
            "FUNC"    NULL
            "PROC"
                (if (&& dbr_proc_indent (|| (index (upper orig_line) "FUNC")(index (upper orig_line) "PROC")))
                    (
                        (= dbr_return_flag 1)
                        (+= curr_indent_col dbr_indent_level)
                    )
                ;else
                    (if (&& (== dbr_return_flag 1) (|| (== token "LOCA") (== token "STAT")))
                        (= dbr_return_flag 1)
                    ;else
                        (= dbr_return_flag 0)
                    )
                )
            "FOR"        NULL
            "WHIL"    NULL
            "BEGI"    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"    NULL
            "END"
                (= 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
            "OTHE"    NULL
            "ELSE"
                (-= dbr_insert_col dbr_indent_level)
            "TEXT"
                (if (== (inq_called) "rein")
                    (_find_matching_endtext)
                )
        )
        (returns dbr_insert_col)
    )
)
;Clipper Template Abbreviations
(macro _command_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~APF APPEND FROM ~APB APPEND BLANK~BEG BEGIN SEQUENCE~CLA CLEAR ALL~CLG CLEAR GETS~CLM CLEAR MEMORY~CLT CLEAR TYPEAHEAD~CLD CLOSE DATABASE~CLI CLOSE INDEX~")
            2
                (return "~COF COPY FILE ~COT COPY TO ~COS COPY STRUCTURE ~")
            3
                (return "~CSE COPY STRUCTURE EXTENDED TO ~DEC DECLARE ~DEF DELETE FILE ~DEL DELETE ~DOC DO CASE~DOW DO WHILE .T.~ENC ENDCASE~EXT EXTERNAL ~IND INDEX ON ~KEY KEYBOARD ~")
            4
                (return "~LBL LABEL FORM ~LOC~LOCAL ~LOF LOCATE FOR ~MEN MENU TO ~")
            5
                (return "~OTH OTHERWISE~PAR PARAMETERS ~PRI PRIVATE ~REC RECALL ~REL RELEASE ~REP REPLACE ~RET RETURN~RFM REPORT FORM ~RIN REINDEX~RFR RESTORE FROM ~RSC RESTORE SCREEN~")
            6
                (return "~SSC SAVE SCREEN~SVT SAVE TO ~STA~STATIC ~")
            7
                (return "~TTL TOTAL ON ~UNL UNLOCK~UPD UPDATE ON ~ATO @ ^UX,^UY TO ^LX,^LY ~BOX @ ^UX,^UY,^LX,^LY BOX expC ~")
            NULL
                (return 7)
        )
    )
)
(macro _function_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~ABS ABS(expN)~ACH ACHOICE(^UX,^UY,^LX,^LY,array1)~ACO ACOPY(array1,array2,expN1,expN2,expN3)~ADE ADEL(array,expN)~")
            2
                (return "~ADI ADIR(directory skeleton,array1,array2,array3,array4,array5))~AFI AFIELDS(array1,array2,array3,array4)~AFL AFILL(array,exp,expN1,expN2)~AIN AINS(expN)~")
            3
                (return "~ALT ALLTRIM(expC)~ALD ALTD(expN)~ASC ASC(expC)~ASN ASCAN(array,exp,expN1,expN2)~ASO ASORT(array,expN1,expN2)~B2I BIN2I(expC)~B2L BIN2L(expC)~B2W BIN2W(expC)~")
            4
                (return "~BOF BOF()~CDO CDOW(expD)~CHR CHR(expN)~CMO CMONTH(expD)~COL COL()~CTO CTOD(expC)~CUR CURDIR(expC)~DAT DATE()~DAY DAY(expD)~DBE DBEDIT(^UX,^UY,^LX,^LY,array1)~")
            5
                (return "~DBF DBFILTER()~DBR DBRELATION(expN)~DEL DELETED()~DES DESENDED(exp)~DIS DISKSPACE(expN)~DOS DOSERROR()~DOW DOW(expD)~DTC DTOC(expD)~DTS DTOS(expD)~")
            6
                (return "~EMP EMPTY(exp)~EOF EOF()~ERR ERRORLEVEL(expN)~EXP EXP(expN)~FCL FCLOSE(expN)~FCO FCOUNT()~FCR FCREATE(expC,expN)~FER FERROR()~FIE FIELD(expN)~FIL FILE(expC)~")
            7
                (return "~FLO FLOCK()~FOP FOPEN(expC,expN)~FOU FOUND()~FRE FREAD(expN1,@memvarC,expN2)~FRS FREADSTR(expN1,expN2)~FSE FSEEK(expN1,expN2,expN3)~FWR FWRITE(expN1,expN2,expN3)~")
            8
                (return "~GET GETE(expC)~HAR HARDCR(expC)~HEA HEADER()~I2B I2BIN(expN)~IIF IIF(expL,exp1,exp2)~INE INDEXEXT()~IXK INDEXKEY(expN)~INO INDEXORD()~INK INKEY(expN)~INT INT(expN)~")
            9
                (return "~ISA ISALPHA(expC)~ISC ISCOLOR()~ISL ISLOWER(expC)~ISP ISPRINTER()~ISU ISUPPER(expC~L2B L2BIN(expN)~LAK LASTKEY()~LAR LASTREC()~LEF LEFT(expC,expN)~LEN LEN(expC)~")
            10
                (return "~LOG LOG(expN)~LOW LOWER(expC)~LTR LRTIM(expC)~LUP LUPDATE()~MAX MAX(expN1,expD1,expL2,expD2)~MEM MEMOEDIT(expC,^UX,^UY,^LX,^LY,expL)~")
            11
                (return "~MML MEMOLINE(expC,expN1,expN2,expN3,expL)~MMR MEMOREAD(expC)~MMM MEMORY()~MMT MEMOTRAN(expC1,expC2,expC3)~MMW MEMOWRIT(expC1,expC2)~MIN MIN(expN1,expN2)~")
            12
                (return "~MLC MLCOUNT(expC,expN1,expN2,expN3,expL)~MLP MLPOS(expC,expN1,expN2,expN3,expL)~MON MONTH(expD)~NTE NETERR()~NTN NETNAME()~NEX NEXTKEY()~PCL PCOL()~")
            13
                (return "~PCO PCOUNT()~PRL PROCLINE()~PRN PROCNAME()~PRW PROW()~RAT RAT(expC1,expC2)~RDE READEXIT(expL)~RDI READINSERT(expL)~RDV READVAR()~RCN RECNO()~RCS RECSIZE()~")
            14
                (return "~REP REPLICATE(expC,expN)~RES RESTSCREEN(expN1,expN2,expN3,expN4,expC)~RIG RIGHT(expC,expN)~RLO RLOCK()~ROU ROUND(expN1,expN2)~ROW ROW()~")
            15
                (return "~SVS SAVESCREEN(expN1,expN2,expN3,expN4)~SCR SCROLL(expN1,expN2,expN3,expN4,expN5)~SEC SECONDS()~SEL SELECT(expC)~SCA SETCANCEL(expL)~SCO SETCOLOR(expC)~")
            16
                (return "~SPR SETPRC(expN1,expN2)~SOU SOUNDEX(expC)~SPA SPACE(expN)~SQR SQRT(expN)~STR STRTRAN(expC1,expC2,expC3,expN1,expN2)~STU STUFF(expC1,expN1,expN2,expC2)~")
            17
                (return "~SUB SUBSTR(expC,expN1,expN2)~TIM TIME()~TON TONE(expN1,expN2)~TRA TRANSFORM(exp,expC)~TRI TRIM(expC)~TYP TYPE(expC)~UPD UPDATED()~UPP UPPER(expC)~")
            18
                (return "~USD USED()~VAL VAL(expC)~WOR WORD(expN)~YEA YEAR(expD)~")
            NULL
                (return 18)
        )
    )
)
(macro _set_table
    (
        (int                table_number
        )
        (get_parm 0 table_number)
        (switch table_number
            1
                (return "~SALT SET ALTERNATE ~SBEL SET BELL ~SCEN SET CENTURY ~SCOL SET COLOR TO ~SCON SET CONSOLE ~SCUR SET CURSOR ~SDEC SET DECIMALS TO ~SDEF SET DEFAULT TO ~SDEL SET DELETED ~")
            2
                (return "~SDEV SET DEVICE TO ~SESC SET ESCAPE ~SEXA SET EXACT ~")
            3
                (return "~SEXC SET EXCLUSIVE ~SFIL SET FILTER TO ~SFOR SET FORMAT TO ~SFUN SET FUNCTION ~SIND SET INDEX TO ~SINT SET INTENSITY ~SKEY SET KEY ~SMAR SET MARGIN TO ~")
            4
                (return "~SORD SET ORDER TO ~SPAT SET PATH TO ~SPRI SET PRINT ~SPRN SET PRINTER TO ~")
            5
                (return "~SPRO SET PROCEDURE TO ~SREL SET RELATION TO ~SSCO SET SCOREBOARD ~SSOF SET SOFTSEEK ~STYP SET TYPEAHEAD TO ~SUNI SET UNIQUE ~SWRA SET WRAP ~")
            NULL
                (return 5)
        )
    )
)
;Clipper Commenting Macros
(macro _uncomment_conditionals
    (
        (int                display_messages
        )
        (get_parm 0 display_messages)
        (if display_messages
            (message "Uncommenting conditional statements...")
        )
        (save_position)
        (top_of_buffer)
        (translate (+ (_comment_character 1) " begi*>") "" 1 1 0)
        (translate (+ (_comment_character 1) " if*>") "" 1 1 0)
        (translate (+ (_comment_character 1) " whil*>") "" 1 1 0)
        (translate (+ (_comment_character 1) " do w*>") "" 1 1 0)
        (translate (+ (_comment_character 1) " do c*>") "" 1 1 0)
        (translate (+ (_comment_character 1) " for*>") "" 1 1 0)
        (restore_position)
        (if display_messages
            (_display_popup_message "Uncommenting complete." "" 0)
        )
    )
)
;Clipper Conditional Garphics 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 "FOR~PROC~FUNC~IF~CASE~OTHE~BEGI~WHIL~" token)
                            (
                                (move_abs 0 (+ (strlen _numbers) dbr_insert_col))
                                (insert "┌")
                            )
                        )
                        (if (&& (&& (== dbr_dialect 12) (index "~STAT~LOCA~" token)) (|| (index (upper orig_line) "FUNC")(index (upper orig_line) "PROC")))
                            (
                                (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~END~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)
    )
)