MT Count keywords : Source

Source

--- This source is written in HyperTalk for CompileIt!

global myType:OStype, mySize:longInt, myactSize:longInt
global myCaseFlg:Boolean
global theAEEvent:R,theReply:R, handerRefCon:LongInt

codeResource "osax"

pascal function countKeyword:I theAEEvent:R, theReply:R, handerRefCon:L

  ---
  put NewPtrClear(8) into myDescPtr

  ---
  put AEGetParamDesc(theAEEvent@,"kwod","TEXT",myDescPtr@) into err
  if err <> 0 then
    DisposPtr myDescPtr
    return err
  end if

  put myDescPtr@.dataHandle into kwodHandle
  put HandToHand(kwodHandle) into err
  put AEDisposeDesc(myDescPtr@) into xerr
  if err <> 0 then
    DisposPtr myDescPtr
    return err
  end if
  put GetHandleSize(kwodHandle) into kwodSize
  if  kwodSize = 0 then
    DisposPtr myDescPtr
    DisposHandle kwodHandle
    return -1701
  end if

  ---

  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@,"exst",typeBoolean,myDescPtr@) into err
  if err <> 0 then
    put false into myExistFlg
  else
    put myDescPtr@.dataHandle@@.booleanType into myExistFlg
    put AEDisposeDesc(myDescPtr@) into xerr
  end if

  ----

  put AEGetParamDesc(theAEEvent@,keyDirectObject,"TEXT",myDescPtr@) into err
  if err = 0 then
    --- Data

    put myDescPtr@.dataHandle into myTemHandle
    put HandToHand(myTemHandle) into err
    put AEDisposeDesc(myDescPtr@) into xerr
    if err <> 0 then
      DisposPtr myDescPtr
      DisposHandle kwodHandle
      return err
    end if

    put GetHandleSize(myTemHandle) into myBufSize
    if myBufSize = 0 then

      DisposHandle kwodHandle
      DisposHandle myTemHandle
      put 0 into  myDescPtr@.integerType
      if theReply@.descriptorType <> typeNull then
        put AEPutParamPtr(theReply@, keyDirectObject, "shor",myDescPtr,2) into err
      end if

      DisposPtr myDescPtr
      return 0
    end if

    put charToNum(kwodHandle@@.charType[0]) into tgA

    put 0 into myCount
    put false into foundFlg
    put myBufSize-kwodSize into scanLen

    repeat with x = 0 to scanLen

      if foundFlg and myExistFlg then
        exit repeat
      end if

      put charToNum(myTemHandle@@.charType[x]) into tgB
      if EqualCase(tgA,tgB) then
        if MatchHandle(myTemHandle,kwodHandle,x) then
          add 1 to myCount
          put true into foundFlg
        end if
      end if

    end repeat


  else --=========================================================---

    --- File
    ---

    put AESizeOfParam(theAEEvent@,"scfl",myType,mySize) into err
    if err <> 0 then
      DisposPtr myDescPtr
      DisposHandle kwodHandle
      return err
    end if

    put NewPtr(70) into myFssPtr

    if myType = "TEXT" then

      put NewPtr(mySize+1) into myNmPtr
      put myNmPtr+1 into aPtr
      put AEGetParamPtr(theAEEvent@,"scfl","TEXT",typeCode,aPtr,mySize,myactSize) into err


      if err <> 0 then
        DisposPtr myNmPtr
        DisPosPtr myFssPtr
        DisposPtr myDescPtr
        DisposHandle kwodHandle
        return err
      end if

      put NumToChar(mySize) into myNmPtr@.charType
      put myNmPtr@.Str255Type into myFname

      put FSMakeFSSpec(0, 0, myFname, myFssPtr@) into err
      DisposPtr myNmPtr
      if err <> 0 then
        DisPosPtr myFssPtr
        DisposPtr myDescPtr
        DisposHandle kwodHandle
        return err
      end if

    else

      put AEGetParamPtr(theAEEvent@,"scfl",typeFSS,typeCode,myFssPtr,70,myactSize) into err

      if err <> 0 then
        DisPosPtr myFssPtr
        DisposPtr myDescPtr
        DisposHandle kwodHandle
        return err
      end if

    end if

    ----
    put FSpOpenDF(myFssPtr@,fsCurPerm,myRefNum) into err
    DisPosPtr myFssPtr
    if err <> 0 then
      DisposPtr myDescPtr
      DisposHandle kwodHandle
      return err
    end if


    get GetEOF(myRefNum,myBufSize)
    put MaxMem(dum) into myMemSize
    put (myMemSize-20480) 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 0 into baseOff
    put charToNum(kwodHandle@@.charType[0]) into tgA
    put 0 into myCount
    put false into foundFlg

    repeat

      get SetFPos(myRefNum,1,baseOff)
      HLock myTemHandle
      put FSRead(myRefNum,myBufSize,myTemHandle@) into err
      HUnlock myTemHandle

      if err = -39 then
        put false into continueFlg
        SetHandleSize myTemHandle,myBufSize
      else if err <> 0 then
        put FSClose(myRefNum) into xerr
        DisposPtr myDescPtr
        DisposHandle myTemHandle
        DisposHandle kwodHandle
        return err
      end if

      put myBufSize-kwodSize into scanLen


      repeat with x = 0 to scanLen

        if foundFlg and myExistFlg then
          put false into continueFlg
          exit repeat
        end if

        put charToNum(myTemHandle@@.charType[x]) into tgB
        if EqualCase(tgA,tgB) then
          if MatchHandle(myTemHandle,kwodHandle,x) then
            add 1 to myCount
            put true into foundFlg
          end if
        end if
      end repeat

      if not continueFlg then exit repeat

      put baseOff+scanLen+1 into baseOff

    end repeat

    put FSClose(myRefNum) into xerr

  end if

  put myCount into myDescPtr@.integerType

  if theReply@.descriptorType <> typeNull then
    put AEPutParamPtr(theReply@, keyDirectObject, "shor",myDescPtr,2) into err
  end if

  DisposPtr myDescPtr
  DisposHandle myTemHandle
  DisposHandle kwodHandle


  return 0


end countKeyword

function MatchHandle tgHandle,keyHandle,xOff

  put GetHandleSize(tgHandle) into strLen
  put GetHandleSize(keyHandle) into keyLen

  if strLen-xOff < keyLen then return false

  put keyLen-1 into scanLen
  put true into matchFlg
  repeat with y = scanLen down to 1

    put CharToNum(tgHandle@@.charType[y+xOff]) into tgA
    put CharToNum(keyHandle@@.charType[y]) into tgB
    if EqualCase(tgA, tgB) then next repeat

    put false into matchFlg
    exit repeat
  end repeat

  return matchFlg

end MatchHandle


function EqualCase tgA, tgB
  if myCaseFlg then
    return (tgA = tgB)
  else
    if tgA >= 65 and tgA <= 90 then put tgA+32 into tgA
    if tgB >= 65 and tgB <= 90 then put tgB+32 into tgB
    return (tgA = tgB)
  end if
end EqualCase