summaryrefslogtreecommitdiff
path: root/visual-regexp.el
blob: 7fa239d9cdf3be5f6482438710444040aadc6477 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
;;; visual-regexp.el --- A regexp/replace command for Emacs with interactive visual feedback

;; Copyright (C) 2013-2014 Marko Bencun

;; Author: Marko Bencun <mbencun@gmail.com>
;; URL: https://github.com/benma/visual-regexp.el/
;; Version: 0.8
;; Package-Requires: ((cl-lib "0.2"))
;; Keywords: regexp, replace, visual, feedback

;; This file is part of visual-regexp.

;; visual-regexp is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; visual-regexp is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with visual-regexp.  If not, see <http://www.gnu.org/licenses/>.

;;; WHAT'S NEW
;; 0.8: Error handling for vr--get-regexp-string. Bug-fixes regarding error display.
;; 0.7: Customizable separator (arrow) string and face.
;; 0.6: distinguish prompts in vr/replace, vr/query-replace, vr/mc-mark.
;; 0.5: emulate case-conversion of replace-regexp.
;; 0.4: vr/mc-mark: interface to multiple-cursors.
;; 0.3: use the same history as the regular Emacs replace commands;
;; 0.2: support for lisp expressions in the replace string, same as in (query-)replace-regexp
;; 0.1: initial release

;;; Tip Jar
;; If you found this useful, please consider donating.
;; BTC: 1BxauiLGMQPb2pavkkQkuFe5CgrGMrUat2

;;; What's This?

;; visual-regexp for Emacs is like `replace-regexp`, but with live  visual feedback directly in the buffer.
;; While constructing the regexp in the minibuffer, you get live visual feedback for the matches, including group matches.
;; While constructing the replacement in the minibuffer, you get live visual feedback for the replacements.
;; It can be used to replace all matches in one go (like `replace-regexp`), or a decision can be made on each match (like `query-replace-regexp`).
;; Thanks to Detlev Zundel for his re-builder.

;;; Where does visual-regexp come from?
;;
;; I was not happy with the way I used emacs' replace-regexp before. Constructing the regular expression is error prone and emacs' regular expressions are limited
;; (for example, no lookaheads, named groups, etc.).
;; Using re-builder to interactively build regular expressions was a step into the right direction, but manually copying over the regexp
;; to the minibuffer is cumbersome.
;; Using the idea of interactive feedback of re-builder, this package makes it possible to use just the minibuffer to construct (with live visual feedback) the regexp and replacement,
;; using Emacs style regular expressions, or optionally, regular expressions powered by other (mode modern) engines, for the replacement. For the latter part, see the package visual-regexp-steroids.

;;; Installation

;; If you are using Emacs 24, you can get visual-regexp from [melpa](http://melpa.milkbox.net/) with the package manager.
;; Add the following code to your init file. Of course you can select your own key bindings.
;; ----------------------------------------------------------
;; (add-to-list 'load-path "folder-in-which-visual-regexp-files-are-in/") ;; if the files are not already in the load path
;; (require 'visual-regexp)
;; (define-key global-map (kbd "C-c r") 'vr/replace)
;; (define-key global-map (kbd "C-c q") 'vr/query-replace)
;; ;; if you use multiple-cursors, this is for you:
;; (define-key global-map (kbd "C-c m") 'vr/mc-mark)
;; ----------------------------------------------------------
;; To customize, use `M-x customize-group [RET] visual-regexp`.

;;; Code:
(unless (fboundp 'make-overlay)
  (require 'overlay))

;; cl is used for the (loop ...) macro
(require 'cl-lib)

;;; faces

(defcustom vr/match-separator-use-custom-face nil
  "If activated, vr/match-separator-face is used to display the separator. Otherwise, use the same face as the current match."
  :type 'boolean
  :group 'visual-regexp)


(defface vr/match-separator-face
  '((((class color))
     :foreground "red"
     :bold t)
    (t
     :inverse-video t))
  "Face for the arrow between match and replacement. To use this, you must activate vr/match-separator-use-custom-face"
  :group 'visual-regexp)

(defcustom vr/match-separator-string " => "
  "This string is used to separate a match from the replacement during feedback."
  :type 'string
  :group 'visual-regexp)

(defface vr/match-0
  '((((class color) (background light))
     :background "lightblue")
    (((class color) (background dark))
     :background "steelblue4")
    (t
     :inverse-video t))
  "First face for displaying a whole match."
  :group 'visual-regexp)

(defface vr/match-1
  '((((class color) (background light))
     :background "pale turquoise")
    (((class color) (background dark))
     :background "dodgerblue4")
    (t
     :inverse-video t))
  "Second face for displaying a whole match."
  :group 'visual-regexp)

(defface vr/group-0
  '((((class color) (background light))
     :background "aquamarine")
    (((class color) (background dark))
     :background "blue3")
    (t
     :inverse-video t))
  "First face for displaying a matching group."
  :group 'visual-regexp)

(defface vr/group-1
  '((((class color) (background light))
     :background "springgreen")
    (((class color) (background dark))
     :background "chartreuse4")
    (t
     :inverse-video t))
  "Second face for displaying a matching group."
  :group 'visual-regexp)

(defface vr/group-2
  '((((min-colors 88) (class color) (background light))
     :background "yellow1")
    (((class color) (background light))
     :background "yellow")
    (((class color) (background dark))
     :background "sienna4")
    (t
     :inverse-video t))
  "Third face for displaying a matching group."
  :group 'visual-regexp)

;;; variables

(defcustom vr/auto-show-help t
  "Show help message automatically when the minibuffer is entered."
  :type 'boolean
  :group 'visual-regexp)

(defcustom vr/default-feedback-limit 50
  "Limit number of matches shown in visual feedback.
If nil, don't limit the number of matches shown in visual feedback."
  :type 'integer
  :group 'visual-regexp)

(defcustom vr/default-replace-preview nil
  "Preview of replacement activated by default? If activated, the original is not shown alongside the replacement."
  :type 'boolean
  :group 'visual-regexp)

(defcustom vr/query-replace-from-history-variable query-replace-from-history-variable
  "History list to use for the FROM argument. The default is to use the same history as Emacs' query-replace commands."
  :type 'symbol
  :group 'visual-regexp)

(defcustom vr/query-replace-to-history-variable query-replace-to-history-variable
  "History list to use for the TO argument. The default is to use the same history as Emacs' query-replace commands."
  :type 'symbol
  :group 'visual-regexp)

(defvar vr/initialize-hook nil
  "Hook called before vr/replace and vr/query-replace")

;;; private variables

(defconst vr--match-faces '(vr/match-0 vr/match-1)
  "Faces in list for convenience")

(defconst vr--group-faces '(vr/group-0 vr/group-1 vr/group-2)
  "Faces in list for convenience")

(defconst vr--overlay-priority 1001
  "Starting priority of visual-regexp overlays.")

(defvar vr--in-minibuffer nil
  "Is visual-regexp currently being used?")

(defvar vr--calling-func nil
  "Which function invoked vr--interactive-get-args?")

(defvar vr--last-minibuffer-contents nil
  "Keeping track of minibuffer changes")

(defvar vr--target-buffer-start nil
  "Starting position in target buffer.")

(defvar vr--target-buffer-end nil
  "Ending position in target buffer.")

(defvar vr--regexp-string nil
  "Entered regexp.")

(defvar vr--replace-string nil
  "Entered replacement.")

(defvar vr--feedback-limit nil
  "Feedback limit currently in use.")

(defvar vr--replace-preview nil
  "Preview of replacement activated?")

(defvar vr--target-buffer nil
  "Buffer to which visual-regexp is applied to.")

(defvar vr--overlays (make-hash-table :test 'equal)
  "Overlays used in target buffer.")

(defvar vr--visible-overlays (list)
  "Overlays currently visible.")

(defvar vr--minibuffer-message-overlay nil)

;;; keymap

(defvar vr/minibuffer-regexp-keymap
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map (kbd "C-c ?") 'vr--minibuffer-help)

    (define-key map (kbd "C-c a") 'vr--shortcut-toggle-limit)
    map)
  "Keymap used while using visual-regexp,")

(defvar vr/minibuffer-replace-keymap
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map (kbd "C-c ?") 'vr--minibuffer-help)
    (define-key map (kbd "C-c m") 'vr--shortcut-show-matches)
    (define-key map (kbd "C-c p") 'vr--shortcut-toggle-preview)

    (define-key map (kbd "C-c a") 'vr--shortcut-toggle-limit)
    map)
  "Keymap used while using visual-regexp,")

;;; helper functions

(defun vr--shortcut-show-matches ()
  (interactive)
  (vr--delete-overlay-displays)
  ;; wait for any input to redisplay replacements
  (sit-for 100000000 t)
  (vr--do-replace-feedback))

(defun vr--shortcut-toggle-preview ()
  (interactive)
  (setq vr--replace-preview (not vr--replace-preview))
  (vr--update-minibuffer-prompt)
  (vr--do-replace-feedback))

(defun vr--shortcut-toggle-limit ()
  "Toggle the limit of overlays shown (default limit / no limit)"
  (interactive)
  (if vr--feedback-limit
      (setq vr--feedback-limit nil)
    (setq vr--feedback-limit vr/default-feedback-limit))
  (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp)
         (vr--feedback))
        ((equal vr--in-minibuffer 'vr--minibuffer-replace)
         (vr--feedback t) ;; update overlays
         (vr--do-replace-feedback))))

(defun vr--get-regexp-string (&optional for-display)
  (concat (if (equal vr--in-minibuffer 'vr--minibuffer-regexp)
              (minibuffer-contents-no-properties)
            vr--regexp-string)))

(defun vr--format-error (err)
  (if (eq (car err) 'error)
      (car (cdr err))
    (format "%s" err)))

;;; minibuffer functions

(defun vr--minibuffer-set-prompt (prompt)
  "Updates minibuffer prompt. Call when minibuffer is active."
  (let ((inhibit-read-only t))
    (put-text-property (point-min) (minibuffer-prompt-end) 'display prompt)))

(defun vr--set-minibuffer-prompt-regexp ()
  (cond ((equal vr--calling-func 'vr--calling-func-query-replace)
         "Query regexp: ")
        ((equal vr--calling-func 'vr--calling-func-mc-mark)
         "Mark regexp: ")
        (t
         "Regexp: ")))

(defun vr--set-minibuffer-prompt-replace ()
  (let (prefix)
    (setq prefix (cond ((equal vr--calling-func 'vr--calling-func-query-replace)
                        "Query replace")
                       (t
                        "Replace")))

    (concat prefix
            (let ((flag-infos (mapconcat 'identity
                                         (delq nil (list (when vr--replace-preview "preview")))
                                         ", ")))
              (when (not (string= "" flag-infos ))
                (format " (%s)" flag-infos)))
            (format " %s" (vr--get-regexp-string t))
            " with: ")))

(defun vr--update-minibuffer-prompt ()
  (when (and vr--in-minibuffer (minibufferp))
    (vr--minibuffer-set-prompt
     (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp)
            (vr--set-minibuffer-prompt-regexp))
           ((equal vr--in-minibuffer 'vr--minibuffer-replace)
            (vr--set-minibuffer-prompt-replace))))))


(defun vr--minibuffer-message (message &rest args)
  "Adaptation of minibuffer-message that does not use sit-for
to make the message disappear. The problem with this was that during sit-for,
 the cursor was shown at the beginning of the message regardless of whether
 the point was actually there or not. Workaround: we let the message stay
visible all the time in the minibuffer."
  (if (not (and vr--in-minibuffer (minibufferp (current-buffer))))
      ;; fallback
      (apply 'minibuffer-message message args)
    ;; Clear out any old echo-area message to make way for our new thing.
    (message nil)
    (setq message (concat " [" message "]"))
    (when args (setq message (apply 'format message args)))
    (unless (zerop (length message))
      ;; The current C cursor code doesn't know to use the overlay's
      ;; marker's stickiness to figure out whether to place the cursor
      ;; before or after the string, so let's spoon-feed it the pos.
      (put-text-property 0 1 'cursor t message))
    (unless (overlayp vr--minibuffer-message-overlay)
      (setq vr--minibuffer-message-overlay (make-overlay (point-max) (point-max) nil t t)))
    (move-overlay vr--minibuffer-message-overlay (point-max) (point-max))
    (overlay-put vr--minibuffer-message-overlay 'after-string message)))

(defun vr/minibuffer-help-regexp ()
  (vr--minibuffer-message (format (substitute-command-keys "\\<vr/minibuffer-regexp-keymap>\\[vr--minibuffer-help]: helps \\[vr--shortcut-toggle-limit]: toggle show all"))))

(defun vr/minibuffer-help-replace ()
  (vr--minibuffer-message (format (substitute-command-keys "\\<vr/minibuffer-replace-keymap>\\[vr--minibuffer-help]: help \\[vr--shortcut-show-matches]: show matches/groups, \\[vr--shortcut-toggle-preview]: toggle preview, \\[vr--shortcut-toggle-limit]: toggle show all"))))

(defun vr--minibuffer-help ()
  (interactive)
  (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp)
         (vr/minibuffer-help-regexp))
        ((equal vr--in-minibuffer 'vr--minibuffer-replace)
         (vr/minibuffer-help-replace))))

;;; overlay functions

(defun vr--get-overlay (i j)
  "i: match index, j: submatch index"
  (let (overlay)
    (setq overlay (gethash (list i j) vr--overlays))
    (unless overlay ;; create new one if overlay does not exist yet
      (setq overlay (make-overlay 0 0))
      (if (= 0 j)
          (overlay-put overlay 'face (nth (mod i (length vr--match-faces)) vr--match-faces))
        (overlay-put overlay 'face (nth (mod j (length vr--group-faces)) vr--group-faces)))
      (overlay-put overlay 'priority (+ vr--overlay-priority (if (= j 0) 0 1)))
      (overlay-put overlay 'vr-ij (list i j))
      (puthash (list i j) overlay vr--overlays))
    overlay))

(defun vr--delete-overlays ()
  "Delete all visible overlays."
  (mapc (lambda (overlay)
          (delete-overlay overlay))
        vr--visible-overlays)
  (setq vr--visible-overlays (list)))

(defun vr--delete-overlay-display (overlay)
  (overlay-put overlay 'display nil)
  (overlay-put overlay 'after-string nil)
  (overlay-put overlay 'priority vr--overlay-priority))

(defun vr--delete-overlay-displays ()
  "Delete the display of all visible overlays. Call before vr--delete-overlays."
  (mapc (lambda (overlay)
          (cl-multiple-value-bind (i j) (overlay-get overlay 'vr-ij)
            (when (= 0 j)
              (vr--delete-overlay-display overlay))))
        vr--visible-overlays))

;;; hooks

(defun vr--update (beg end len)
  (when (and vr--in-minibuffer (minibufferp))
    ;; minibuffer-up temporarily deletes minibuffer contents before inserting new one.
    ;; don't do anything then as the messages shown by visual-regexp are irritating while browsing the history.
    (unless (and (string= "" (minibuffer-contents-no-properties))
                 (equal last-command 'previous-history-element))
      ;; do something when minibuffer contents changes
      (unless (string= vr--last-minibuffer-contents (minibuffer-contents-no-properties))
        (setq vr--last-minibuffer-contents (minibuffer-contents-no-properties))
        ;; minibuffer contents has changed, update visual feedback.
        ;; not using after-change-hook because this hook applies to the whole minibuffer, including minibuffer-messages
        ;; that disappear after a while.
        (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp)
               (vr--feedback))
              ((equal vr--in-minibuffer 'vr--minibuffer-replace)
               (vr--do-replace-feedback)))))))
(add-hook 'after-change-functions 'vr--update)

(defun vr--minibuffer-setup ()
  "Setup prompt and help when entering minibuffer."
  (when vr--in-minibuffer
    (progn
      (vr--update-minibuffer-prompt)
      (when vr/auto-show-help (vr--minibuffer-help)))))
(add-hook 'minibuffer-setup-hook 'vr--minibuffer-setup)

;;; helper functions

(defun vr--target-window ()
  (if vr--target-buffer
      (get-buffer-window vr--target-buffer)
    nil))

(defun vr--compose-messages (&rest msgs)
  (mapconcat 'identity (delq nil (mapcar (lambda (msg) (if (or (not msg) (string= "" msg)) nil msg)) msgs)) " - "))

;;; show feedback functions
(defun vr--feedback-function (forward feedback-limit callback)
  "Feedback function for emacs-style regexp search"
  (let ((message-line "")
        (err))
    (with-current-buffer vr--target-buffer
      (save-excursion
        (goto-char (if forward vr--target-buffer-start vr--target-buffer-end))
        (let ((i 0)
              (looping t))
          (while (and looping
                      (condition-case err
                          (if forward
                              (re-search-forward regexp-string vr--target-buffer-end t)
                            (re-search-backward regexp-string vr--target-buffer-start t))
                        (invalid-regexp (progn (setq message-line (car (cdr err))) nil))))
            (when (or (not feedback-limit) (< i feedback-limit)) ;; let outer loop finish so we can get the matches count
              (cl-loop for (start end) on (match-data) by 'cddr
                       for j from 0
                       when (and start end)
                       do
                       (funcall callback i j start end)))
            (when (= (match-beginning 0) (match-end 0))
              (cond ;; don't get stuck on zero-width matches
               ((and forward (> vr--target-buffer-end (point))) (forward-char))
               ((and (not forward) (< vr--target-buffer-start (point))) (backward-char))
               (t (setq looping nil))))
            (setq i (1+ i)))
          (if (string= "" message-line)
              (setq message-line (format "%s matches" i))))))
    message-line))

(defun vr--feedback-match-callback (i j begin end)
  (with-current-buffer vr--target-buffer
    (save-excursion
      (when (= 0 i) ;; make first match visible
        (with-selected-window (vr--target-window)
          (goto-char end)))
      (let ((overlay (vr--get-overlay i j)))
        (move-overlay overlay begin end vr--target-buffer)
        (if (and (= 0 j) (= begin end)) ;; empty match; indicate by a pipe
            (overlay-put overlay 'after-string (propertize "|" 'face (nth (mod i (length vr--match-faces)) vr--match-faces) 'help-echo "empty match"))
          (overlay-put overlay 'after-string nil))
        (setq vr--visible-overlays (cons overlay vr--visible-overlays)))
      ;; mark if we have reached the specified feedback limit
      (when (and vr--feedback-limit (= vr--feedback-limit (1+ i)) )
        (setq limit-reached t)))))

(defun vr--feedback (&optional inhibit-message)
  "Show visual feedback for matches."
  (vr--delete-overlays)
  (let ((limit-reached nil)
        message-line)
    (setq message-line
          (let ((regexp-string))
            (condition-case err
                (progn
                  (setq regexp-string (vr--get-regexp-string))
                  (vr--feedback-function t vr--feedback-limit 'vr--feedback-match-callback))
              (error (car (cdr err))))))
    (unless inhibit-message
      (let ((msg (vr--compose-messages message-line (when limit-reached (format "%s matches shown, hit C-c a to show all" vr--feedback-limit)))))
        (unless (string= "" msg)
          (vr--minibuffer-message msg))))))

(defun vr--get-replacement (replacement match-data i)
  (with-current-buffer vr--target-buffer
    (let*
        ;; emulate case-conversion of (perform-replace)
        ((case-fold-search (if (and case-fold-search search-upper-case)
                               (ignore-errors (isearch-no-upper-case-p (vr--get-regexp-string) t))
                             case-fold-search))
         (nocasify (not (and case-replace case-fold-search))))
      ;; we need to set the match data again, s.t. match-substitute-replacement works correctly. 
      ;; (match-data) could have been modified in the meantime, e.g. by vr--get-regexp-string->pcre-to-elisp.
      (set-match-data match-data)
      (if (stringp replacement)
          (match-substitute-replacement replacement nocasify)
        (match-substitute-replacement (funcall (car replacement) (cdr replacement) i) nocasify)))))

(defun vr--do-replace-feedback-match-callback (replacement match-data i)
  (let ((begin (cl-first match-data))
        (end (cl-second match-data))
        (replacement (vr--get-replacement replacement match-data i)))
    (let* ((overlay (vr--get-overlay i 0))
           (empty-match (= begin end)))
      (move-overlay overlay begin end vr--target-buffer)
      (vr--delete-overlay-display overlay)
      (let ((current-face (nth (mod i (length vr--match-faces)) vr--match-faces)))
        (if (or empty-match vr--replace-preview)
            (progn
              (overlay-put overlay (if empty-match 'after-string 'display) (propertize replacement 'face current-face))
              (overlay-put overlay 'priority (+ vr--overlay-priority 2)))
          (progn
            (overlay-put overlay 'after-string
                         (concat (propertize vr/match-separator-string 'face
                                             (if vr/match-separator-use-custom-face
                                                 'vr/match-separator-face
                                               current-face))
                                 (propertize replacement 'face current-face)))
            (overlay-put overlay 'priority (+ vr--overlay-priority 0))))))))

(defun vr--get-replacements (feedback feedback-limit)
  "Get replacements using emacs-style regexp."
  (let ((regexp-string)
        (message-line "")
        (i 0)
        (limit-reached nil)
        (replacements (list))
        (err)
        (buffer-contents (with-current-buffer vr--target-buffer
                           (buffer-substring-no-properties (point-min) (point-max)))))

    (condition-case err
        (progn
          ;; can signal invalid-regexp
          (setq regexp-string (vr--get-regexp-string))

          (with-current-buffer vr--target-buffer
            (goto-char vr--target-buffer-start)
            (let ((looping t))
              (while (and
                      looping
                      (condition-case err
                          (re-search-forward regexp-string vr--target-buffer-end t)
                        ('invalid-regexp (progn (setq message-line (car (cdr err))) nil))))
                (condition-case err
                    (progn
                      (if (or (not feedback) (not feedback-limit) (< i feedback-limit))
                          (setq replacements (cons
                                              (let ((match-data (mapcar 'marker-position (match-data))))
                                                (list (query-replace-compile-replacement replace-string t) match-data i))
                                              replacements))
                        (setq limit-reached t))
                      (when (= (match-beginning 0) (match-end 0))
                        (if (> vr--target-buffer-end (point))
                            (forward-char) ;; don't get stuck on zero-width matches
                          (setq looping nil)))
                      (setq i (1+ i)))
                  ('error (progn
                            (setq message-line (vr--format-error err))
                            (setq replacements (list))
                            (setq looping nil))))))))
      (invalid-regexp (setq message-line (car (cdr err))))
      (error (setq message-line (car (cdr err)))))
    (if feedback
        (if (string= "" message-line)
            (setq message-line (vr--compose-messages (format "%s matches" i) (when limit-reached (format "%s matches shown, hit C-c a to show all" feedback-limit)))))
      (setq message-line (format "replaced %d matches" i)))
    (list replacements message-line)))

(defun vr--do-replace-feedback ()
  "Show visual feedback for replacements."
  (vr--feedback t) ;; only really needed when regexp has not been changed from default (=> no overlays have been created)
  (let ((replace-string (minibuffer-contents-no-properties)))
    (cl-multiple-value-bind (replacements message-line) (vr--get-replacements t vr--feedback-limit)
      ;; visual feedback for matches
      (condition-case err
          (mapc (lambda (replacement-info) (apply 'vr--do-replace-feedback-match-callback replacement-info)) replacements)
        ('error (setq message-line (vr--format-error err))))
      (unless (string= "" message-line)
        (vr--minibuffer-message message-line)))))

;;; vr/replace

(defun vr--do-replace (&optional silent)
  "Replace matches."
  (vr--delete-overlay-displays)
  (vr--delete-overlays)
  (let ((replace-string vr--replace-string))
    (cl-multiple-value-bind (replacements message-line) (vr--get-replacements nil nil)
      (let ((replace-count 0)
            (cumulative-offset 0)
            last-match-data)
        (cl-loop for replacement-info in replacements
                 for counter from 0 do
                 (setq replace-count (1+ replace-count))
                 (cl-multiple-value-bind (replacement match-data i) replacement-info
                   ;; replace match
                   (let* ((replacement (vr--get-replacement replacement match-data i))
                          (begin (cl-first match-data))
                          (end (cl-second match-data)))
                     (with-current-buffer vr--target-buffer
                       (save-excursion
                         ;; first insert, then delete
                         ;; this ensures that if we had an active region before, the replaced match is still part of the region
                         (goto-char begin)
                         (insert replacement)
                         (setq cumulative-offset (+ cumulative-offset (- (point) end)))
                         (delete-char (- end begin))))
                     (when (= 0 counter)
                       (setq last-match-data match-data))
                     )))
        (unless (or silent (string= "" message-line))
          (vr--minibuffer-message message-line))
        ;; needed to correctly position the mark after query replace (finished with 'automatic ('!'))
        (set-match-data (mapcar (lambda (el) (+ cumulative-offset el)) last-match-data))
        replace-count))))

(defun vr--interactive-get-args (mode calling-func)
  "Get interactive args for the vr/replace and vr/query-replace functions."
  (unwind-protect
      (progn
        (let ((buffer-read-only t)) ;; make target buffer
          (when vr--in-minibuffer (error "visual-regexp already in use."))
          (setq vr--calling-func calling-func)
          (setq vr--target-buffer (current-buffer))
          (setq vr--target-buffer-start (if (region-active-p)
                                            (region-beginning)
                                          (point)))
          (setq vr--target-buffer-end (if (region-active-p)
                                          (region-end)
                                        (point-max)))

          (run-hooks 'vr/initialize-hook)
          (setq vr--feedback-limit vr/default-feedback-limit)

          (setq vr--replace-preview vr/default-replace-preview)

          (save-excursion
            ;; deactivate mark so that we can see our faces instead of region-face.
            (deactivate-mark)
            (progn
              (setq vr--in-minibuffer 'vr--minibuffer-regexp)
              (setq vr--last-minibuffer-contents "")
              (setq vr--regexp-string
                    (read-from-minibuffer
                     " " ;; prompt will be  set in vr--minibuffer-setup
                     nil vr/minibuffer-regexp-keymap
                     nil vr/query-replace-from-history-variable))
              ;;(setq vr--regexp-string (format "%s%s" (vr--get-regexp-modifiers-prefix) vr--regexp-string))

              (when (equal mode 'vr--mode-regexp-replace)
                (setq vr--in-minibuffer 'vr--minibuffer-replace)
                (setq vr--last-minibuffer-contents "")
                (setq vr--replace-string
                      (read-from-minibuffer
                       " " ;; prompt will be  set in vr--minibuffer-setup
                       nil vr/minibuffer-replace-keymap
                       nil vr/query-replace-to-history-variable)))))
          ;; Successfully got the args, deactivate mark now. If the command was aborted (C-g), the mark (region) would remain active.
          (deactivate-mark)
          (cond ((equal mode 'vr--mode-regexp-replace)
                 (list vr--regexp-string
                       vr--replace-string
                       vr--target-buffer-start
                       vr--target-buffer-end))
                ((equal mode 'vr--mode-regexp)
                 (list vr--regexp-string
                       vr--target-buffer-start
                       vr--target-buffer-end)))))
    (progn ;; execute on finish
      (setq vr--in-minibuffer nil)
      (setq vr--calling-func nil)
      (unless (overlayp vr--minibuffer-message-overlay)
        (delete-overlay vr--minibuffer-message-overlay))
      (vr--delete-overlay-displays)
      (vr--delete-overlays))))

(add-hook 'multiple-cursors-mode-enabled-hook
          ;; run vr/mc-mark once per cursor by default (do not ask the user)
          (lambda ()
            (when (boundp 'mc--default-cmds-to-run-once)
              (add-to-list 'mc--default-cmds-to-run-once 'vr/mc-mark))))

;;;###autoload
(defun vr/mc-mark (regexp start end)
  "Convert regexp selection to multiple cursors."
  (require 'multiple-cursors)
  (interactive
   (vr--interactive-get-args 'vr--mode-regexp 'vr--calling-func-mc-mark))
  (with-current-buffer vr--target-buffer
    (mc/remove-fake-cursors)
    (activate-mark)
    (let ((regexp-string (vr--get-regexp-string))
          ;; disable deactivating of mark after buffer-editing commands
          ;; (which happens for example in visual-regexp-steroids/vr--parse-matches
          ;; during the callback).
          (deactivate-mark nil)
          (first-fake-cursor nil))
      (vr--feedback-function t nil (lambda (i j begin end)
                                     (with-current-buffer vr--target-buffer
                                       (goto-char end)
                                       (push-mark begin)
                                       ;; temporarily enable transient mark mode
                                       (activate-mark)
                                       (let ((fc (mc/create-fake-cursor-at-point)))
                                         (unless first-fake-cursor
                                           (setq first-fake-cursor fc))))))

      ;; one fake cursor too many, replace first one with
      ;; the regular cursor.
      (when first-fake-cursor
        (mc/pop-state-from-overlay first-fake-cursor)))
    (mc/maybe-multiple-cursors-mode)))

;;;###autoload
(defun vr/replace (regexp replace start end)
  "Regexp-replace with live visual feedback."
  (interactive
   (vr--interactive-get-args 'vr--mode-regexp-replace 'vr--calling-func-replace))
  (unwind-protect
      (progn
        (when vr--in-minibuffer (error "visual-regexp already in use."))
        (setq vr--target-buffer (current-buffer)
              vr--target-buffer-start start
              vr--target-buffer-end end
              vr--regexp-string regexp
              vr--replace-string replace)
        ;; do replacement
        (vr--do-replace))
    ;; execute on finish
    (setq vr--in-minibuffer nil)))

;; query-replace-regexp starts here

(defvar vr--query-replacements nil)
;; we redefine the help text from replace.el to remove the commands we don't support.

(defconst vr--query-replace-help
  "Type Space or `y' to replace one match, Delete or `n' to skip to next,
RET or `q' to exit, Period to replace one match and exit,
Comma to replace but not move point immediately,
p to preview the replacement (like 'C-c p' during construction of the regexp),
C-r [not supported in visual-regexp],
C-w [not supported in visual-regexp],
C-l to clear the screen, redisplay, and offer same replacement again,
! to replace all remaining matches with no more questions,
^ [not supported in visual-regexp],
E [not supported in visual-regexp]"
  "Help message while in `vr/query-replace'.")

(defvar vr--query-replace-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map query-replace-map)
    ;; the following replace.el commands are not supported by visual-regexp.
    (define-key map "e" nil)
    (define-key map "E" nil)
    (define-key map "\C-r" nil)
    (define-key map "\C-w" nil)
    (define-key map "^" nil)
    (define-key map "p" 'toggle-preview)
    map
    ))

;;;###autoload
(defun vr/query-replace (regexp replace start end)
  "Use vr/query-replace like you would use query-replace-regexp."
  (interactive
   (vr--interactive-get-args 'vr--mode-regexp-replace 'vr--calling-func-query-replace))
  (unwind-protect
      (progn
        (when vr--in-minibuffer (error "visual-regexp already in use."))
        (setq vr--target-buffer (current-buffer)
              vr--target-buffer-start start
              vr--target-buffer-end end
              vr--regexp-string regexp
              vr--replace-string replace)
        (let ((replace-string vr--replace-string))
          (setq vr--query-replacements (nreverse (car (vr--get-replacements nil nil)))))
        (vr--perform-query-replace regexp nil))
    ;; execute on finish
    (setq vr--in-minibuffer nil)))

(defun vr--perform-query-replace (from-string &optional map)
  ;; This function is a heavily modified version of (perform-replace) from replace.el.
  ;; The original plan was to use the original perform-replace, but various issues stood in the way.
  (or map (setq map vr--query-replace-map))
  (and minibuffer-auto-raise
       (raise-frame (window-frame (minibuffer-window))))
  (let* ((next-replacement nil) ;; replacement string for current match
         (keep-going t)
         (replace-count 0)
         ;; a match can be replaced by a longer/shorter replacement. cumulate the difference
         (cumulative-offset 0)
         (recenter-last-op nil) ; Start cycling order with initial position.
         (message
          (apply 'propertize
                 (substitute-command-keys
                  "Query replacing %s with %s: (\\<vr--query-replace-map>\\[help] for help) ")
                 minibuffer-prompt-properties)))

    ;; show visual feedback for all matches
    (mapc (lambda (replacement-info)
            (cl-multiple-value-bind (replacement match-data i) replacement-info
              (vr--feedback-match-callback i 0 (cl-first match-data) (cl-second match-data))))
          vr--query-replacements)

    (goto-char vr--target-buffer-start)
    (push-mark)
    (undo-boundary)
    (unwind-protect
        ;; Loop finding occurrences that perhaps should be replaced.
        (while (and keep-going vr--query-replacements)
          ;; Advance replacement list
          (cl-multiple-value-bind (replacement match-data i) (car vr--query-replacements)
            (setq match-data (mapcar (lambda (el) (+ cumulative-offset el)) match-data))
            (let ((begin (cl-first match-data))
                  (end (cl-second match-data)))
              (setq next-replacement-orig replacement)
              (setq next-replacement (vr--get-replacement replacement match-data replace-count))
              (goto-char begin)
              (setq vr--query-replacements (cdr vr--query-replacements))

              ;; default for new occurrence: no preview
              (setq vr--replace-preview nil)

              (undo-boundary)
              (let (done replaced key def)
                ;; Loop reading commands until one of them sets done,
                ;; which means it has finished handling this
                ;; occurrence.
                (while (not done)
                  ;; show replacement feedback for current occurrence
                  (unless replaced
                    (vr--do-replace-feedback-match-callback next-replacement-orig match-data i))
                  ;; Bind message-log-max so we don't fill up the message log
                  ;; with a bunch of identical messages.
                  (let ((message-log-max nil))
                    (message message from-string next-replacement))
                  (setq key (read-event))
                  (setq key (vector key))
                  (setq def (lookup-key map key))

                  ;; can use replace-match afterwards
                  (set-match-data match-data)

                  ;; Restore the match data while we process the command.
                  (cond ((eq def 'help)
                         (with-output-to-temp-buffer "*Help*"
                           (princ
                            (concat "Query replacing visual-regexp "
                                    from-string " with "
                                    next-replacement ".\n\n"
                                    (substitute-command-keys
                                     vr--query-replace-help)))
                           (with-current-buffer standard-output
                             (help-mode))))
                        ((eq def 'exit)
                         (setq keep-going nil
                               done t))
                        ((eq def 'act)
                         (unless replaced
                           (replace-match next-replacement t t)
                           (setq replace-count (1+ replace-count)))
                         (setq done t
                               replaced t))
                        ((eq def 'act-and-exit)
                         (unless replaced
                           (replace-match next-replacement t t)
                           (setq replace-count (1+ replace-count)))
                         (setq keep-going nil
                               done t
                               replaced t))
                        ((eq def 'act-and-show)
                         (unless replaced
                           (replace-match next-replacement t t)
                           (setq replace-count (1+ replace-count))
                           (setq replaced t)))
                        ((eq def 'toggle-preview)
                         (setq vr--replace-preview (not vr--replace-preview)))
                        ((eq def 'automatic)
                         (setq vr--target-buffer-start (match-beginning 0)
                               vr--target-buffer-end (+ cumulative-offset vr--target-buffer-end))
                         (setq replace-count (+ replace-count (vr--do-replace t)))
                         (setq done t
                               replaced t
                               keep-going nil))
                        ((eq def 'skip)
                         (setq done t))
                        ((eq def 'recenter)
                         ;; `this-command' has the value `query-replace',
                         ;; so we need to bind it to `recenter-top-bottom'
                         ;; to allow it to detect a sequence of `C-l'.
                         (let ((this-command 'recenter-top-bottom)
                               (last-command 'recenter-top-bottom))
                           (recenter-top-bottom)))
                        (t
                         (setq this-command 'mode-exited)
                         (setq keep-going nil)
                         (setq unread-command-events
                               (append (listify-key-sequence key)
                                       unread-command-events))
                         (setq done t)))
                  (when replaced
                    (setq cumulative-offset (+ cumulative-offset (- (length next-replacement) (- end begin)))))
                  (unless (eq def 'recenter)
                    ;; Reset recenter cycling order to initial position.
                    (setq recenter-last-op nil))
                  ;; in case of 'act-and-show: delete overlay display or it will still be
                  ;; visible even though the replacement has been made
                  (when replaced (vr--delete-overlay-display (vr--get-overlay i 0)))))

              ;; occurrence has been handled
              ;; delete feedback overlay
              (delete-overlay (vr--get-overlay i 0)))))

      ;; unwind
      (progn
        (vr--delete-overlay-displays)
        (vr--delete-overlays)
        ;; (replace-dehighlight)
        ))
    (unless unread-command-events
      ;; point is set to the end of the last occurrence.
      (goto-char (match-end 0))
      (message "Replaced %d occurrence%s"
               replace-count
               (if (= replace-count 1) "" "s")))))

(provide 'visual-regexp)

;;; visual-regexp.el ends here