emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH 4/5] tildify.el: Rewrite `tildify-region' and co., add foreach fu


From: Michal Nazarewicz
Subject: [PATCH 4/5] tildify.el: Rewrite `tildify-region' and co., add foreach function.
Date: Sun, 2 Mar 2014 22:55:34 +0100

From: Michal Nazarewicz <address@hidden>

Pull the loop looking for environments to ignore out of
`tildify-region' function into a new
`tildify-foreach-region-outside-env' function which takes
callback argument.  With that function, rewrite
`tildify-region' to be considerably shorter.

This also gets rid of `tildify-build-regexp' function whose
functionality is now inlined in the foreach function and
thanks to the use of `mapconcat' much shorter then
`tildify-build-regexp' has been.

Furthermore rewrite `tildify-find-env' so that it takes
pairs of regexes as an argument instead of having to look it
up in `tildify-ignored-environments-alist' each time.  Move to
use `mapconcat' also shortened the function a bit.

Lastly, rewrite `tildify-tildify' so that it returns number of
applied changes along the response.  This allows to get rid of
the `tildify-count' variable.
---
 lisp/textmodes/tildify.el | 171 +++++++++++++++++++---------------------------
 1 file changed, 72 insertions(+), 99 deletions(-)

diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 9accce8..d18721a 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 <address@hidden>
-;; Version:    4.5.3
+;;             Michal Nazarewicz <address@hidden>
+;; Version:    4.5.4
 ;; 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
@@ -203,51 +198,16 @@ See variables `tildify-pattern-alist', 
`tildify-string-alist', and
 parameters.
 This function performs no refilling of the changed text."
   (interactive "*r")
-  (setq tildify-count 0)
-  (let (a
-       z
-       (marker-end (copy-marker end))
-       end-env
-       finish
-       (ask t)
-       (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 t))
+    (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 ()
@@ -262,55 +222,67 @@ This function performs no refilling of the changed text."
 
 ;;; *** 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))
+         (beg-re (if pairs (mapconcat 'car pairs "\\|") pairs)))
+    (if (not pairs)
+        (funcall callback beg end)
+      (let ((func (lambda (b e)
+                    (let ((b (min b beg)) (e (min e beg)))
+                    (if (< b e) (funcall callback beg end) t))))
+            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))
+                            (if (re-search-forward end-re nil t)
+                                t
+                              (funcall func p end)
+                              nil)))))))))))
+
+(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
-  (if (re-search-forward regexp nil t)
-      ;; Build end-env regexp
-      (let ((match (match-string 0))
-           (alist (tildify-mode-alist tildify-ignored-environments-alist))
-           expression)
-       (save-match-data
-         (while (not (eq (string-match (caar alist) match) 0))
-           (setq alist (cdr alist))))
-       (if (stringp (setq expression (cdar alist)))
-           expression
-         (let ((result "")
-               aux)
-           (while expression
-             (setq result (concat result
-                                  (if (stringp (setq aux (car expression)))
-                                      expression
-                                    (regexp-quote (match-string aux)))))
-             (setq expression (cdr expression)))
-           result)))
-    ;; Return nil if not found
-    nil))
+  (when (re-search-forward regexp nil t)
+    ;; Find regexp pair that matched
+    (let ((match (match-string 0)))
+      (save-match-data
+        (while (not (eq (string-match (caar pairs) match) 0))
+          (setq pairs (cdr pairs)))))
+      ;; Build end-re regexp
+      (let ((expression (cdar pairs)))
+        (if (stringp expression)
+            expression
+          (mapconcat (lambda (el) (if (stringp el) el
+                                    expression
+                                    (regexp-quote (match-string el))))
+                     expression "")))))
 
 (defun tildify-tildify (beg end ask)
   "Add tilde characters in the region between BEG and END.
@@ -319,8 +291,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 +305,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 +333,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 ***
-- 
1.9.0.279.gdc9e3eb




reply via email to

[Prev in Thread] Current Thread [Next in Thread]