+++ /dev/null
-;;; visual-regexp.el --- A regexp/replace command for Emacs with interactive visual feedback
-
-;; Copyright (C) 2013-2015 Marko Bencun
-
-;; Author: Marko Bencun <mbencunNOSPAMgmail.com>
-;; URL: https://github.com/benma/visual-regexp.el/
-;; Package-Version: 20150329.954
-;; 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 (vr--format-error 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 (vr--format-error 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
--- /dev/null
+;;; visual-regexp.el --- A regexp/replace command for Emacs with interactive visual feedback
+
+;; Copyright (C) 2013-2017 Marko Bencun
+
+;; Author: Marko Bencun <mbencunNOSPAMgmail.com>
+;; URL: https://github.com/benma/visual-regexp.el/
+;; Package-Version: 20170301.116
+;; Version: 1.1
+;; 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
+;; 1.1: Add new customization: vr/plain
+;; 1.0: Add support for one prompt for search/replace, using query-replace-from-to-separator
+;; (query-replace history like in Emacs 25).
+;; Breaking changes:
+;; - vr/minibuffer-(regexp|replace)-keymap have been collapsed to vr/minibuffer-keymap
+;; - vr/minibuffer-help-(regexp|replace) have been replaced by vr--minibuffer-help-text
+;; 0.9: Fix warnings regarding free variables.
+;; 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](https://melpa.org/) 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)
+
+;; For Emacs < 25.0, this variable is not yet defined.
+;; Copy pasted from Emacs 25.0 replace.el.
+(unless (boundp 'query-replace-from-to-separator)
+ (defcustom query-replace-from-to-separator
+ (propertize (if (char-displayable-p ?→) " → " " -> ")
+ 'face 'minibuffer-prompt)
+ "String that separates FROM and TO in the history of replacement pairs."
+ ;; Avoids error when attempt to autoload char-displayable-p fails
+ ;; while preparing to dump, also stops customize-rogue listing this.
+ :initialize 'custom-initialize-delay
+ :type 'sexp))
+
+(defcustom vr/match-separator-string
+ (progn
+ (custom-reevaluate-setting 'query-replace-from-to-separator)
+ (substring-no-properties query-replace-from-to-separator))
+ "This string is used to separate a match from the replacement during feedback."
+ :type 'sexp
+ :initialize 'custom-initialize-delay
+ :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)
+
+(setq vr--is-emacs24 (version< emacs-version "25"))
+
+(defvar vr--query-replace-defaults nil
+ "Same as query-replace-defaults from Emacs 25, for compatibility with Emacs 24.")
+
+(defcustom vr/query-replace-defaults-variable
+ (if vr--is-emacs24
+ 'vr--query-replace-defaults
+ 'query-replace-defaults)
+ "History of search/replace pairs"
+ :type 'symbol
+ :group 'visual-regexp)
+
+
+(defcustom vr/plain nil
+ "If non-nil, use plain search/replace instead of regexp search/replace."
+ :type 'boolean
+ :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--limit-reached)
+
+(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-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)
+ (define-key map (kbd "C-c p") 'vr--shortcut-toggle-preview)
+ map)
+ "Keymap used while using visual-regexp,")
+
+;;; helper functions
+
+(defun vr--shortcut-toggle-preview ()
+ (interactive)
+ (when (vr--in-replace)
+ (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))
+ (vr--show-feedback))
+
+(defun vr--get-regexp-string-full ()
+ (if (equal vr--in-minibuffer 'vr--minibuffer-regexp)
+ (minibuffer-contents)
+ vr--regexp-string))
+
+(defun vr--query-replace--split-string (string)
+ "Copy/paste of query-replace--split-string, removing the assertion."
+ (let* ((length (length string))
+ (split-pos (text-property-any 0 length 'separator t string)))
+ (if (not split-pos)
+ (substring-no-properties string)
+ (cons (substring-no-properties string 0 split-pos)
+ (substring-no-properties string (1+ split-pos) length)))))
+
+(defun vr--in-from ()
+ "Returns t if the we are in the regexp prompt. Returns nil if we are in the replace prompt. Call only if (and vr--in-minibuffer (minibufferp))"
+ (equal vr--in-minibuffer 'vr--minibuffer-regexp))
+
+(defun vr--in-replace ()
+ "Returns t if we are either in the replace prompt, or in the regexp prompt containing a replacement (separated by vr/match-separator-string)"
+ (or (not (vr--in-from))
+ (consp (vr--query-replace--split-string (vr--get-regexp-string-full)))))
+
+(defun vr--get-regexp-string (&optional for-display)
+ (let ((split (vr--query-replace--split-string (vr--get-regexp-string-full))))
+ (if (consp split) (car split) split)))
+
+(defun vr--get-replace-string ()
+ (if (equal vr--in-minibuffer 'vr--minibuffer-replace)
+ (minibuffer-contents-no-properties)
+ (let ((split (vr--query-replace--split-string (vr--get-regexp-string-full))))
+ (if (consp split) (cdr split) vr--replace-string))))
+
+(defun vr--format-error (err)
+ (if (eq (car err) 'error)
+ (car (cdr err))
+ (format "%s" err)))
+
+;;; minibuffer functions
+
+(defun vr--set-minibuffer-prompt ()
+ (let ((prompt (cond ((equal vr--calling-func 'vr--calling-func-query-replace)
+ "Query replace")
+ ((equal vr--calling-func 'vr--calling-func-mc-mark)
+ "Mark")
+ (t
+ "Replace"))))
+ (when (and (vr--in-replace) vr--replace-preview)
+ (setq prompt (concat prompt " (preview)")))
+ (when (not (vr--in-from))
+ (setq prompt (concat prompt " " (vr--get-regexp-string t))))
+ (setq prompt (concat prompt (if (vr--in-from) ": " " with: ")))
+ prompt))
+
+(defun vr--update-minibuffer-prompt ()
+ (when (and vr--in-minibuffer (minibufferp))
+ (let ((inhibit-read-only t)
+ (prompt (vr--set-minibuffer-prompt)))
+ (put-text-property (point-min) (minibuffer-prompt-end) 'display prompt))))
+
+
+(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-text ()
+ (let ((help ""))
+ (setq help (concat help (substitute-command-keys "\\<vr/minibuffer-keymap>\\[vr--minibuffer-help]: help, \\[vr--shortcut-toggle-limit]: toggle show all, \\[previous-history-element]: previous")))
+ (when (vr--in-replace)
+ (setq help (concat help (substitute-command-keys ", \\[vr--shortcut-toggle-preview]: toggle preview"))))
+ help
+ ))
+
+(defun vr--minibuffer-help ()
+ (interactive)
+ (vr--minibuffer-message (vr--minibuffer-help-text)))
+
+;;; 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--show-feedback ()
+ (if (vr--in-replace)
+ (vr--do-replace-feedback)
+ (vr--feedback)))
+
+(defun vr--after-change (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.
+ (vr--update-minibuffer-prompt)
+ (vr--show-feedback)))))
+(add-hook 'after-change-functions 'vr--after-change)
+
+(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 (regexp-string 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
+ (funcall (if vr/plain 'search-forward 're-search-forward) regexp-string vr--target-buffer-end t)
+ (funcall (if vr/plain 'search-backward '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 vr--limit-reached t)))))
+
+(defun vr--feedback (&optional inhibit-message)
+ "Show visual feedback for matches."
+ (vr--delete-overlays)
+ (setq vr--limit-reached nil)
+ (let (message-line)
+ (setq message-line
+ (condition-case err
+ (progn
+ (vr--feedback-function (vr--get-regexp-string) t vr--feedback-limit 'vr--feedback-match-callback))
+ (error (vr--format-error err))))
+ (unless inhibit-message
+ (let ((msg (vr--compose-messages message-line (when vr--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 vr/plain)
+ (match-substitute-replacement (funcall (car replacement) (cdr replacement) i) nocasify vr/plain)))))
+
+(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--mapcar-nonnil (rep list)
+ (mapcar (lambda (it) (when it (funcall rep it))) list))
+
+(defun vr--get-replacements (feedback feedback-limit)
+ "Get replacements using emacs-style regexp."
+ (setq vr--limit-reached nil)
+ (let ((regexp-string)
+ (replace-string (vr--get-replace-string))
+ (message-line "")
+ (i 0)
+ (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
+ (funcall (if vr/plain 'search-forward '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 (vr--mapcar-nonnil 'marker-position (match-data))))
+ (list (query-replace-compile-replacement replace-string t) match-data i))
+ replacements))
+ (setq vr--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 (vr--format-error err))))
+ (if feedback
+ (if (string= "" message-line)
+ (setq message-line (vr--compose-messages (format "%s matches" i) (when vr--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)
+ (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)
+ (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 (vr--mapcar-nonnil (lambda (el) (+ cumulative-offset el)) last-match-data))
+ replace-count)))
+
+(defun vr--set-target-buffer-start-end ()
+ (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))))
+
+(defun vr--set-regexp-string ()
+ (save-excursion
+ ;; deactivate mark so that we can see our faces instead of region-face.
+ (deactivate-mark)
+ (setq vr--in-minibuffer 'vr--minibuffer-regexp)
+ (setq vr--last-minibuffer-contents "")
+ (custom-reevaluate-setting 'vr/match-separator-string)
+ (let* ((minibuffer-allow-text-properties t)
+ (history-add-new-input nil)
+ (text-property-default-nonsticky
+ (cons '(separator . t) text-property-default-nonsticky))
+ ;; seperator and query-replace-from-to-history copy/pasted from replace.el
+ (separator
+ (when vr/match-separator-string
+ (propertize "\0"
+ 'display vr/match-separator-string
+ 'separator t)))
+ (query-replace-from-to-history
+ (append
+ (when separator
+ (mapcar (lambda (from-to)
+ (concat (query-replace-descr (car from-to))
+ separator
+ (query-replace-descr (cdr from-to))))
+ (symbol-value vr/query-replace-defaults-variable)))
+ (symbol-value vr/query-replace-from-history-variable))))
+ (setq vr--regexp-string
+ (read-from-minibuffer
+ " " ;; prompt will be set in vr--minibuffer-setup
+ nil vr/minibuffer-keymap
+ nil 'query-replace-from-to-history))
+ (let ((split (vr--query-replace--split-string vr--regexp-string)))
+ (if (not (consp split))
+ (add-to-history vr/query-replace-from-history-variable vr--regexp-string nil t)
+ (add-to-history vr/query-replace-from-history-variable (car split) nil t)
+ (add-to-history vr/query-replace-to-history-variable (cdr split) nil t)
+ (add-to-history vr/query-replace-defaults-variable split nil t))))))
+
+(defun vr--set-replace-string ()
+ (save-excursion
+ ;; deactivate mark so that we can see our faces instead of region-face.
+ (deactivate-mark)
+ (let ((split (vr--query-replace--split-string vr--regexp-string)))
+ (unless (consp split)
+ (setq vr--in-minibuffer 'vr--minibuffer-replace)
+ (setq vr--last-minibuffer-contents "")
+ (let ((history-add-new-input nil))
+ (setq vr--replace-string
+ (read-from-minibuffer
+ " " ;; prompt will be set in vr--minibuffer-setup
+ nil vr/minibuffer-keymap
+ nil vr/query-replace-to-history-variable))
+ (add-to-history vr/query-replace-to-history-variable vr--replace-string nil t)
+ (add-to-history vr/query-replace-defaults-variable (cons vr--regexp-string vr--replace-string)))))))
+
+(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))
+ (vr--set-target-buffer-start-end)
+
+ (run-hooks 'vr/initialize-hook)
+ (setq vr--feedback-limit vr/default-feedback-limit)
+
+ (setq vr--replace-preview vr/default-replace-preview)
+
+ (vr--set-regexp-string)
+ (when (equal mode 'vr--mode-regexp-replace)
+ (vr--set-replace-string))
+
+ ;; 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 (;; 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 (vr--get-regexp-string) t nil (lambda (i j begin end)
+ (when (zerop j)
+ (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)
+ (vr--perform-query-replace))
+ ;; execute on finish
+ (setq vr--in-minibuffer nil)))
+
+(defun vr--perform-query-replace ()
+ ;; 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.
+ (and minibuffer-auto-raise
+ (raise-frame (window-frame (minibuffer-window))))
+ (let* ((from-string (vr--get-regexp-string))
+ (map vr--query-replace-map)
+ (vr--query-replacements (nreverse (car (vr--get-replacements nil nil))))
+ (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
+ (concat
+ (propertize "Replacing " 'read-only t)
+ (propertize "%s" 'read-only t 'face 'font-lock-keyword-face)
+ (propertize " with " 'read-only t)
+ (propertize "%s" 'read-only t 'face 'font-lock-keyword-face)
+ (propertize (substitute-command-keys
+ " (\\<vr--query-replace-map>\\[help] for help) ")
+ 'read-only t))))
+
+ ;; 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 (vr--mapcar-nonnil (lambda (el) (+ cumulative-offset el)) match-data))
+ (let ((begin (cl-first match-data))
+ (end (cl-second match-data))
+ (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
projects / emacsconfig.git / commitdiff