home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / ipatch.icn < prev    next >
Text File  |  2000-11-15  |  2KB  |  72 lines
  1. ############################################################################
  2. #
  3. #    File:     ipatch.icn
  4. #
  5. #    Subject:  Program to patch iconx path in executable
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     November 15, 2000
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  Usage:  ipatch file path
  18. #
  19. #     Ipatch changes the path to iconx, the Icon interpreter, that is
  20. #  embedded in an Icon executable file under Unix.  Icon 9.4 headers are
  21. #  rewritten in the same form.  Because headers from earlier versions of
  22. #  Icon contain no room for expansion, they are rewritten in a different
  23. #  form to accommodate a possibly-longer path.
  24. #
  25. ############################################################################
  26. #
  27. #  Requires:  Unix
  28. #
  29. ############################################################################
  30.  
  31. procedure main(args)
  32.    local fname, path, f, header, hlength, pfx
  33.  
  34.    if *args ~= 2 then
  35.       stop("usage: ", &progname, " file iconx")
  36.    fname := get(args)
  37.    path := get(args)
  38.  
  39.    f := open(fname, "rwu") | stop("cannot open ", fname, " for writing")
  40.    header := reads(f, 1000) | stop(fname, ": empty file")
  41.  
  42.    header ? {
  43.      (tab(find("\n[executable Icon binary follows]\n")) & tab(find("\f\n\0"))) |
  44.          stop(fname, ": not an Icon executable")
  45.       hlength := &pos - 1
  46.       tab(1)
  47.       if pfx := tab(find("IXBIN=") + 6) then {
  48.          # Icon 9.4 or later binary
  49.          tab(upto('\n'))
  50.          header := pfx || path || tab(hlength + 1)
  51.          }
  52.       else {
  53.          # Icon 9.3 or earlier binary
  54.          header := "#!/bin/sh" ||
  55.             "\n" ||
  56.             "\nexec ${ICONX-" || path || "} $0 ${1+\"$@\"}" ||
  57.             "\n\n\n\n\n" ||
  58.             "\n[executable Icon binary follows]" ||    # must appear exactly
  59.             "\n"
  60.          }
  61.       }
  62.  
  63.    if *header + 3 > hlength then
  64.       stop("cannot patch: path is too long to fit")
  65.  
  66.    if not close(open(path)) then
  67.       write(&errout, "warning: cannot open ", path, "; patching anyway")
  68.  
  69.    seek(f, 1) | stop("cannot reposition ", fname)
  70.    writes(f, left(header, hlength)) | stop("write failed")
  71. end
  72.