MT Pick Lines : Source
| Name: | MT Pick Lines
|
| Event Class: | XUVJ
|
| Event ID: | pkln
|
| Resource: | AEVTXUVJpkln
|
Source
--- This source is written in HyperTalk for CompileIt!
global myType:OStype, mySize:longInt, myactSize:longInt
global theAEEvent:R,theReply:R, handerRefCon:LongInt
global myBufSize:LongInt, readBufSize:LongInt
codeResource "osax"
pascal function PickLines:I theAEEvent:R, theReply:R, handerRefCon:L
put NewPtrClear(334) into myWorkPtr
put myWorkPtr into myDescPtr
put myWorkPtr + 8 into myFssPtr
put myWorkPtr + 78 into myNmPtr
----
put AEGetParamDesc(theAEEvent@,"csen",typeBoolean,myDescPtr@) into err
if err <> 0 then
put false into myCaseFlg
else
put myDescPtr@.dataHandle@@.booleanType into myCaseFlg
put AEDisposeDesc(myDescPtr@) into xerr
end if
----
put AEGetParamDesc(theAEEvent@,"clum","shor",myDescPtr@) into err
if err <> 0 then
put 0 into tgClum
else
put myDescPtr@.dataHandle@@.integerType into tgClum
if tgClum < 1 then put 0 into tgClum
put AEDisposeDesc(myDescPtr@) into xerr
end if
----
put AEGetParamDesc(theAEEvent@,"lsiz","shor",myDescPtr@) into err
if err <> 0 then
put 0 into gLimit
else
put myDescPtr@.dataHandle@@.integerType into gLimit
if gLimit < 1 then put 0 into gLimit
put AEDisposeDesc(myDescPtr@) into xerr
end if
----
put AEGetParamDesc(theAEEvent@,"kwod","TEXT",myDescPtr@) into err
if err <> 0 then
DisposPtr myWorkPtr
return err
end if
put myDescPtr@.dataHandle into kwodHandle
put HandToHand(kwodHandle) into err
put AEDisposeDesc(myDescPtr@) into xerr
if err <> 0 then
DisposPtr myWorkPtr
return err
end if
put GetHandleSize(kwodHandle) into kwodSize
if kwodSize = 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
return -1701
end if
----
put AEGetParamDesc(theAEEvent@,"xdel",typeChar,myDescPtr@) into err
if err <> 0 then
put NewHandle(1) into xDelHandle
put NumToChar(13) into xDelHandle@@.charType
else
put myDescPtr@.dataHandle into xDelHandle
put HandToHand(xDelHandle) into err
put AEDisposeDesc(myDescPtr@) into xerr
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
return err
end if
end if
put GetHandleSize(xDelHandle) into xDelLen
if xDelLen = 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
return -1701
end if
----
put AEGetParamDesc(theAEEvent@,"xtab",typeChar,myDescPtr@) into err
if err <> 0 then
put NewHandle(1) into xTabHandle
put NumToChar(9) into xTabHandle@@.charType
else
put myDescPtr@.dataHandle into xTabHandle
put HandToHand(xTabHandle) into err
put AEDisposeDesc(myDescPtr@) into xerr
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
return err
end if
end if
put GetHandleSize(xTabHandle) into xTabLen
if xTabLen = 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return -1701
end if
----
put AEGetParamDesc(theAEEvent@,keyDirectObject,"TEXT",myDescPtr@) into err
if err = 0 then
---
--- scan Data
---
put myDescPtr@.dataHandle into myStrHandle
put HandToHand(myStrHandle) into err
put AEDisposeDesc(myDescPtr@) into xErr
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
MoveHHi myStrHandle
put AEcreateList(nil,0,false,myDescPtr@) into err
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
DisposHandle myStrHandle
return err
end if
put GetHandleSize(myStrHandle) into myBufSize
if myBufSize < kwodSize then
if theReply@.descriptorType <> typeNull then
put AEPutParamDesc(theReply@, keyDirectObject,myDescPtr@) into err
end if
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
DisposHandle myStrHandle
return 0
end if
---
put charToNum(kwodHandle@@.charType[0]) into tgKey
put CharToNum(xTabHandle@@.charType[0]) into tgTab
put CharToNum(xDelHandle@@.charType[0]) into tgDel
put 0 into foundCounter
put myBufSize-1 into scanOff
put 0-xDelLen into ssPos
put false into foundFlg
put 1 into xTabCounter
put 0 into x
repeat
if x > scanOff then
if foundFlg then
put myBufSize-ssPos-xDelLen into tgLen
HLock myStrHandle
put myStrHandle@+ssPos+xDelLen into tgPtr
put AEPutPtr(myDescPtr@,0,typeChar,tgPtr,tgLen) into err
HUnlock myStrHandle
if err <> 0 then
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
DisposHandle myStrHandle
return err
end if
end if
exit repeat
end if
if (gLimit > 0) and (foundCounter >= gLimit) then
exit repeat
end if
put charToNum(myStrHandle@@.charType[x]) into tgB
if EqualCase(tgDel,tgB,true) then
if MatchTop(myStrHandle,x,xDelHandle,true) then
if foundFlg then
put x-ssPos-xDelLen into tgLen
HLock myStrHandle
put myStrHandle@+ssPos+xDelLen into tgPtr
put AEPutPtr(myDescPtr@,0,typeChar,tgPtr,tgLen) into err
HUnlock myStrHandle
if err <> 0 then
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
DisposHandle myStrHandle
return err
end if
put false into foundFlg
add 1 to foundCounter
end if
put 1 into xTabCounter
put x into ssPos
add xDelLen to x
next repeat
end if
end if
if foundFlg then
add 1 to x
next repeat
end if
if EqualCase(tgTab,tgB,true) then
if MatchTop(myStrHandle,x,xTabHandle,true) then
add 1 to xTabCounter
add xTabLen to x
next repeat
end if
end if
if EqualCase(tgKey,tgB,myCaseFlg) then
if (tgClum = 0 ) ¬
or (tgClum = xTabCounter) then
put MatchTop(myStrHandle,x,kwodHandle,myCaseFlg) into foundFlg
if foundFlg then
add kwodSize to x
next repeat
end if
end if
end if
add 1 to x
end repeat
if theReply@.descriptorType <> typeNull then
put AEPutParamDesc(theReply@, keyDirectObject,myDescPtr@) into err
end if
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle myStrHandle
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return 0
else ---========================================================---
---
--- scan file
---
put AESizeOfParam(theAEEvent@,"scfl",myType,mySize) into err
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
if myType = "TEXT" and mySize < 256 then
put myNmPtr+1 into aPtr
put AEGetParamPtr(theAEEvent@,"scfl","TEXT",typeCode,aPtr,mySize,myactSize) into err
if err <> 0 then
DisposPtr myNmPtr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
put NumToChar(mySize) into myNmPtr@.charType
put myNmPtr@.Str255Type into myFname
put FSMakeFSSpec(0, 0, myFname, myFssPtr@) into err
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
else
put AEGetParamPtr(theAEEvent@,"scfl",typeFSS,typeCode,myFssPtr,70,myactSize) into err
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
end if
put AEcreateList(nil,0,false,myDescPtr@) into err
if err <> 0 then
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
----
---- Start File search
----
put FSpOpenDF(myFssPtr@,fsCurPerm,myRefNum) into err
if err <> 0 then
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
put GetEOF(myRefNum,myBufSize) into xErr
if myBufSize < kwodSize then
if theReply@.descriptorType <> typeNull then
put AEPutParamDesc(theReply@, keyDirectObject,myDescPtr@) into err
end if
put FSClose(myRefNum) into err
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return 0
end if
put MaxMem(dum) into myMemSize
if myMemSize < 30720 then
put FSClose(myRefNum) into err
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return -108
end if
put (myMemSize-30720) into readBufSize
if myBufSize < readBufSize then
put myBufSize into readBufSize
put false into continueFlg
else
put readBufSize into myBufSize
put true into continueFlg
end if
put NewHandle(readBufSize) into myTemHandle
put MemError() into err
if err <> 0 or myTemHandle = NIL then
put FSClose(myRefNum) into xerr
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
MoveHHi myTemHandle
put charToNum(kwodHandle@@.charType[0]) into tgKey
put CharToNum(xTabHandle@@.charType[0]) into tgTab
put CharToNum(xDelHandle@@.charType[0]) into tgDel
put 0 into baseOff
put 0 into foundCounter
repeat
put SetFPos(myRefNum,1,baseOff) into err
HLock myTemHandle
put FSRead(myRefNum,myBufSize,myTemHandle@) into err
HUnlock myTemHandle
if err = -39 then
put false into continueFlg
end if
put myBufSize-1 into scanOff
put 0-xDelLen into ssPos
put false into foundFlg
put 1 into xTabCounter
put 0 into x
repeat
if x > scanOff then
if (not continueFlg) and foundFlg then
--- if last line contains keyword
put myBufSize-ssPos-xDelLen into tgLen
HLock myTemHandle
put myTemHandle@+ssPos+xDelLen into tgPtr
put AEPutPtr(myDescPtr@,0,typeChar,tgPtr,tgLen) into err
HUnlock myTemHandle
if err <> 0 then
put FSClose(myRefNum) into xerr
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle myTemHandle
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
end if
exit repeat
end if
if (gLimit > 0) and (foundCounter >= gLimit) then
put false into continueFlg
exit repeat
end if
put charToNum(myTemHandle@@.charType[x]) into tgB
if EqualCase(tgDel,tgB,true) then
if MatchTop(myTemHandle,x,xDelHandle,true) then
--- Line End
if foundFlg then
put x-ssPos-xDelLen into tgLen
HLock myTemHandle
put myTemHandle@+ssPos+xDelLen into tgPtr
put AEPutPtr(myDescPtr@,0,typeChar,tgPtr,tgLen) into err
HUnlock myTemHandle
if err <> 0 then
put FSClose(myRefNum) into xerr
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle myTemHandle
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
return err
end if
put false into foundFlg
add 1 to foundCounter
end if
put 1 into xTabCounter
put x into ssPos
add xDelLen to x
next repeat
end if
end if
if foundFlg then
add 1 to x
next repeat
end if
if EqualCase(tgTab,tgB,true) then
if MatchTop(myTemHandle,x,xTabHandle,true) then
add 1 to xTabCounter
add xTabLen to x
next repeat
end if
end if
if EqualCase(tgKey,tgB,myCaseFlg) then
if (tgClum = 0 ) ¬
or (tgClum = xTabCounter) then
put MatchTop(myTemHandle,x,kwodHandle,myCaseFlg) into foundFlg
if foundFlg then
add kwodSize to x
next repeat
end if
end if
end if
add 1 to x
end repeat
if not continueFlg then exit repeat
if ssPos = (0-xDelLen) then exit repeat
put baseOff+ssPos+xDelLen into baseOff
end repeat
put FSClose(myRefNum) into err
if theReply@.descriptorType <> typeNull then
put AEPutParamDesc(theReply@, keyDirectObject,myDescPtr@) into err
end if
put AEDisposeDesc(myDescPtr@) into xerr
DisposPtr myWorkPtr
DisposHandle myTemHandle
DisposHandle kwodHandle
DisposHandle xDelHandle
DisposHandle xTabHandle
end if
return err
end PickLines
function MatchTop myStrHandle,xOff,tgHandle,caseFlg
put GetHandleSize(myStrHandle) into srcLen
put GetHandleSize(tgHandle) into tgKLen
if (tgKLen = 1) or (srcLen=1) then return true
if (srcLen - xOff) < tgKLen then return false
put true into matchFlg
put tgKLen-1 into yOff
repeat with x = yOff down to 1
put CharToNum(myStrHandle@@.charType[x+xOff]) into xx
put CharToNum(tgHandle@@.charType[x]) into yy
if EqualCase(xx,yy,caseFlg) then next repeat
put false into matchFlg
exit repeat
end repeat
return matchFlg
end MatchTop
function EqualCase tgA, tgB, caseFlg
if not caseFlg then
if tgA >= 65 and tgA <= 90 then put tgA+32 into tgA
if tgB >= 65 and tgB <= 90 then put tgB+32 into tgB
end if
return (tgA = tgB)
end EqualCase
Tanaka's osax : Source
Tanaka's osax