152 lines
5.8 KiB
EmacsLisp
152 lines
5.8 KiB
EmacsLisp
;;; 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
|