complex query replace using perform-replace with replace-re-search-function

[jack-mac]

Hello!

I'm using GNU Emacs 23.1.1 (i686-pc-linux-gnu, GTK+ Version 2.22.0) of
2011-03-04 on roseapple, modified by Debian

[1] I need some help for my function `jd-sh-format-pipes' which is
described below.

It works *almost* correctly!

The query process just asks for the correct occurrences (the one
recognized by my function `jd-sh-re-search-pipe'), but *all* the
occurrences of the regexp are semi-highlighted (including what I call
exceptions to the regexp).  Nevertheless, the perform-replace process
skips these exceptions and full-highlights only the correct ones.

Is this a bug?

If it's normal, how is it possible to have *only* the 'correct'
occurrences semi-highlighted?


BTW, is there any place where I could find any examples of how to use
`perform-replace' with a customized `replace-re-search-function'
and/or `replacements' being a cons cell with a function?

================================================================
[2] Also, when reading the code of `perform-replace', I found
something strange (NOT related to my problem, I think, since I don't
use the `delimited-flag').

It changes twice the `search-function' variable:

Once is ok for me (since it takes into account the value of the
variable `replace-re-search-function'):

  (let* ([snip]
         (search-function
          (if regexp-flag
              replace-re-search-function
            replace-search-function))
         [snip])

but the second one (when `delimited-flag' is t) seems to erase the
previous value of `search-function' and does NOT take into account the
value of the variable `replace-re-search-function'):

    (if delimited-flag
        (setq search-function 're-search-forward
              search-string (concat "\\b"
                                    (if regexp-flag from-string
                                      (regexp-quote from-string))
                                    "\\b")))

Is this correct?

================================================================
Here is the description of my function `jd-sh-format-pipes'
with a sample file to reformat.

Thanks in advance

)jack(

;;; [jack] 120610 I want each pipe in my ksh files to be surrounded by
exactly one space,
;;; i.e. basically replace  "<cm1> *| *<cmd2>"  by  "<cm1> | <cmd2>"
;;; but there are some exceptions:
;;; - `good_pipe'
;;;   <cm1> | <cmd2>
;;;   when the pipe is already surrounded by exactly one space, leave
it
;;; - `comment'
;;;   # r1238 | vtgk1446 (Jacques)    | 2012-01-31 10:26:23
;;;   Don't change a comment
;;; - `string'
;;;   sed -e 's|x|y|g' -e "s|$x|$y|g"
;;;   Don't change a string
;;; - `double_pipe'
;;;   <cmd1>  ||  <cmd2>
;;;   Don't separate a double pipe: don't change it into "<cmd1> | |
<cmd2>"
;;;   Don't squeeze the spaces:     don't change it into "<cmd1> ||
<cmd2>"
;;; - `case_clause'
;;;   case <x> in
;;;       <val>|<val>)
;;;   Don't change a case clause:   don't change it into "<val> |
<val>)"
;;; - `pipe_at_beginning-of-line'
;;;   <cmd1>   \
;;;     | <cmd2>
;;;   Don't squeeze the leading spaces, squeeze only the trailing ones
;;;
;;; As regexps don't like exceptions, it's probably nearly impossible
;;; to use `query-replace-regexp' with a regexp.
;;; So, I'll use a customized `replace-re-search-function'.

(defvar jd-sh-format-pipes-any-pipe-re  "[ \t]*| *")
(defvar jd-sh-format-pipes-good-pipe-re " | ")

(defun jd-re-paren (&rest args)
  (apply 'concat (cons "\\(" (append args (list "\\)")))))

(defun jd-sh-format-pipes ()
  (interactive)
  (let ((replace-re-search-function 'jd-sh-re-search-pipe)
        (any-pipe  jd-sh-format-pipes-any-pipe-re)
        (good-pipe jd-sh-format-pipes-good-pipe-re))
    (query-replace-regexp any-pipe good-pipe)))

(defun jd-sh-re-search-pipe (regexp &optional bound noerror count)
  (let ((good-pipe jd-sh-format-pipes-good-pipe-re)
        (pipe-at-bol (concat "^[ \t]*" (jd-re-paren "|") " *"))
        (good-pipe-at-bol "| ")
        (double-pipe "[ \t]*||[ \t]*")
        bop bopo eop ppss
        (found (not 'true)))
    (while (and (not found)
                (re-search-forward regexp bound noerror))
      (setq bop (match-beginning 0)  bopo bop  eop (match-end 0))
      (setq ppss (syntax-ppss)) ; Thanks to Stefan!
      (when (not 'debug)
        (message "%s %s"
                 (save-excursion
                   (beginning-of-line)
                   (buffer-substring (point) (+ (point) 9)))
                 ppss))
      (cond
       ((nth 3 ppss))                           ; Inside a string
       ((nth 4 ppss))                           ; Inside a comment
       ((equal (buffer-substring bop eop) good-pipe)) ; Already ok
       ((save-excursion
          (goto-char bop)
          (save-match-data
            (looking-at double-pipe)))     ; E.g. <cmd1> || <cmd2>
        (forward-char))                    ; Just skip the second pipe
       ((save-excursion
          ;; E.g.:    <cmd1>   \
          ;;            | <cmd2>
          (beginning-of-line)
          (save-match-data
            (when (and (looking-at pipe-at-bol)
                       (= eop (match-end 0)))
              (cond
               ((equal (buffer-substring (match-beginning 1) eop)
                       good-pipe-at-bol)
                t)                              ; Already ok
               (t (setq bop (1- (match-beginning 1)))
                  nil))))))             ; Process it in another clause
       ;; E.g.:    case <x> in
       ;;            <val>|<val>)
       ((save-excursion
          (beginning-of-line)
          (save-match-data
            (and (looking-at "^[^()\n]*[)]")
                 (<= eop (match-end 0))))))     ; Skip it
       (t (setq found t)
          ;; Restore match data with a possibly different bop
          (goto-char bop)
          (if (looking-at regexp)
              (goto-char (match-end 0))
            (error "Something went wrong between %s and %s at %s"
                   bopo eop bop)))))
    found))

The following file should be opened with sh-mode to get correct
comment
and string syntax.
Then M-x jd-sh-format-pipes RET

$ cat jd-sh-format-pipes-example.ksh
#!/bin/ksh

normal |command|with  |  some|  pipes  ||  Some should | not | be
changed

# normal |comment|with  |  some|  pipes  ||  None should | be changed
# r1238 | vtgk1446 (Jacques)    | 2012-01-31 10:26:23

normal |string|with  |  pipes | sed -e 's|x|y|g' -e "s|$x|$y|g" dont
change

normal |command|with  |  pipes  \
    |some| be  ||  changed      \
    | some| should | not be  ||  changed        \
    |  some| should | not be  ||  changed

case $clause in
    dont|change) ;;
esac
# File "jd-sh-format-pipes-example.ksh" ends here