🚀 go-pugleaf

As a semi-related response, here is my code for doing highlighting
during search and replace for 4.0 It's almost the same as the
standard, it just has some zone stuff in a few places.

(defvar *replace-style* (make-style))

(if (< 2 (number-of-colors))
  (progn
    (let
      (
	(bm
	  (or
	    (style-background-stipple *replace-style*) ;avoid duplication
	    (make-bitmap 4 4 "\167\273\335\356")
      )))
      (set-style-foreground *replace-style* (foreground))
      (set-style-background *replace-style* "red")
      (set-style-background-stipple *replace-style* bm)
  ))
  (progn
    (set-style-foreground *replace-style* (foreground))
    (set-style-background *replace-style* (background))
    (set-style-underline *replace-style* (foreground))
))

(defun perform-replace
  (from-string to-string query-flag regexp-flag delimited-flag)
  (let
    (
      (nocasify (not (and case-fold-search case-replace
	    (string-equal from-string
	      (downcase from-string)
      ))))
      (literal (not regexp-flag))
      (search-function (if regexp-flag 're-search-forward 'search-forward))
      (search-string from-string)
      (keep-going t)
      (replace-zone nil)
      (lastrepl nil))			;Position after last match considered.
    (if delimited-flag
      (setq search-function 're-search-forward
	search-string (concat "\\b"
	  (if regexp-flag from-string (regexp-quote from-string)) "\\b")))
    (push-mark)
    (push-mark)
    (unwind-protect			;for zone deletion
      (while
	(and
	  keep-going
	  (not (eobp))
	  (progn
	    (set-mark (point))
	    (funcall search-function search-string nil t)
	))
	;; Don't replace the null string 
	;; right after end of previous replacement.
	(if (eq lastrepl (point))
	  (forward-char 1)
	  (undo-boundary)
	  (if (not query-flag)
	    (replace-match to-string nocasify literal)
	    (let (done replaced)
	      (if (fboundp 'add-zone)
		(if (zonep replace-zone)
		  (move-zone replace-zone
		    (match-beginning 0) (match-end 0)
		  )
		  (setq replace-zone
		    (add-zone
		      (match-beginning 0)
		      (match-end 0)
		      *replace-style*
	      ))))
	      (while (not done)
	      ;; Preserve the match data.  Process filters and sentinels
	      ;; could run inside read-char..
		(let ((data (match-data))
		    (help-form
		      '(concat "Query replacing "
			(if regexp-flag "regexp " "")
			from-string " with " to-string ".\n\n"
			(substitute-command-keys query-replace-help))))
		  (setq char help-char)
		  (while (= char help-char)
		    (message "Query replacing %s with %s: " from-string to-string)
		    (setq char (read-char))
		    (if (= char ??)
		      (setq unread-command-char help-char char help-char)))
		  (store-match-data data))
		(cond ((or (= char ?\e)
		      (= char ?q))
		    (setq keep-going nil)
		    (setq done t))
		  ((= char ?^)
		    (goto-char (mark))
		    (setq replaced t))
		  ((or (= char ?\ )
		      (= char ?y))
		    (or replaced
		      (replace-match to-string nocasify literal))
		    (setq done t))
		  ((= char ?\.)
		    (or replaced
		      (replace-match to-string nocasify literal))
		    (setq keep-going nil)
		    (setq done t))
		  ((= char ?\,)
		    (if (not replaced)
		      (progn
			(replace-match to-string nocasify literal)
			(setq replaced t))))
		  ((= char ?!)
		    (or replaced
		      (replace-match to-string nocasify literal))
		    (setq done t query-flag nil))
		  ((or (= char ?\177)
		      (= char ?n))
		    (setq done t))
		  ((= char ?\C-l)
		    (recenter nil))
		  ((= char ?\C-r)
		    (store-match-data
		      (prog1 (match-data)
			(save-excursion (recursive-edit)))))
		  ((= char ?\C-w)
		    (delete-region (match-beginning 0) (match-end 0))
		    (store-match-data
		      (prog1 (match-data)
			(save-excursion (recursive-edit))))
		    (setq replaced t))
		  (t
		    (setq keep-going nil)
		    (setq unread-command-char char)
		    (setq done t))))))
	  (setq lastrepl (point))))
      (and
	(boundp 'epoch::version)
	(zonep replace-zone)
	(delete-zone replace-zone)
    ))
    (pop-mark)
    keep-going
))