Sample Macros
' CT.MACRO
' Center text on a line. Uses RBound (if active) or specified length
' Syntax: CTnn or CTTnn / CTTnn as line commands nn is the width to center on
'
' Author: George Deluca
'
dim tt, tt2 as string
dim lno1, lno2, width, i as number
if is_primary_Cmd then halt(fail, "CT macro was not invoked as a line command")
'----- Get the line numbers
lno1 = Get_Src1_Lptr ' From line
lno2 = Get_Src2_Lptr ' To line
width = Get_Src_Op ' Get the centering width
if width = 0 then width = Get_RBound '
for i = lno1 to lno2 ' Loop through the line range
if Is_Data(i) then ' Just Data lines
tt = trim$(Get_Line$(i)) ' Get the trimmed text
if width = 0 then width = Get_Line_Len(i) ' Use line length if no other
if len(tt) > width then ' Center possible?
Set_Msg(8, "One or more lines exceed Center length")
else '
tt2 = repeat$((width - len(tt)) / 2, " ") + tt ' Center it
Set_Line(i, tt2) ' Stuff it back
end if '
end if '
next '
halt ' Done
------------------------------------------------------------------------------------------
' ISRBox.MACRO
' ISRBOX - Draw box with its U/L corner at the cursor
' Syntax: ISRBOX With cursor sitting on the
' desired location. Normally the
' command would be assigned to a
' command key for convenience.
' Author: George Deluca
' Original in Rexx in the IBM macros documentation
'
dim i, j as number
if Get_Csr_LPtr = 0 then halt(FAIL, "Cursor is not within the text area")'
j = Get_Csr_LPtr ' Point at 1st line
for i = 1 to 5 ' Set # lines to do
if j = Get_Last_LPtr then exit for ' Just in case we hit bottom
if Is_Data(j) then ' Only data lines
if i = 1 or i = 5 then ' If Top or bottom of box
SPF_Ovr(j, Get_Csr_Col, "+--------------------+") ' Overlay the box chars
else ' Else middle lines
SPF_Ovr(j, Get_Csr_Col, "| |") ' Overlay the box chars
end if '
if i = 3 then Set_Csr(j, Get_Csr_Col + 2, 0) ' Put cursor on middle line
else '
Decr i ' Don't move box row number
end if '
Incr j ' On to next edit line
next '
halt ' Done
------------------------------------------------------------------------------------------
' ISRCount.MACRO
'
' ISRCOUNT counts the number of occurrences of a string, and
' issues a message.
'
' Syntax: ISRCOUNT string
'
' Author: George Deluca
' Original by IBM in the Macros documentation
dim msg as string
if Get_Arg$(0) = "" then halt(fail, "Missing search argument") ' Better have an operand
SPF_Cmd("FIND ALL " + SPF_Quote$(Get_Arg$(0))) ' Issue a FIND ALL command
if Get_RC <> 0 then halt(fail, "No occurrences of: " + Get_Arg$(1)) ' Tell of error
msg = Get_Msg$ ' Get the SPFLite message text
' Issue our own format message
halt("ISRCount found", Get_Arg$(0), parse$(msg, " ", 4), "times")
------------------------------------------------------------------------------------------
' ISRMask.MACRO
'
' ISRMASK - Overlay a line with data from the mask line.
' Use either line command O/OO or OR/ORR to specify
' which lines to overlay. O/OO causes nondestructive
' overlay, and OR/ORR causes a destructive overlay.
'
' Author: George Deluca
' Original by IBM in the Macros Documentation
'
dim mask as string
dim i as number
spf_debug(Get_Dest_LCmd$)
if left$(Get_Dest_LCmd$, 1) <> "O" then halt(fail, "No overlay range has been selected")
mask = Get_Profile$("MASK") ' Fetch the MASK data
for i = Get_Dest1_LPtr to Get_Dest2_LPtr ' Loop through line range
if Is_Data(i) then ' Only Data lines
if Get_Dest_LCmd$ = "O" or Get_Dest_LCmd$ = "OO" then ' Normal O/OO type overlay?
SPF_Ovr(i, 1, mask) ' Overlay the mask
else ' Must be OR/ORR type
SPF_Ovr_Rep(i, 1, mask) ' Force Overlay the mask
end if '
end if ' End IsData
next '
halt ' Done
------------------------------------------------------------------------------------------
' PB.MACRO
' Run a batch compile of the current program. If the compiler reports an error,
' read the LOG file to locate the error, and move the cursor to the line in error
' and display the compiler's error message. This demonstrates how to read and
' process an external file using the thinBasic FILE module.
'
' Syntax: PB
'
' Author: George Deluca
'
dim cmd, errmsg, tt as string
dim errlin, errcol, i as number
dim fHandle as DWORD
uses "FILE" ' Attach the FILE module
'----- Save unmodified files
SPF_Cmd("SAVEALL COND")
'----- Build command line to run the compiler
cmd = $DQ + "D:\Google Drive\Misc Data\PBWin10.bat" + $DQ + " "
cmd += $DQ + mid$(Get_FilePath$, 3) + $DQ + " "
cmd += $DQ + Get_FileName$ + $DQ
'----- Do the compile and get the RC result
SPF_EXEC(cmd)
if Get_RC = 0 then halt("PB10 compile successful")
'----- Handle the compiler error, get the LOG file
fHandle = FILE_OPEN(Get_FilePath$ + "\" + Get_FileBase$ + ".LOG" , "INPUT")
if fHandle = 0 then halt(fail, "PB10 compile failed, can't open LOG file")
for i = 1 to 6 ' Read line 6 of the LOG
errmsg = FILE_LineInput(fHandle) '
next i '
i = FILE_Close(fHandle) '
'----- Extract error line number, column and error message text
'----- Sample error line: Error 442 in C:\Documents\Source\try.bas(12:016): THEN expected
tt = parse$(errmsg, any "()", 2) ' Get the (nnn:nnn) value
errlin = val(tt) ' Line number preceeds the :
tt = mid$(tt, instr(tt, ":") + 1) '
errcol = val(tt) ' Col number follows the :
errmsg = parse$(errmsg, "):", 2) ' Message follows the ):
'----- Issue an error message and set the cursor to the error line
Set_Msg(fail,"Line: " + format$(errlin) + " Col: " + format$(errcol) + " " + errmsg)
tt = Get_Line$(errlin + 1) ' Get the error line
if errcol > len(tt) then ' Long enough to hi-lite?
tt = lset$(tt, errcol) ' Lengthen it
Set_Line(errlin + 1, tt) ' Stuff it back
end if '
Set_Csr(errlin + 1, errcol, 1) ' Hi-light the compiler's error location
halt ' Done
------------------------------------------------------------------------------------------
' RM.MACRO
' Find rightmost occurrence of a string
' Syntax: RM string
'
' Author: George Deluca
'
dim hicol, hiline as number value 0
if Get_Arg$(0) = "" then halt(fail, "Missing search argument")
SPF_Cmd("FIND FIRST " & Get_Arg$(0)) ' Issue 1st FIND cmd
do while Get_RC = 0 ' while found
if Get_Find_Col > hicol then ' Save hi-water mark
hicol = Get_Find_Col '
hiline = Get_Find_LPtr '
end if '
SPF_Cmd("RFIND") ' Look some more
loop '
if hiline = 0 then ' Find anything?
halt(fail, "String not found") ' No, tell of error
else ' Yes
Set_Csr(hiline, hicol, Get_Find_Len) ' Set cursor to it
halt("Found", Get_Arg$(0), "rightmost in col:", format$(hicol)) ' Issue good message
end if '
------------------------------------------------------------------------------------------
' FMBkDisp.macro
'----- Display Backup status for all files in the File Manager list
' Created: George Deluca - June 1, 2019
'
'----- Check environment
if isfalse Is_FM then halt(8, "FMBkDisp: Not running in File Manager")
if isfalse Is_Primary_Cmd then halt(8, "FMBkDisp: Not running as Primary Command")
dim i, j as long
dim t as string
'----- Display BACKUP status for each file
for i = 1 to FMGet_FCount when FMGet_FType(i) = FM_EQU_File ' Loop through Files
j = FMGet_Backup_Versions(i) ' Get # backups
t = lset$(FMGet_Abbrevname$(i, 20), 20) ' Get short fixed length filename
t += " has " + iif$(j = 0, "no Backups", format$(j) + " Backup"+ iif$(j > 1, "s", "") )
FMSet_Msg(i, t) ' Display the message
next i ' End of file loop
halt(0, "FMBkDisp: Display complete")
------------------------------------------------------------------------------------------
' FMJoin.macro
'----- Join selected files in a File Manager session and open in a new Edit session
'----- If no macro operand, the collected data will be opened
'----- in a Clipboard session
'-----
'----- If an operand, it is assumed to be a filename and the
'----- collected data will be created in that file and the file
'----- opened in a normal Edit session.
'-----
'----- Select files with a Z line command (Could use any character)
'-----
' Created: George Deluca - June 3, 2019
'
USES "FILE"
'----- Check environment
if isfalse Is_FM then halt(8, "FMJoin: Not running in File Manager")
if isfalse Is_Primary_Cmd then halt(8, "FMJoin: Not running as Primary Command")
'----- Declare variables
dim FCount as long = FMGet_FCount
dim i, j as long
dim FName, FullName as string = "" ' Filename to null (CLIP mode)
dim CB, lText as string = "" ' Set strings to null
dim IFile, OFile as DWORD ' File handles
'----- See if an Output filename specified, if so, get it's name
if Get_Arg_Count > 0 then FName = Get_Arg$(1) ' An operand? Save as FName
'----- Scan for selected files in the list
for i = 1 to FCount when FMGet_FType(i) = FM_EQU_File ' Loop through Files
if ucase$(trim$(FMGet_Cmd$(i))) = "Z" then ' A selected file?
FullName = FMGet_Path$(i) + FMGet_FileName$(i) ' Build full filename
'----- Open Output if not CLIP mode
If FName <> "" and OFile = 0 then ' If O/P file and not opened
if instr(FName, "\") = 0 then ' If FName unqualified
FName = FMGet_Path$(i) + FName ' Add the Input path
end if '
OFile = File_Open(FName, "OUTPUT") ' Open the output
If OFile = 0 then Halt(8, "FMJoin: Can't open: " + FName)
end if
'----- Open the Input file
IFile = File_Open(FullName, "INPUT") ' Open the file
If IFile = 0 then Halt(8, "Can't open: " + FullName)
'----- Read a single Input file
Do while isfalse File_EOF(IFile) ' Read the data
if FName = "" then ' If in CLIP mode
CB += File_LineInput(IFile) + $CRLF ' Add to CB string
else '
lText = File_LineInput(IFile) ' Read a line
File_LinePrint(OFile, lText) ' Write to the output
end if '
loop '
'----- Close Input, clear Select character
File_Close(IFile) '
FMSet_Cmd(i, " ") ' Clear the selection char
incr j ' Count files done
end if '
next i '
if FName <> "" then File_Close(OFile) ' Close O/P file if we have one
'----- Did we accomplish anything?
if j = 0 then Halt(0, "FMJoin: No files were selected")
'----- Invoke via the Clipboard and CLIP
if FName = "" then ' In CLIP mode?
ClipBoard_SetText(CB) ' Write to the Clipboard
SPF_Post_Do("(Home)(EraseEOL)[CLIP](Enter)") ' Invoke CLIP
else '
'----- Or invoke via a new edit session
FName = SPF_Quote$(FName) ' Put FName in quotes
SPF_Post_Do("(Home)(EraseEOL)[EDIT " + FName + "](Enter)") ' Invoke EDIT
end if '
Halt(0) '
------------------------------------------------------------------------------------------
' FMBkAll.macro
'----- Backup all files in the File Manager list which have no existing backup
'-----
' Created: George Deluca - June 1, 2019
'
'----- Check environment
if isfalse Is_FM then halt(8, "FMBkAll: Not running in File Manager")
if isfalse Is_Primary_Cmd then halt(8, "FMBkAll: Not running as Primary Command")
dim i, j as long
'----- Scan file list for ones not backed up
for i = 1 to FMGet_FCount when FMGet_FType(i) = FM_EQU_File ' Loop through Files
if FMGet_Backup_Versions(i) = 0 then ' If no current backups
SPF_FM_LCmd(i, "BACKUP") ' Then request one
incr j ' Count it
end if ' End of no backups
next i ' End of file loop
'----- Issue appropriate message
halt(0, iif$(j = 0, "FMBkAll: All files had existing Backup(s)", "FMBkAll: " + format$(j) + " Backups requested"))
------------------------------------------------------------------------------------------
Created with the Personal Edition of HelpNDoc: Free help authoring environment