#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH
;;Skeleton of a typical klone script

(setq args (getopts "USAGE: %0 [options] files...
Fixes framemaker postscript files in place so that they can be printed on any
printer.
files can be compressed (.gz suffixes)
Without files, behaves as a unix filter
Nothing is done if not needed
"
    ("-v" () verbose "verbose operation")
))

(setq re (regcomp "[/]FMAllowPaperSizeMismatch[ \t]+(false)[ \t]+def"))

(defun main (&aux
  )
  (if args
    (dolist (file args)
      (catch 'Done (fix-frame-in-place file))
    )
    (fix-frame-filter)
  )
)

(defun fix-frame-filter (&aux 
    line
    (bufsize 1000000)
  )
  (catch 'EOF (catch 'Done 
      (dotimes 32000 
	(setq line (read-line))
	(if (regexec re line)
	  (write-line "/FMAllowPaperSizeMismatch            true def")
	  (write-line line)
      ))
      (while t (write-chars (read-chars bufsize)))
)))
  
(defun fix-frame-in-place (file &aux
    (fd (open file :error ()))
    (pos 0)
    (lnum 1)
    modpos
    ufile
    fixdone
  )
  (verbose? "processing file %0..." file)
  (catch 'Done
    (if (not fd)
      (throw 'Done (PF *stderr* "Cannot find/open file %0\n" file))
    )
    (if (setq ufile (match "^(.*)[.]gz$" file 1)) (progn ;; gzip file
	(verbose? "uncompressing %0" file)
	(wait (system (list "gzip" "-d" file)))
	(setq file ufile)
    ))
    (setq fd (open file :error () :direction :io :if-exists :overwrite))
    (if (not fd)
      (throw 'Done (PF *stderr* "Cannot open file %0 for writing\n" file))
    )
    (catch 'EOF (dotimes 32000
	(setq line (read-line fd))
	(if (regexec re line) (progn
	    (setq modpos (+ pos (get (get re 1) 0)))
	    (file-position fd modpos)
	    (print-format fd "true ")
	    (flush fd)
	    (file-position fd (+ pos (length line)))
	    (print-format 
	      "%0: fixed at line %1, FMAllowPaperSizeMismatch allowed\n" 
	      file lnum
	    )
	    (setq fixdone t)
	    (throw 'Done)
	))
	(incf pos (+ 1 (length line)))
	(incf lnum)
    ))  
  )
  (if (not fixdone)
    (verbose? "no need to fix %0" file)
  )
  (if ufile (progn
      (verbose? "recompressing %0" ufile)
      (wait (system (list "gzip" "-9" ufile)))
  ))
)

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***

