about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-re.el109
1 files changed, 94 insertions, 15 deletions
diff --git a/lisp/acdw-re.el b/lisp/acdw-re.el index 1fc0a9c..eff61e1 100644 --- a/lisp/acdw-re.el +++ b/lisp/acdw-re.el
@@ -23,21 +23,22 @@
23 23
24;;; Code: 24;;; Code:
25 25
26(defvar acdw/re-builder-positions nil 26(require 're-builder)
27 "Store point and region bounds before calling re-builder")
28 27
29(defun acdw/re-builder-save-state (&rest _) 28(defvar my/re-builder-positions nil
30 "Save into `acdw/re-builder-positions' the point and region 29 "Store point and region bounds before calling `re-builder'.")
31positions before calling `re-builder'." 30
32 (setq acdw/re-builder-positions 31(defun my/re-builder-save-state (&rest _)
32 "Save the point and region before calling `re-builder'."
33 (setq my/re-builder-positions
33 (cons (point) 34 (cons (point)
34 (when (region-active-p) 35 (when (region-active-p)
35 (list (region-beginning) 36 (list (region-beginning)
36 (region-end)))))) 37 (region-end))))))
37 38
38(defun reb-replace-regexp (&optional delimited) 39(defun reb-replace-regexp (&optional delimited)
39 "Run `query-replace-regexp' with the contents of re-builder. With 40 "Run `query-replace-regexp' with the contents of `re-builder'.
40non-nil optional argument DELIMITED, only replace matches 41With non-nil optional argument DELIMITED, only replace matches
41surrounded by word boundaries." 42surrounded by word boundaries."
42 (interactive "P") 43 (interactive "P")
43 (reb-update-regexp) 44 (reb-update-regexp)
@@ -56,17 +57,95 @@ surrounded by word boundaries."
56 " in region" 57 " in region"
57 "")) 58 ""))
58 t)) 59 t))
59 (pnt (car acdw/re-builder-positions)) 60 (pnt (car my/re-builder-positions))
60 (beg (cadr acdw/re-builder-positions)) 61 (beg (cadr my/re-builder-positions))
61 (end (caddr acdw/re-builder-positions))) 62 (end (caddr my/re-builder-positions)))
62 (with-selected-window reb-target-window 63 (with-selected-window reb-target-window
63 ;; replace with (goto-char (match-beginning 0)) if you want to control 64 (goto-char (or pnt 0))
64 ;; where in the buffer the replacement starts with re-builder 65 (setq my/re-builder-positions nil)
65 (goto-char pnt)
66 (setq acdw/re-builder-positions nil)
67 (reb-quit) 66 (reb-quit)
68 (query-replace-regexp re replacement delimited beg end)))) 67 (query-replace-regexp re replacement delimited beg end))))
69 68
69;; Restrict re-builder matches to region
70
71(defun reb-update-overlays (&optional subexp)
72 "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
73If SUBEXP is non-nil mark only the corresponding sub-expressions."
74 (let* ((re (reb-target-binding reb-regexp))
75 (subexps (reb-count-subexps re))
76 (matches 0)
77 (submatches 0)
78 firstmatch
79 here
80 start end
81 firstmatch-after-here)
82 (with-current-buffer reb-target-buffer
83 (setq here
84 (if reb-target-window
85 (with-selected-window reb-target-window (window-point))
86 (point))
87 start
88 (if (region-active-p)
89 (nth 1 my/re-builder-positions)
90 (nth 0 my/re-builder-positions))
91 end
92 (if (region-active-p)
93 (nth 2 my/re-builder-positions)
94 (point-max)))
95 (reb-delete-overlays)
96 (goto-char (or start 0))
97 (while (and (not (eobp))
98 (re-search-forward re end t)
99 (or (not reb-auto-match-limit)
100 (< matches reb-auto-match-limit)))
101 (when (and (= 0 (length (match-string 0)))
102 (not (eobp)))
103 (forward-char 1))
104 (let ((i 0)
105 suffix max-suffix)
106 (setq matches (1+ matches))
107 (while (<= i subexps)
108 (when (and (or (not subexp) (= subexp i))
109 (match-beginning i))
110 (let ((overlay (make-overlay (match-beginning i)
111 (match-end i)))
112 ;; When we have exceeded the number of provided faces,
113 ;; cycle thru them where `max-suffix' denotes the maximum
114 ;; suffix for `reb-match-*' that has been defined and
115 ;; `suffix' the suffix calculated for the current match.
116 (face
117 (cond
118 (max-suffix
119 (if (= suffix max-suffix)
120 (setq suffix 1)
121 (setq suffix (1+ suffix)))
122 (intern-soft (format "reb-match-%d" suffix)))
123 ((intern-soft (format "reb-match-%d" i)))
124 ((setq max-suffix (1- i))
125 (setq suffix 1)
126 ;; `reb-match-1' must exist.
127 'reb-match-1))))
128 (unless firstmatch (setq firstmatch (match-data)))
129 (unless firstmatch-after-here
130 (when (> (point) here)
131 (setq firstmatch-after-here (match-data))))
132 (setq reb-overlays (cons overlay reb-overlays)
133 submatches (1+ submatches))
134 (overlay-put overlay 'face face)
135 (overlay-put overlay 'priority i)))
136 (setq i (1+ i))))))
137 (let ((count (if subexp submatches matches)))
138 (message "%s %smatch%s%s"
139 (if (= 0 count) "No" (int-to-string count))
140 (if subexp "subexpression " "")
141 (if (= 1 count) "" "es")
142 (if (and reb-auto-match-limit
143 (= reb-auto-match-limit count))
144 " (limit reached)" "")))
145 (when firstmatch
146 (store-match-data (or firstmatch-after-here firstmatch))
147 (reb-show-subexp (or subexp 0)))))
148
70(provide 'acdw-re) 149(provide 'acdw-re)
71 150
72;;; acdw-re.el ends here 151;;; acdw-re.el ends here