;; This file:
;;   http://angg.twu.net/elisp/eev-peg.el.html
;;   http://angg.twu.net/elisp/eev-peg.el
;;           (find-angg "elisp/eev-peg.el")
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;;
;; "Query-replace pairs".
;;
;; (defun q () (interactive) (find-angg "elisp/eev-peg.el"))
;; (find-es "emacs" "rx")
;; (find-elnode "Rx Constructs" "(regexp EXPR)")
;; (find-angg ".emacs" "fooi")
;; (find-eev "eev-compose-hash.el")
;; (find-eev "eev-compose-hash.el" "ee-composes-do")
;; (load (buffer-file-name))


(require 'peg)

(defun find-epp-2a (obj &rest pos-spec-list)
  (find-2a nil `(find-epp ',obj ,@pos-spec-list)))

(defun find-eppm-2a (obj &rest pos-spec-list)
  (find-2a nil `(find-eppm ',obj ,@pos-spec-list)))

(defun find-pegtest (str peg)
  (find-2a nil `(progn (find-estring str) (peg-run peg))))

(defun find-pegtestm (str matcher)
  (find-2a nil `(progn (find-estring str) (eval matcher))))


;; This file needs peg.el:
;;
;;   (find-epackage-links 'peg "peg" t)
;;   (find-epackage       'peg)
;;   (code-c-d "peg" "~/.emacs.d/elpa/peg-1.0/")
;;   (find-pegfile "")
;;
;; See:
;;
;;   (find-pegfile "peg.el")
;;   (find-pegfile "peg.el" ";; Parsing Expression Grammars")
;;   (find-pegfile "peg.el" ";; Regexp equivalents:")
;;   (find-pegfile "peg.el" "(defmacro peg ")
;;   (find-pegfile "peg.el" "(defmacro peg " "Return a PEG-matcher")
;;   (find-pegfile "peg.el" "(defun peg-run ")
;;   (find-pegfile "peg.el" "(defun peg-run " "Parse with PEG-MATCHER")
;;
;; This is a PEX equivalent to the regexp "\n;; *":
;;
;;   (and "\n;;" (* " "))
;;
;; The "and" can sometimes be omitted. Try:
;;
;;                     (peg-run (peg "\n;;" (* " ")))
;;                              (peg "\n;;" (* " "))
;;                 (find-epp    (peg "\n;;" (* " ")))
;;   (find-2a nil '(find-epp    (peg "\n;;" (* " "))))
;;                 (find-epp-2a (peg "\n;;" (* " ")))
;;                 (find-epp-2a (peg "\n;;" (* " ")) "while")
;;
;;   (find-epp-2a           (peg (* (range ?a ?d))))
;;   (find-pegtest "abcdef" (peg (* (range ?a ?d))))
;;
;;
;; `ee-build-replacer'
;; ===================
;; The "replacer" associated to this list of pairs
;;
;;   (("a" "AA") ("b" "BB") ("c" "CC"))
;;
;; is a peg matcher that performs a search and replace that replaces
;; each "a" by a "AA", each "b" by a "BB", and each "c" by a "CC".
;; Replacers are easy to write using peg.el, and the replacer
;; associated to the list of pairs above is:
;;
 '    (with-peg-rules
        ((r (or (replace "a" "AA")
                (replace "b" "BB")
                (replace "c" "CC")))
         (rs (* (* (not r) (any)) r)))
	(peg-run (peg rs)))
;;
;; Try:
;;
;;   (setq mypairs '(("a" "AA") ("b" "BB") ("c" "CC")))
;;   (setq myreplacer (ee-build-replacer mypairs))
;;   (find-epp-2a  myreplacer)
;;   (find-eppm-2a myreplacer)
;;   (find-pegtestm "_a__b__c_def" myreplacer)
;;
;; Note that `myreplacer' is a sexp that starts with `with-peg-rules',
;; that is this macro:
;;
;;   (find-pegfile "peg.el" "(defmacro with-peg-rules ")
;;
;; and so we need to run it with `(eval myreplacer)', not with
;; `(peg-run myreplacer)'. Try:
;;
;;   (find-pegtest  "_a__b__c_def" myreplacer)
;;   (find-pegtestm "_a__b__c_def" myreplacer)
;;
;; The version with `find-pegtest' aborts with an "invalid function".
;;
;; ATTENTION, IMPORTANT: if you run the sexp below in this buffer
;;
;;   (eval myreplacer)
;;
;; it will replace all the "a"s, "b"s and "c"s from the end of the
;; sexp to the end of the buffer to "AA"s, "BB"s, and "CC"s - and you
;; will have to run an "undo" after running it... and this is why this
;; function `ee-replace-pairs' runs `(eval (ee-build-replacer pairs))'
;; after a narrow-to-region and inside a save-restriction.


;;



;; Test:
;; (find-epp (ee-replace-pairs-0 '(("a" "AA") ("b" "BB") ("c" "CC"))))
;;
(defun ee-build-replacer (pairs)
  "Return the replacer associated to the list of pairs PAIRS."
  (let* ((f (lambda (ab) (cons 'replace ab)))
	 (replaces (mapcar f pairs)))
    `(with-peg-rules
	 ((r  (or ,@replaces))
	  (rs (* (* (not r) (any)) r)))
       (peg-run (peg rs)))))

(defun ee-replace-pairs (pairs)
  "Replace all PAIRS in the region."
  (save-excursion
    (save-restriction
      (narrow-to-region (point) (mark))
      (goto-char (point-min))
      (eval (ee-build-replacer pairs)))))

(defun erp-test ()
  (interactive)
  (ee-replace-pairs '(("a" "AA") ("b" "BB") ("c" "CC"))))








;; Local Variables:
;; coding:  utf-8-unix
;; End: