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 / gprocs / autopost.icn < prev    next >
Text File  |  2000-07-29  |  2KB  |  72 lines
  1. ############################################################################
  2. #
  3. #    File:     autopost.icn
  4. #
  5. #    Subject:  Procedures to activate PostScript recorder
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     October 11, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #   These procedures, when linked with an unsuspecting Icon program,
  18. #   cause psrecord (q.v) to begin recording PostScript commands when
  19. #   an X window is opened.  This is done by overloading the built-in
  20. #   "open" function.
  21. #
  22. #   The results of this may or may not be usable depending on how the
  23. #   original program is coded.  Psrecord cannot emulate all the X calls
  24. #   and works best with programs designed for it.
  25. #
  26. #   "stop" and "exit" are also overloaded to try and terminate the
  27. #   PostScript file properly.  Other program exit paths, notably a
  28. #   return from the main procedure, are not caught.
  29. #
  30. ############################################################################
  31. #
  32. #  Links:  psrecord
  33. #
  34. ############################################################################
  35. #
  36. #  Requires:  Version 9 graphics
  37. #
  38. ############################################################################
  39.  
  40. link psrecord
  41.  
  42. invocable "open", "stop", "exit"
  43.  
  44. procedure open(args[])
  45.    local f
  46.    static realfunc
  47.    initial realfunc := proc("open", 0)
  48.  
  49.    f := (realfunc ! args) | fail
  50.    if args[2] ? upto('gx') then
  51.       PSEnable(f)
  52.    return f
  53. end
  54.  
  55. procedure stop(args[])
  56.    local f
  57.    static realfunc
  58.    initial realfunc := proc("stop", 0)
  59.  
  60.    PSDone()
  61.    return realfunc ! args
  62. end
  63.  
  64. procedure exit(args[])
  65.    local f
  66.    static realfunc
  67.    initial realfunc := proc("exit", 0)
  68.  
  69.    PSDone()
  70.    return realfunc ! args
  71. end
  72.