bug#17699: [PATCH 6/7] tildify.el: Rewrite `tildify-region' and co., add foreach function.

[Michal Nazarewicz <mina86@mina86.com>]

* lisp/textmodes/tildify.el (tildify-foreach-region-outside-env): New
function which calls a callback on portions of the buffer that are
outside of ignored environments.
(tildify-build-regexp): Remove function since it is now
incorporated in `tildify-foreach-region-outside-env' where it is
optimised and simplified by the use of `mapconcat'.
(tildify-tildify): Return number of substitutions made so that…
(tildify-count): …can be removed.
(tildify-find-env): Accept a new PAIRS argument which was
previously looked up in `tildify-ignored-environments-alist' each
time the function was called.  With this change, the lookup is
performed only once in `tildify-foreach-region-outside-env'.
(tildify-region): Greatly simplify the function since now most of
the work is done by `tildify-foreach-region-outside-env'.
(tildify-mode-alist): Simplify slightly by avoiding if and setq
and instead using or.

* tests/automated/tildify-tests.el (tildify-test-find-env-end-re-bug)
(tildify-test-find-env-group-index-bug): Update to support new
signature of the `tildify-foreach-region-outside-env' function.
Namely, it now takes pairs as an argument instead of looking it up in
`tildify-ignored-environments-alist'.
---
 lisp/ChangeLog                  |  17 +++++
 lisp/textmodes/tildify.el       | 145 +++++++++++++++++-----------------------
 test/ChangeLog                  |   6 ++
 test/automated/tildify-tests.el |  17 +++--
 4 files changed, 92 insertions(+), 93 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0351d54..075a424 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,22 @@
 2014-06-05  Michal Nazarewicz  <mina86@mina86.com>
 
+	* textmodes/tildify.el (tildify-foreach-region-outside-env): New
+	function which calls a callback on portions of the buffer that are
+	outside of ignored environments.
+	(tildify-build-regexp): Remove function since it is now
+	incorporated in `tildify-foreach-region-outside-env' where it is
+	optimised and simplified by the use of `mapconcat'.
+	(tildify-tildify): Return number of substitutions made so that…
+	(tildify-count): …can be removed.
+	(tildify-find-env): Accept a new PAIRS argument which was
+	previously looked up in `tildify-ignored-environments-alist' each
+	time the function was called.  With this change, the lookup is
+	performed only once in `tildify-foreach-region-outside-env'.
+	(tildify-region): Greatly simplify the function since now most of
+	the work is done by `tildify-foreach-region-outside-env'.
+	(tildify-mode-alist): Simplify slightly by avoiding if and setq
+	and instead using or.
+
 	* textmodes/tildify.el (tildify-ignored-environments-alist):
 	Optimise environments regexes
 
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 39ccad7..50fee2f 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -3,7 +3,8 @@
 ;; Copyright (C) 1997-2014 Free Software Foundation, Inc.
 
 ;; Author:     Milan Zamazal <pdm@zamazal.org>
-;; Version:    4.5.2
+;;             Michal Nazarewicz <mina86@mina86.com>
+;; Version:    4.5.3
 ;; Keywords:   text, TeX, SGML, wp
 
 ;; This file is part of GNU Emacs.
@@ -187,12 +188,6 @@ END-REGEX defines end of the corresponding text part and can be either:
                  (symbol :tag "Like other")))))
 
 
-;;; *** Internal variables ***
-
-(defvar tildify-count nil
-  "Counter for replacements.")
-
-
 ;;; *** Interactive functions ***
 
 ;;;###autoload
@@ -205,51 +200,16 @@ This function performs no refilling of the changed text.
 If DONT-ASK is set, or called interactively with prefix argument, user
 won't be prompted for confirmation of each substitution."
   (interactive "*rP")
-  (setq tildify-count 0)
-  (let (a
-	z
-	(marker-end (copy-marker end))
-	end-env
-	finish
-	(ask (not dont-ask))
-	(case-fold-search nil)
-	(regexp (tildify-build-regexp))	; beginnings of environments
-	aux)
-    (if regexp
-	;; Yes, ignored environments exist for the current major mode,
-	;; tildify just texts outside them
-	(save-excursion
-	  (save-restriction
-	    (widen)
-	    (goto-char (point-min))
-	    (while (not finish)
-	      (setq a (point))
-	      (setq end-env (tildify-find-env regexp))
-	      (setq z (copy-marker (if end-env (1- (point)) (point-max))))
-	      (if (>= (marker-position z) beg)
-		  (progn
-		    (or (>= a beg) (setq a beg))
-		    (or (<= (marker-position z) (marker-position marker-end))
-			(setq z marker-end))
-		    (setq aux (tildify-tildify a (marker-position z) ask))
-		    (if (eq aux 'force)
-			(setq ask nil)
-		      (if (eq aux nil)
-			  (setq finish t)))))
-	      (if (>= (marker-position z) (marker-position marker-end))
-		  (setq finish t))
-	      (or (>= (point) (marker-position z))
-		  (goto-char (marker-position z)))
-	      (if (not finish)
-		  (if (re-search-forward end-env nil t)
-		      (if (> (point) (marker-position marker-end))
-			  (setq finish t))
-		    (message
-		     "End of environment not found: %s" end-env)
-		    (setq finish t))))))
-      ;; No ignored environments, tildify directly
-      (tildify-tildify beg end ask)))
-  (message "%d spaces replaced." tildify-count))
+  (let (case-fold-search (count 0) (ask (not dont-ask)))
+    (tildify-foreach-region-outside-env beg end
+      (lambda (beg end)
+        (let ((aux (tildify-tildify beg end ask)))
+          (setq count (+ count (car aux)))
+          (if (not (eq (cdr aux) 'force))
+              (cdr aux)
+            (setq ask nil)
+            t))))
+    (message "%d spaces replaced." count)))
 
 ;;;###autoload
 (defun tildify-buffer (&optional dont-ask)
@@ -266,42 +226,58 @@ won't be prompted for confirmation of each substitution."
 
 ;;; *** Auxiliary functions ***
 
-(defun tildify-build-regexp ()
-  "Build start of environment regexp."
-  (let ((alist (tildify-mode-alist tildify-ignored-environments-alist))
-	regexp)
-    (when alist
-      (setq regexp (caar alist))
-      (setq alist (cdr alist))
-      (while alist
-	(setq regexp (concat regexp "\\|" (caar alist)))
-	(setq alist (cdr alist)))
-      regexp)))
-
 (defun tildify-mode-alist (mode-alist &optional mode)
   "Return alist item for the MODE-ALIST in the current major MODE."
-  (if (null mode)
-      (setq mode major-mode))
-  (let ((alist (cdr (or (assoc mode mode-alist)
+  (let ((alist (cdr (or (assoc (or mode major-mode) mode-alist)
 			(assoc t mode-alist)))))
     (if (and alist
 	     (symbolp alist))
 	(tildify-mode-alist mode-alist alist)
       alist)))
 
-(defun tildify-find-env (regexp)
+(defun tildify-foreach-region-outside-env (beg end callback)
+  "Scan region from BEG to END calling CALLBACK on portions out of environments.
+Call CALLBACK on each region outside of environment to ignore.
+CALLBACK will only be called for regions which have intersection
+with [BEG END].  It must be a function that takes two point
+arguments specifying the region to operate on.  Stop scanning the
+region as soon as CALLBACK returns nil.  Environments to ignore
+are determined from `tildify-ignored-environments-alist'."
+  (declare (indent 2))
+  (let ((pairs (tildify-mode-alist tildify-ignored-environments-alist)))
+    (if (not pairs)
+        (funcall callback beg end)
+      (let ((func (lambda (b e)
+                    (let ((b (max b beg)) (e (min e end)))
+                    (if (< b e) (funcall callback b e) t))))
+            (beg-re (concat "\\(?:"
+                            (mapconcat 'car pairs "\\)\\|\\(?:")
+                            "\\)"))
+            p end-re)
+        (save-excursion
+          (save-restriction
+            (widen)
+            (goto-char (point-min))
+            (while (and (< (setq p (point)) end)
+                        (if (not (setq end-re
+                                       (tildify-find-env beg-re pairs)))
+                            (progn (funcall func p end) nil)
+                          (funcall func p (match-beginning 0))
+                          (when (< (point) end)
+                            (setq p (point))
+                            (re-search-forward end-re nil t)))))))))))
+
+(defun tildify-find-env (regexp pairs)
   "Find environment using REGEXP.
-Return regexp for the end of the environment or nil if no environment was
-found."
+Return regexp for the end of the environment found in PAIRS or nil if
+no environment was found."
   ;; Find environment
   (when (re-search-forward regexp nil t)
     (save-match-data
-      ;; Build end-env regexp
-      (let ((match (match-string 0))
-            (alist (tildify-mode-alist tildify-ignored-environments-alist)))
-        (while (not (eq (string-match (caar alist) match) 0))
-          (setq alist (cdr alist)))
-        (let ((expression (cdar alist)))
+      (let ((match (match-string 0)))
+        (while (not (eq (string-match (caar pairs) match) 0))
+          (setq pairs (cdr pairs)))
+        (let ((expression (cdar pairs)))
           (if (stringp expression)
               expression
             (mapconcat
@@ -319,8 +295,9 @@ macros.
 
 If ASK is nil, perform replace without asking user for confirmation.
 
-Returns one of symbols: t (all right), nil (quit), force (replace without
-further questions)."
+Returns (count . response) cons where count is number of string
+replacements done and response is one of symbols: t (all right), nil
+(quit), force (replace without further questions)."
   (save-excursion
     (goto-char beg)
     (let* ((alist (tildify-mode-alist tildify-pattern-alist))
@@ -332,7 +309,8 @@ further questions)."
 	   bad-answer
 	   replace
 	   quit
-	   (message-log-max nil))
+	   (message-log-max nil)
+	   (count 0))
       (while (and (not quit)
 		  (re-search-forward regexp (marker-position end-marker) t))
 	(when (or (not ask)
@@ -359,12 +337,11 @@ further questions)."
 		      (setq bad-answer t)))
 		    replace))
 	  (replace-match tilde t t nil match-number)
-	  (setq tildify-count (1+ tildify-count))))
+	  (setq count (1+ count))))
       ;; Return value
-      (cond
-       (quit nil)
-       ((not ask) 'force)
-       (t t)))))
+      (cons count (cond (quit nil)
+                        ((not ask) 'force)
+                        (t t))))))
 
 
 ;;; *** Announce ***
diff --git a/test/ChangeLog b/test/ChangeLog
index 38a4feb..6248d6c 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,11 @@
 2014-06-05  Michal Nazarewicz  <mina86@mina86.com>
 
+	* automated/tildify-tests.el (tildify-test-find-env-end-re-bug)
+	(tildify-test-find-env-group-index-bug): Update to support new
+	signature of the `tildify-foreach-region-outside-env' function.
+	Namely, it now takes pairs as an argument instead of looking it up in
+	`tildify-ignored-environments-alist'.
+
 	* automated/tildify-tests.el (tildify-test--example-html): Add support
 	for generating XML code, so that…
 	(tildify-test-xml) …test can be added to check handling of XML
diff --git a/test/automated/tildify-tests.el b/test/automated/tildify-tests.el
index dd404fc..cf18320 100644
--- a/test/automated/tildify-tests.el
+++ b/test/automated/tildify-tests.el
@@ -114,23 +114,22 @@ latter is missing, SENTENCE will be used in all placeholder positions."
 (ert-deftest tildify-test-find-env-end-re-bug ()
     "Tests generation of end-regex using mix of indexes and strings"
   (with-temp-buffer
-    (let ((tildify-ignored-environments-alist
-           `((,major-mode ("foo\\|bar" . ("end-" 0))))))
-      (insert "foo whatever end-foo")
-      (goto-char (point-min))
-      (should (string-equal "end-foo" (tildify-find-env "foo\\|bar"))))))
+    (insert "foo whatever end-foo")
+    (goto-char (point-min))
+    (should (string-equal "end-foo"
+                          (tildify-find-env "foo\\|bar"
+                                            '(("foo\\|bar" . ("end-" 0))))))))
 
 
 (ert-deftest tildify-test-find-env-group-index-bug ()
     "Tests generation of match-string indexes"
   (with-temp-buffer
-    (let ((tildify-ignored-environments-alist
-           `((,major-mode ("start-\\(foo\\|bar\\)" . ("end-" 1))
-                          ("open-\\(foo\\|bar\\)" . ("close-" 1)))))
+    (let ((pairs '(("start-\\(foo\\|bar\\)" . ("end-" 1))
+                   ("open-\\(foo\\|bar\\)" . ("close-" 1))))
           (beg-re "start-\\(foo\\|bar\\)\\|open-\\(foo\\|bar\\)"))
       (insert "open-foo whatever close-foo")
       (goto-char (point-min))
-      (should (string-equal "close-foo" (tildify-find-env beg-re))))))
+      (should (string-equal "close-foo" (tildify-find-env beg-re pairs))))))
 
 
 (provide 'tildify-tests)
-- 
2.0.0.526.g5318336