Build a "with-query-replace-description" macro

Question

In the company where I work we use Emacs as the default editor for the LaTeX copy-editing tasks and we share some Emacs scripts to automate/guide some operations.

Actually I need to perform some query-replacements into the LaTeX code and to make my colleagues aware of the purpose of these replacements. To do this I use this kind of functions in my scripts:

(query-replace-with-info "foo"
                         "bar"
                         "This replacement is appropriate in the following cases..."
                         nil (point-min) (point-max))

making Emacs behave like in the following figure:

To build my query-replace-with-info function I hacked the perform-replace function in this way: https://pastebin.com/79y7PKP7

The problem with this is that I cannot easily mantain the code if perform-replace will be updated in newer Emacs versions.

So I'd like to write a macro in this form:

(with-query-replace-description
 "This replacement is appropriate in the following cases..."
 (query-replace "foo"
                "bar"
               nil (point-min) (point-max)))

The description could be displayed in a temp-buffer.

Any suggestions?

Info added

I added an extra argument INFO-STRING to the original perform-replace function:

(defun perform-replace-with-info (from-string replacements
                          query-flag regexp-flag INFO-STRING  delimited-flag
                          &optional repeat-count map start end backward region-noncontiguous-p)
...

and, in the let arguments, I added:

(info-string (if INFO-STRING
              (propertize
               (concat INFO-STRING "\n\n")
               'face '(:foreground "goldenrod"
                           ;; :background "DarkGoldenrod1"
                           ))
            ;; *ELSE*
            ""))

Finally I modified the original message argument in the let args, this way:

(message
          (if query-flag
          (concat ; <-- The magic
           info-string ; <--
           (apply 'propertize
              (substitute-command-keys
               "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
              minibuffer-prompt-properties)))))

Can this be done with the advice tecnique suggested by Drew in the comments? (I just read that advice could be evil... please ignore this last question.)

Answer 1

Use advice only in the last resort. Preferred approaches, in order:

1. Hooks. Many Emacs operations allow you to add your own functions to be called in response to events triggered by those operations: before-save-hook, after-save-hook, etc etc.

2. Failing that, write your own command that "decorates" the original command, adding behavior before or after a call to the original (or both).

3. If the change you want cannot be achieved thus, for example, if the change you want needs to occur within the body of the original command, then copy, rename and modify the original's code (or use advice, see below).

4. If you really need system-wide, ongoing, transparent replacement of the original, you can instead copy and modify without renaming, but there are big problems, one of which you have noted, that your changes may break a future version. It has to be your responsibility to make sure that this doesn't happen.

5. Advice. It seems like a miracle cure for all ills, but it also has its own problems. Its transparency can be a problem as well as a benefit, since other users (or you after a few months) may not know/remember it is there. Keep it very, very simple, clean and uncluttered.

Answer 2

I've been successfully using this solution for quite some time now:

(defmacro with-interactive-tasks-explanation (MESSAGE &rest body)
  "It allows displaying, in a dedicated buffer resized to the
necessary minimum, instructions, tips, and clarifications on the
interactive operations present within the macro body."
  (declare (indent 1))
  `(let* ((message-buffer-name "*INTERACTIVE TASKS EXPLANATION*")
          (message-buffer (get-buffer-create message-buffer-name)))
     (unwind-protect
         (save-window-excursion
           (display-buffer-in-side-window
            message-buffer
            '((side . bottom)
              (slot . -1)
              (dedicated . t)))
           (with-current-buffer message-buffer
             (insert (make-string (window-width) ?/))
             (insert "\n\n")
             (insert ,MESSAGE)
             (insert "\n\n")
             (insert (make-string (window-width) ?/))
             (let ((TEMP-BUFFER-OVERLAY (make-overlay (point-min) (point-max))))
               (overlay-put TEMP-BUFFER-OVERLAY 'face 'shadow)
               (overlay-put TEMP-BUFFER-OVERLAY 'evaporate t))
             (fit-window-to-buffer (get-buffer-window (buffer-name)) nil 4 nil nil t)
             )
           ,@body
           )
       (kill-buffer message-buffer-name))))

The above macro can be used to wrap other kinds of interactive tasks.

1. query-replace-explained function:

(defun query-replace-explained (from-string to-string info-string
                                            &optional delimited start end)
  (let ((start (if start
                   start
                 (point-min-marker)))
        (end (if end
                 end
               (point-max-marker))))
(save-excursion
  (goto-char start)
  (when (search-forward-ifp from-string end t)
    (with-interactive-tasks-explanation info-string
      (query-replace from-string to-string delimited start end))))))

1. query-replace-explained function:

(defun query-replace-regexp-explained (regexp to-string info-string
                                              &optional delimited start end)
  (let ((start (if start
                   start
                 (point-min-marker)))
        (end (if end
                 end
               (point-max-marker)))
        ;; This is crucial!
    ;; - "search-space-regexp" defines the regexp used by search-forward* to interpret
    ;; spaces

    ;; - "search-whitespace-regexp" defines the regexp used by query-replace-regexp to
    ;; interpret spaces and is activated by "replace-regexp-lax-whitespace"

    ;; - For this function to work properly, it is necessary for
    ;; "search-space-regexp" to match "search-whitespace-regexp" if
    ;; "replace-regexp-lax-whitespace" is "t"
    (search-spaces-regexp (if replace-regexp-lax-whitespace
                              search-whitespace-regexp
                            search-spaces-regexp)))

(save-excursion
  (goto-char start)
  (when (search-forward-regexp-ifp regexp end t)
    (with-interactive-tasks-explanation
     info-string
     (query-replace-regexp regexp to-string delimited start end))))))

Usage.

(query-replace-explained
 "foo"
 "bar"
 "You need to replace \"foo\" with \"bar\" for example purpose"
 nil (point-min) (point-max))

or:

(with-interactive-tasks-explanation
    "You need to replace \"foo\" with \"bar\" for example purpose"
  (query-replace
   "foo"
   "bar"
   nil (point-min) (point-max)))