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