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

(defun main ()
  (setq files (getopts "replace-strings [options] -f file files...
Replaces strings in files in place. With no files, filter."
;;--------------------------------------------------------------------
      ("-s" () simple-mode simple mode: syntax: 
replace-strings [options] regexp replacement-string files...
The regexp is given with the klone syntax, and the replacement
string will have \1, \2, \3 expansed into the subparts of the 
matched regexp. e.g:
replace-string 'Part(0-9]).uue' 'Part0\1.uue' 
makes: Part2.uue into Part02.uue)
      ("-S" () Simple-mode super simple mode: syntax: 
replace-strings [options] string replacement-string files...
This is like -s, but with fixed strings, but is able to work on binary files.
Other modes stop at the first null byte encountered in the files)
      ("-f" file scriptfile "the script file containing the plist of replacements
a plist of key regexp and value string or plist of strings
eg.:
    (\"[Ff]oo\" (\"Foo\" \"Bar\" \"foo\" \"bar\"))")
      ("-e" expr scriptexprs "replacement pairs of a scriptfile but online
    -e '(\"[Ff]oo\" (\"Foo\" \"Bar\" \"foo\" \"bar\"))'" :multiple t)
      ("-v" () verbose "verbose operation")
      ("-V" () Verbose "more verbose operation")
  ))

  (if Verbose (setq verbose t))

  (if (not (or scriptexprs scriptfile simple-mode Simple-mode)) (progn
      (print-format "replace-strings needs a script file given by -f. -help for help\n")
      (exit 1)
  ))

  (setq scriptexprs-list (list))
  (if scriptexprs (dolist (se scriptexprs)
      (setq r (read (open se :type :string)))
      (put scriptexprs-list -1 (get r 0))
      (put scriptexprs-list -1 (get r 1))
    )
  )
  (if simple-mode (with (
	re (0 files)
	remp (1 files)
      )
      (if (or (not (typep re String)) (not (typep remp String)))
	(fatal-error 1 "replace-strings -s needs a regexp and a remplacement string arguments!\n")
      )
      (setq simple-mode:re (regcomp re))
      (setq simple-mode:remp remp)
      (setq files (subseq files 2))
    )
    Simple-mode (with (
	re (0 files)
	remp (1 files)
      )
      (if (or (not (typep re String)) (not (typep remp String)))
	(fatal-error 1 "replace-strings -S needs a string and a remplacement string arguments!\n")
      )
      (setq simple-mode:re re)
      (setq simple-mode:remp remp)
      (setq files (subseq files 2))
    )
  )

  (if files
    (dolist (file files)
      (setq fd-in (open file))
      (do-replacements (setq filebuffer (String fd-in)))
      (if (/= 0 replace-string:count)
	(verbose? "in file %1: %0 replacement%2 done" replace-string:count 
	  file (if (= 1 replace-string:count) "" "s"))
      )
      (when (/= 0 replace-string:count) 
	(if (not (setq fd-out (open file 
	    :direction :output :if-exists :supersede :error ()))
	  )
	  (fatal-error 1 
	    "replace-strings: cannot write modifications to file %0\n" file)
	)
	(write filebuffer fd-out)
	(close fd-out)
      )
    )
    (do-replacements (setq filebuffer (String *standard-input*)))
    (if (/= 0 replace-string:count)
      (verbose? "%0 replacement%1 done" replace-string:count
	(if (= 1 replace-string:count) "" "s")
      )
    )
    (write filebuffer *standard-output*)
  )    
)

(defun do-replacements (buffer &aux
  )
  (if 
    simple-mode
    (replace-string buffer simple-mode:re simple-mode:remp :all t)
    
    Simple-mode
    (replace-fixed-string buffer simple-mode:re simple-mode:remp)

    (with (fds (if scriptexprs scriptexprs-list (read (open scriptfile
	:type (if scriptexprs :string :file)
      ))))
      (dohash (from to fds)
	(replace-word buffer from to))
    )
  )
)

;; replace-word
;; in buffer all occurences of from (or 1rst pattern) to to. "to" can be a
;; - string:  from is replaced by to
;; - vector:  from is searched in to which must be a plist for the replacement
;; - other:   is applyied to from, must return the to value

(defun replace-word (buffer from to &aux
    (offset 0)
    (re (regcomp from))
    match-level
    point
    n
    to-string
    (minusminus (lambda (n1 n2) (- n2 n1)))
  )
  (setq replace-string:count 0)
  (while (regexec re buffer offset)
					; match found
    (setq match-level (if (get re 1 ()) 1 0))
    (setq point (getn (getn re match-level) 0))
    (if Verbose (print-format *standard-error* "  at %0\n" point))
    (if (typep to String)
      (setq to-string to)
      (typep to List)
      (setq to-string
	(get to (regsub re match-level) '(regsub re match-level)))
      (setq to-string (apply to (regsub re match-level)))
    )
    (setq n (- (length to-string) (apply minusminus (get re match-level))))
    (if (> n 0)
      (insert buffer point (make-string n))
      (< n 0)
      (dotimes (N (- n)) (delete buffer point))
    )
    (put buffer point to-string)
    (incf replace-string:count)
    (setq offset (+ point (length to-string)))
  )
)

(defun replace-fixed-string (buffer s r &aux
    (offset 0)
    point
    (n (- (length r) (length s)))
    (nr (length r))
    (occurences 0)
  )
  (setq replace-string:count 0)
  (while (setq point (seek buffer s offset))
    (if Verbose (print-format *standard-error* "  at %0\n" point))
    (if (> n 0)
      (insert buffer point (make-string n))
      (< n 0)
      (dotimes (- n) (delete buffer point))
    )
    (put buffer point r)
    (incf offset nr)
    (incf replace-string:count)
  )
)

(main)

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