;;; acdw-re.el -*- lexical-binding: t; coding: utf-8-unix -*-
;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
;; Created: 2021-04-29
;; Keywords: configuration
;; URL: https://tildegit.org/acdw/emacs

;; This file is NOT part of GNU Emacs.

;;; License:
;; Everyone is permitted to do whatever with this software, without
;; limitation.  This software comes without any warranty whatsoever,
;; but with two pieces of advice:
;; - Don't hurt yourself.
;; - Make good choices.

;;; Commentary:
;; Pulled mostly from karthinks:
;; https://karthinks.com/software/bridging-islands-in-emacs-1/

;; UPDATED CODE:
;; https://github.com/karthink/.emacs.d/blob/master/init.el#L981
;; https://github.com/karthink/.emacs.d/blob/master/lisp/reb-fix.el

;;; Code:

(require 're-builder)

(defvar my/re-builder-positions nil
  "Store point and region bounds before calling `re-builder'.")

(defun my/re-builder-save-state (&rest _)
  "Save the point and region before calling `re-builder'."
  (setq my/re-builder-positions
        (cons (point)
              (when (region-active-p)
                (list (region-beginning)
                      (region-end))))))

(defun reb-replace-regexp (&optional delimited)
  "Run `query-replace-regexp' with the contents of `re-builder'.
With non-nil optional argument DELIMITED, only replace matches
surrounded by word boundaries."
  (interactive "P")
  (reb-update-regexp)
  (let* ((re (reb-target-binding reb-regexp))
         (replacement (query-replace-read-to
                       re
                       (concat "Query replace"
                               (if current-prefix-arg
                                   (if (eq current-prefix-arg '-)
                                       " backward"
                                     " word")
                                 "")
                               " regexp"
                               (if (with-selected-window reb-target-window
                                     (region-active-p))
                                   " in region"
                                 ""))
                       t))
         (pnt (car my/re-builder-positions))
         (beg (cadr my/re-builder-positions))
         (end (caddr my/re-builder-positions)))
    (with-selected-window reb-target-window
      (goto-char (or pnt 0))
      (setq my/re-builder-positions nil)
      (reb-quit)
      (query-replace-regexp re replacement delimited beg end))))

;; Restrict re-builder matches to region

(defun reb-update-overlays (&optional subexp)
  "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
  (let* ((re (reb-target-binding reb-regexp))
         (subexps (reb-count-subexps re))
         (matches 0)
         (submatches 0)
         firstmatch
         here
         start end
         firstmatch-after-here)
    (with-current-buffer reb-target-buffer
      (setq here
            (if reb-target-window
                (with-selected-window reb-target-window (window-point))
              (point))
            start
            (if (region-active-p)
                (nth 1 my/re-builder-positions)
              (nth 0 my/re-builder-positions))
            end
            (if (region-active-p)
                (nth 2 my/re-builder-positions)
              (point-max)))
      (reb-delete-overlays)
      (goto-char (or start 0))
      (while (and (not (eobp))
                  (re-search-forward re end t)
                  (or (not reb-auto-match-limit)
                      (< matches reb-auto-match-limit)))
        (when (and (= 0 (length (match-string 0)))
                   (not (eobp)))
          (forward-char 1))
        (let ((i 0)
              suffix max-suffix)
          (setq matches (1+ matches))
          (while (<= i subexps)
            (when (and (or (not subexp) (= subexp i))
                       (match-beginning i))
              (let ((overlay (make-overlay (match-beginning i)
                                           (match-end i)))
                    ;; When we have exceeded the number of provided faces,
                    ;; cycle thru them where `max-suffix' denotes the maximum
                    ;; suffix for `reb-match-*' that has been defined and
                    ;; `suffix' the suffix calculated for the current match.
                    (face
                     (cond
                      (max-suffix
                       (if (= suffix max-suffix)
                           (setq suffix 1)
                         (setq suffix (1+ suffix)))
                       (intern-soft (format "reb-match-%d" suffix)))
                      ((intern-soft (format "reb-match-%d" i)))
                      ((setq max-suffix (1- i))
                       (setq suffix 1)
                       ;; `reb-match-1' must exist.
                       'reb-match-1))))
                (unless firstmatch (setq firstmatch (match-data)))
                (unless firstmatch-after-here
                  (when (> (point) here)
                    (setq firstmatch-after-here (match-data))))
                (setq reb-overlays (cons overlay reb-overlays)
                      submatches (1+ submatches))
                (overlay-put overlay 'face face)
                (overlay-put overlay 'priority i)))
            (setq i (1+ i))))))
    (let ((count (if subexp submatches matches)))
      (message "%s %smatch%s%s"
               (if (= 0 count) "No" (int-to-string count))
               (if subexp "subexpression " "")
               (if (= 1 count) "" "es")
               (if (and reb-auto-match-limit
                        (= reb-auto-match-limit count))
                   " (limit reached)" "")))
    (when firstmatch
      (store-match-data (or firstmatch-after-here firstmatch))
      (reb-show-subexp (or subexp 0)))))

(provide 'acdw-re)

;;; acdw-re.el ends here