home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 308.lha / treewalk / copy.ftw < prev    next >
Encoding:
Text File  |  1980-12-05  |  1.2 KB  |  46 lines
  1. /*
  2.  * copy.ftw - support routine for files.ftw. It copies the minimal subtree
  3.  * that includes it's arguments to directory found in the tw.copyname clip.
  4.  *
  5.  * Note: will copy directories if you ask it to. This is probably not what
  6.  * you want, so it's best not to ask it.
  7.  */
  8. address command
  9.  
  10. directory = arg(1)
  11. file = arg(2)
  12. root = twpath()
  13. dest = getclip("tw.copyname")
  14.  
  15. /* patch up the copy name, if we need to */
  16. if index(":/", right(dest, 1)) = 0 then do
  17.     if index(dest, ":") ~= 0 then dest = dest'/'
  18.     else dest = dest':'
  19.     call setclip 'tw.copyname', dest
  20.     end
  21.  
  22. /* Verify that we've got a good path */
  23. if index(directory, root) ~= 1 then return 1
  24.  
  25. outname = dest || substr(directory, length(root) + 1) || file
  26. inname = directory || file
  27.  
  28. /* Walk up outname until we find a directory that really exists */
  29. outdex = lastpos('/', outname)
  30. do while outdex > 0
  31.     outdir = substr(outname, 1, outdex - 1)
  32.     if exists(outdir) then break
  33.     outdex = lastpos('/', outname, outdex - 1)
  34.     end
  35. outdex = index(outname, '/', outdex + 1)
  36.  
  37. /* Now, walk back down what's left creating directories */
  38. do while outdex > 0
  39.     outdir = substr(outname, 1, outdex - 1)
  40.     'makedir' outdir
  41.     outdex = index(outname, '/', outdex + 1)
  42.     end
  43.  
  44. 'copy' inname 'to' outname
  45. return 1
  46.