#!/usr/local/bin/klone

(defun main ()
  (setq files (getopts "replace-strings [options] -f file files...
Klonifies wool files. With no files, filter."
      ("-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)) (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 files
    (dolist (file files)
      (setq fd-in (open file))
      (setq fd-out (open (+ file ".BAK")
	  :direction :output :if-exists :supersede)
      )
      (do-replacements fd-in fd-out)
      (sh mv ,(+ file ".BAK") ,file)
    )
    (do-replacements *standard-input* *standard-output*)
  )    
)

(defun do-replacements (in out &aux
    (buffer (String in))		;gobble buffer
    (fds (if scriptexprs scriptexprs-list (read (open scriptfile
	:type (if scriptexpr :string :file)
    ))))
  )
  (if verbose (print-format *standard-error* "Replacing: %r0\n" fds))
  (dohash (from to fds)
    (replace-word buffer from to)
  )
  (write-string buffer out)
)

;; 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
    Verbose:once
    n
    to-string
    (minusminus (lambda (n1 n2) (- n2 n1)))
  )
  (if verbose (print-format *standard-error* "Replacing %r0 by %r1\n" from to))
  (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 (progn (setq Verbose:once t)
	(print-format *standard-error* "%0, " 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)
    (setq offset (+ point (length to-string)))
  )
  (if Verbose (if Verbose:once (print-format *standard-error* "\n")
      (print-format *standard-error* "   ... no occurences found\n")
  ))
)

(main)

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