MT Replace : Source

Source

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

global myType:OStype, mySize:longInt, myCounter:longInt
global theAEEvent:R,theReply:R, handerRefCon:LongInt, myScount:LongInt, myRcount:LongInt
global myCaseFlg:Boolean, firstFlg:Boolean, sStrPtr:Pointer, rStrPtr:Pointer

codeResource "osax"

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

  put NewPtr(48) into myWorkPtr

  put myWorkPtr into myDescPtr
  put myWorkPtr + 8 into mySearchDesc
  put myWorkPtr + 16 into myReplaceDesc
  put myWorkPtr + 24 into sStrPtr
  put myWorkPtr + 32 into rStrPtr
  put myWorkPtr + 40 into myLIPtr

  ----
  put AEGetParamDesc(theAEEvent@,"zstr","list",mySearchDesc@) into err
  if err <> 0 then
    DisposPtr myWorkPtr
    return err
  end if

  put AECountItems(mySearchDesc@,myScount) into err
  if err <> 0 then
    put AEDisposeDesc(mySearchDesc@) into xerr
    DisposPtr myWorkPtr
    return err
  end if

  if myScount < 1 then
    put AEDisposeDesc(mySearchDesc@) into xerr
    DisposPtr myWorkPtr
    return -1708
  end if
  ----
  put AEGetParamDesc(theAEEvent@,"rstr","list",myReplaceDesc@) into err
  if err <> 0 then
    put AEDisposeDesc(mySearchDesc@) into xerr
    DisposPtr myWorkPtr
    return err
  end if

  put AECountItems(myReplaceDesc@,myRcount) into err
  if err <> 0 then
    put AEDisposeDesc(mySearchDesc@) into xerr
    put AEDisposeDesc(myReplaceDesc@) into xerr
    DisposPtr myWorkPtr
    return err
  end if

  if myRcount < 1 or myRcount <> myScount then
    put AEDisposeDesc(mySearchDesc@) into xerr
    put AEDisposeDesc(myReplaceDesc@) into xerr
    DisposPtr myWorkPtr
    return -1708
  end if

  ----
  put AEGetParamDesc(theAEEvent@,"csen","bool",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@,"oly1","bool",myDescPtr@) into err
  if err <> 0 then
    put false into firstFlg
  else
    put myDescPtr@.dataHandle@@.booleanType into firstFlg
    put AEDisposeDesc(myDescPtr@) into xerr
  end if
  ----

  put AESizeOfParam(theAEEvent@,keyDirectObject,myType,mySize) into err
  if err <> 0 then
    put AEDisposeDesc(mySearchDesc@) into xerr
    put AEDisposeDesc(myReplaceDesc@) into xerr
    DisposPtr myWorkPtr
    return err
  end if

  if (myType = "list") then
    --- list of strings

    put AEGetParamDesc(theAEEvent@,keyDirectObject,typeAEList,myDescPtr@) into err
    if err <> 0 then
      put AEDisposeDesc(mySearchDesc@) into xerr
      put AEDisposeDesc(myReplaceDesc@) into xerr
      DisposPtr myWorkPtr
      return err
    end if

    put 0 into mySize
    put AECountItems(myDescPtr@,mySize) into err
    if err <> 0 then
      put AEDisposeDesc(myDescPtr@) into xErr
      put AEDisposeDesc(mySearchDesc@) into xerr
      put AEDisposeDesc(myReplaceDesc@) into xerr
      DisposPtr myWorkPtr
      return err
    end if

    if mySize > 0 then

      repeat with x = 1 to mySize

        put AEGetNthDesc(myDescPtr@,x,"TEXT",myKey,myLIPtr@) into err
        if err = 0 then

          put myLIPtr@.dataHandle into myStrHandle

          put replacer(myStrHandle,mySearchDesc,myReplaceDesc) into err
          if err <> 0 then
            DisposPtr myLIPtr
            put AEDisposeDesc(myDescPtr@) into xErr
            put AEDisposeDesc(mySearchDesc@) into xerr
            put AEDisposeDesc(myReplaceDesc@) into xerr
            DisposPtr myWorkPtr
            return err
          end if

          put AEPutDesc(myDescPtr@,x,myLIPtr@) into err
          put AEDisposeDesc(myLIPtr@) into xErr
          if err <> 0 then
            DisposPtr myLIPtr
            put AEDisposeDesc(myDescPtr@) into xErr
            put AEDisposeDesc(mySearchDesc@) into xerr
            put AEDisposeDesc(myReplaceDesc@) into xerr
            DisposPtr myWorkPtr
            return err
          end if

        end if

      end repeat
    end if

  else

    --- string

    put AEGetParamDesc(theAEEvent@,keyDirectObject,typeChar,myDescPtr@) into err
    if err <> 0 then
      put AEDisposeDesc(mySearchDesc@) into xerr
      put AEDisposeDesc(myReplaceDesc@) into xerr
      DisposPtr myWorkPtr
      return err
    end if


    put myDescPtr@.dataHandle into myStrHandle
    put replacer(myStrHandle,mySearchDesc,myReplaceDesc) into err

  end if

  if err = 0 then
    if theReply@.descriptorType <> typeNull then
      put AEPutParamDesc(theReply@, keyDirectObject,myDescPtr@) into err
    end if
  end if

  put AEDisposeDesc(myDescPtr@) into xErr
  put AEDisposeDesc(mySearchDesc@) into xerr
  put AEDisposeDesc(myReplaceDesc@) into xerr
  DisposPtr myWorkPtr
  return err


end xReplace



function replacer myStrHandle,mySearchDesc,myReplaceDesc

  repeat with z = 1 to myScount

    put AEGetNthDesc(mySearchDesc@,z,"TEXT",myKey,sStrPtr@) into err

    if err <> 0 then
      DisposPtr sStrPtr
      DisposPtr rStrptr
      return err
    end if

    put AEGetNthDesc(myReplaceDesc@,z,"TEXT",myKey,rStrPtr@) into err
    if err <> 0 then
      put AEDisposeDesc(sStrPtr@) into xerr
      DisposPtr sStrPtr
      DisposPtr rStrptr
      return err
    end if

    put sStrPtr@.dataHandle into tStrHandle
    put rStrPtr@.dataHandle into rStrHandle
    put GetHandleSize(tStrHandle) into tStrSize
    put GetHandleSize(rStrHandle) into rStrSize
    put GetHandleSize(myStrHandle) into myStrLen

    if myStrLen < tStrSize then
      put AEDisposeDesc(sStrPtr@) into xerr
      put AEDisposeDesc(rStrPtr@) into xerr
      next repeat
    end if

    put myStrLen-tStrSize into endOff
    put rStrSize-tStrSize into deltaSize
    put tStrSize-1 into xScanLen

    put CharToNum(tStrHandle@@.charType) into tgx

    put 0 into myCounter

    HLock rStrHandle

    repeat
      if myCounter > endOff then exit repeat

      put CharToNum(myStrHandle@@.charType[myCounter]) into tgy

      if not EqualCase(tgx,tgy) then
        add 1 to myCounter
        next repeat
      end if

      if tStrSize > 1 then
        put 0 into checkSum

        repeat with y = xScanLen down to 1
          put CharToNum(tStrHandle@@.charType[y]) into xChar
          put CharToNum(myStrHandle@@.charType[myCounter+y]) into yChar
          if not EqualCase(xChar, yChar) then
            put 1 into checkSum
            exit repeat
          end if
        end repeat

        if checkSum <> 0 then
          add 1 to myCounter
          next repeat
        end if

      end if

      put Munger(myStrHandle,myCounter,nil,tStrSize,rStrHandle@,rStrSize) into myCounter

      if firstFlg then exit repeat

      add deltaSize to endOff

    end repeat

    HUnlock rStrHandle
    put AEDisposeDesc(sStrPtr@) into xerr
    put AEDisposeDesc(rStrPtr@) into xerr

  end repeat

  return 0
end replacer


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