;;; wgrep.el --- Writable grep buffer -*- lexical-binding: t -*-

;; Copyright (C) 2010-2020,2023 Masahiro Hayashi
;; Copyright (C) 2002-2009 Matsushita Akihisa <akihisa@mail.ne.jp>

;; Author: Masahiro Hayashi <mhayashi1120@gmail.com>
;; Keywords: grep edit extensions
;; URL: http://github.com/mhayashi1120/Emacs-wgrep/raw/master/wgrep.el
;; Emacs: GNU Emacs 25 or later
;; Package-Requires: ((emacs "25.1"))
;; Package-Version: 20230203.1214
;; Package-Revision: b4d69280d8a6

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; ## Summary:

;; wgrep allows you to edit a grep buffer and apply those changes to
;; the file buffer like `sed` interactively. No need to learn sed
;; script, just learn Emacs.

;; ## Install:

;; Put this file into load-path'ed directory, and byte compile it if
;; desired. And put the following expression into your ~/.emacs.
;;
;;     (require 'wgrep)

;; ## Usage:

;; You can edit the text in the *grep* buffer after typing `C-c C-p` .
;; After that the changed text is highlighted.
;; The following keybindings are defined:

;; * `C-c C-e`: Apply the changes to file buffers.
;; * `C-c C-u`: All changes are unmarked and ignored.
;; * `C-c C-d`: Mark as delete to current line (including newline).
;; * `C-c C-r`: Remove the changes in the region (these changes are not
;;   applied to the files. Of course, the remaining
;;   changes can still be applied to the files.)
;; * `C-c C-p`: Toggle read-only area.
;; * `C-c C-k`: Discard all changes and exit.
;; * `C-x C-q`: Exit wgrep mode.

;; * To save all buffers that wgrep has changed, run
;;
;;     M-x wgrep-save-all-buffers

;; * To save buffer automatically when `wgrep-finish-edit'.
;;
;;     (setq wgrep-auto-save-buffer t)

;; * You can change the default key binding to switch to wgrep.
;;
;;     (setq wgrep-enable-key "r")

;; * To apply all changes regardless of whether or not buffer is read-only.
;;
;;     (setq wgrep-change-readonly-file t)

;; ### Trivial features:

;; - wdired.el like interface.
;; - Support GNU grep `--context` (`-A` `-B` and `-C`) option.
;; - Can handle too many files.
;; - Can handle newline insertion in *grep* buffer.
;; - Delete whole line include newline.

;; ### Similar software:

;; [GNU sed](https://www.gnu.org/software/sed/)
;; [helm-ag](https://github.com/syohex/emacs-helm-ag) has a similar feature.

;; ## History:

;; This program was forked from Matsushita Akihisa's [grep-edit.el
;; v2.11](http://www.bookshelf.jp/elc/grep-edit.el).  As this website is
;; now inaccessible,
;; [emacswiki.org's](https://www.emacswiki.org/emacs/grep-edit.el) copy
;; may be consulted.

;; Imported version can be downloaded from this orphan commit:
;; https://github.com/mhayashi1120/Emacs-wgrep/tree/import-original-author/

;; Following added implementations and differences.
;; * Support GNU grep context option -A -B and -C
;; * Some bugfix. (wrong coloring text etc..)
;; * wdired.el like interface.
;; * Remove all advice.
;; * Bind to local variables. (grep-a-lot.el works well)
;; * After save buffer, colored face will be removed.
;; * Change face easy to see.
;; * Reinforce checking error.
;; * Support removing whole line include new-line.

;;; Code:

(require 'grep)

(declare-function image-get-display-property "image-mode.el" ())
(declare-function image-mode-as-text "image-mode.el" ())

(defgroup wgrep nil
  "Customize wgrep"
  :prefix "wgrep-"
  :group 'grep)

;;;
;;; Variable / Constant
;;;

;;;;
;;;; Customize
;;;;

(defcustom wgrep-change-readonly-file nil
  "Non-nil means to enable change read-only files."
  :group 'wgrep
  :type 'boolean)

(defcustom wgrep-enable-key "\C-c\C-p"
  "This variable will be obsoleted in the future release.
Key to enable `wgrep-mode'."
  :group 'wgrep
  :type 'string)

(defcustom wgrep-auto-save-buffer nil
  "Non-nil means do `basic-save-buffer' automatically while `wgrep-finish-edit'."
  :group 'wgrep
  :type 'boolean)

(defcustom wgrep-too-many-file-length 10
  "Number to detect as too many files."
  :group 'wgrep
  :type 'number)

(defvar wgrep-setup-hook nil
  "Hooks to run when setting up wgrep.")

(defvar wgrep-mode-map nil)

;;;;
;;;; Internal variable
;;;;

(defvar wgrep-readonly-state nil)
(make-variable-buffer-local 'wgrep-readonly-state)

(defvar wgrep-prepared nil)
(make-variable-buffer-local 'wgrep-prepared)

(defvar wgrep-sibling-buffer nil)
(make-variable-buffer-local 'wgrep-sibling-buffer)

(defvar wgrep-original-mode-map nil)
(make-variable-buffer-local 'wgrep-original-mode-map)

(defvar wgrep-inhibit-modification-hook nil)

(defvar wgrep-auto-apply-disk nil
  "Internal use `wgrep-auto-save-buffer' or too many file is editing.")

(defvar wgrep-acceptable-modes nil)
(make-obsolete 'wgrep-acceptable-modes nil "2.1.1")

;; Suppress elint warning
;; GNU Emacs have this variable at least version 21 or later
(defvar auto-coding-regexp-alist)

;;;;
;;;; Constant
;;;;

;; These regexp come from `grep-regexp-alist' at grep.el
(eval-and-compile
  (defconst wgrep-null-file-separator-header-regexp
    "\\(?1:[^\0\n]+\\)\\(?:\0\\)\\(?3:[0-9]+\\):")

  (defconst wgrep-colon-file-separator-header-regexp
    "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?3:[1-9][0-9]*\\)[\t ]*:"))

;; Generalized regexp, but wrong matching when colon `:' and null `\0'
;; is contained in grep result.
(defconst wgrep-default-line-header-regexp
  (eval-when-compile
    (concat
     "^"
     "\\(?:"
     ;; `--null' argument is used.
     wgrep-null-file-separator-header-regexp
     "\\|"
     ;; Fallback regexp
     wgrep-colon-file-separator-header-regexp
     "\\)")))

;;;;
;;;; Error
;;;;

(define-error 'wgrep-error "wgrep error")

;;;;
;;;; Overridable functions / regexp
;;;;

(defvar wgrep-line-file-regexp wgrep-default-line-header-regexp
  "Regexp that match to line header of grep result.

That capture 1: filename 3: line-number
End of this match equals start of file contents.
")

(defvar wgrep-results-parser 'wgrep-parse-command-results
  "This function parse line oriented command output and set following properties.
`wgrep-line-filename', `wgrep-line-number', `wgrep-ignore' and
`wgrep-construct-filename-property' function construct the property name with
`wgrep-line-filename' and the value is same. This property is used for searching
 correct point of filename.
Not like `wgrep-header&footer-parser' should not set `read-only' property.")

;; Previously named `wgrep-header/footer-parser` this name violate `package-lint`
;; conventions.
(defvar wgrep-header&footer-parser 'wgrep-prepare-header&footer
  "This function should set text properties `read-only' and `wgrep-header' to
non editable region.")

;;;
;;; Basic utilities
;;;

;;;;
;;;; misc
;;;;

;;Hack function
(defun wgrep-string-replace-bom (string cs)
  (let ((regexp (car (rassq (coding-system-base cs) auto-coding-regexp-alist)))
        ;;TODO check ack-grep
        ;; FIXME: `find-operation-coding-system' is not exactly correct.
        ;;        However almost case is ok like this bom function.
        ;;        e.g. (let ((default-process-coding-system 'some-coding))
        ;;               (call-interactively 'grep))
        (grep-cs (or (find-operation-coding-system 'call-process grep-program)
                     (terminal-coding-system)))
        str)
    (if (and regexp
             (setq str (encode-coding-string string grep-cs))
             (string-match regexp str))
        (decode-coding-string (substring str (match-end 0)) cs)
      string)))

(defun wgrep-delete-whole-line ()
  (delete-region (line-beginning-position)
                 (line-beginning-position 2)))

(defun wgrep-goto-line (line)
  (goto-char (point-min))
  (forward-line (1- line)))

(defun wgrep-process-exited-p ()
  (let ((proc (get-buffer-process (current-buffer))))
    (or (null proc)
        (eq (process-status proc) 'exit))))

;;;;
;;;; error
;;;;

(defun wgrep-check-file (file)
  (unless (file-exists-p file)
    (signal 'wgrep-error (list "File does not exist.")))
  (unless (file-writable-p file)
    (signal 'wgrep-error (list "File is not writable."))))

;;;;
;;;; overlay
;;;;

(defun wgrep-cleanup-overlays (beg end)
  (dolist (ov (overlays-in beg end))
    (when (overlay-get ov 'wgrep)
      (delete-overlay ov))))

(defun wgrep-make-overlay (beg end)
  (let ((o (make-overlay beg end nil nil t)))
    (overlay-put o 'wgrep t)
    o))

(defun wgrep-file-overlays ()
  (save-restriction
    (widen)
    (let (res)
      (dolist (ov (overlays-in (point-min) (point-max)))
        (when (overlay-get ov 'wgrep)
          (setq res (cons ov res))))
      (nreverse res))))

(defun wgrep-edit-field-overlays ()
  (let (res)
    (dolist (ov (overlays-in (point-min) (point-max)))
      (when (overlay-get ov 'wgrep-changed)
        (setq res (cons ov res))))
    (sort res (lambda (x y) (< (overlay-start x) (overlay-start y))))))

;;;
;;; grep result handler
;;;

(defun wgrep-construct-filename-property (filename)
  (intern (format "wgrep-fn-%s" filename)))

(defun wgrep-goto-grep-line (file number)
  (let ((first (point))
        (fprop (wgrep-construct-filename-property file))
        fn next)
    (catch 'found
      ;; FIXME
      ;; In a huge buffer, `next-single-property-change' loop make
      ;; slow down the program.
      ;; 1. sketchy move by filename (wgrep-fn-* property).
      ;; 2. search filename and line-number in text property.
      ;; 3. return to 1. while search is done or EOB.

      (goto-char (point-min))

      (while (setq next (next-single-property-change (point) fprop))
        (goto-char next)
        (while (and (not (eobp))
                    (or (null (setq fn (get-text-property
                                        (line-beginning-position)
                                        'wgrep-line-filename)))
                        (string= fn file)))
          (when fn
            (let ((num (get-text-property (point) 'wgrep-line-number))
                  (start (next-single-property-change (point) 'wgrep-line-number)))
              (when (eq number num)
                (goto-char start)
                (throw 'found t))))
          (forward-line 1)))
      (goto-char first)
      nil)))

(defun wgrep-get-old-text (file number)
  (when (and wgrep-sibling-buffer
             (buffer-live-p wgrep-sibling-buffer))
    (with-current-buffer wgrep-sibling-buffer
      (when (wgrep-goto-grep-line file number)
        (buffer-substring-no-properties
         (point) (line-end-position))))))

;;;
;;; Prepare and parse grep <-> wgrep
;;;

(defun wgrep-to-original-mode ()
  (kill-local-variable 'query-replace-skip-read-only)
  (remove-hook 'after-change-functions 'wgrep-after-change-function t)
  ;; do not remove `wgrep-maybe-echo-error-at-point' that display
  ;; errors at point
  (use-local-map wgrep-original-mode-map)
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil)
  (setq buffer-read-only t))

(defun wgrep-goto-first-found ()
  (let ((header (previous-single-property-change (point-max) 'wgrep-header)))
    (cond
     (header
      (goto-char header)
      header)
     (t
      (goto-char (point-min))
      (point)))))

(defun wgrep-goto-end-of-found ()
  (let ((footer (next-single-property-change (point-min) 'wgrep-footer)))
    (cond
     (footer
      (goto-char footer)
      footer)
     (t
      (goto-char (point-max))
      (point-max)))))

(defun wgrep-cleanup-temp-buffer ()
  "Cleanup temp buffer in *grep* buffer."
  (let ((origin-buffer (current-buffer)))
    (dolist (buf (buffer-list))
      (with-current-buffer buf
        (when (eq origin-buffer wgrep-sibling-buffer)
          (kill-buffer buf)))))
  (setq wgrep-sibling-buffer nil))

(defun wgrep-clone-to-temp-buffer ()
  (wgrep-cleanup-temp-buffer)
  (let ((grepbuf (current-buffer))
        (tmpbuf (generate-new-buffer " *wgrep temp* ")))
    (setq wgrep-sibling-buffer tmpbuf)
    (add-hook 'kill-buffer-hook 'wgrep-cleanup-temp-buffer nil t)
    (append-to-buffer tmpbuf (point-min) (point-max))
    (with-current-buffer tmpbuf
      (setq wgrep-sibling-buffer grepbuf))
    tmpbuf))

(defun wgrep-set-readonly-area (state)
  (let ((inhibit-read-only t)
        (wgrep-inhibit-modification-hook t)
        pos start end)
    (save-excursion
      ;; set readonly grep result filename
      (setq pos (point-min))
      (while (setq start (next-single-property-change
                          pos 'wgrep-line-filename))
        (setq end (next-single-property-change
                   start 'wgrep-line-filename))
        (put-text-property start end 'read-only state)
        (put-text-property (1- end) end 'rear-nonsticky t)
        ;; set readonly all newline at end of grep line
        (when (eq (char-before start) ?\n)
          (put-text-property (1- start) start 'read-only state))
        (setq pos end))
      (setq pos (point-min))
      (while (setq start (next-single-property-change
                          pos 'wgrep-ignore))
        (setq end (next-single-property-change
                   start 'wgrep-ignore))
        (put-text-property start end 'read-only state)
        ;; set readonly all newline at end of grep line
        (when (eq (char-before start) ?\n)
          (put-text-property (1- start) start 'read-only state))
        (setq pos end))
      ;; set readonly last of grep line
      (let ((footer (or (next-single-property-change (point-min) 'wgrep-footer)
                        ;; to consider empty footer.
                        (point-max))))
        (when (eq (char-before footer) ?\n)
          (put-text-property (1- footer) footer 'read-only state))))
    (setq wgrep-readonly-state state)))

(defun wgrep-prepare-context ()
  (save-restriction
    (let ((start (wgrep-goto-first-found))
          (end (wgrep-goto-end-of-found)))
      (narrow-to-region start end)
      (goto-char (point-min))
      (funcall wgrep-results-parser))))

;; -A -B -C output may be misunderstood and set read-only.
;; Context match break font-lock if context have at least two `:'.
;; e.g.
;; filename-1-2010-01-01 23:59:99
;; filename:2:hoge
;; filename-3-20:10:25
(defun wgrep-prepare-context-while (filename line direction fprop flen)
  (let* ((next (+ direction line))
         (fregexp (regexp-quote filename)))
    (forward-line direction)
    (while (looking-at (format "^%s[-\0]%d-" fregexp next))
      (let ((start (match-beginning 0))
            (end (match-end 0))
            (bol (line-beginning-position))
            (eol (line-end-position)))
        (put-text-property start end 'wgrep-line-filename filename)
        (put-text-property start end 'wgrep-line-number next)
        (put-text-property start (+ start flen) fprop filename)
        (remove-text-properties bol eol '(wgrep-ignore))
        (forward-line direction)
        (setq next (+ direction next))))))

(defun wgrep-parse-command-results ()
  (let ((cache (make-hash-table)))
    (while (not (eobp))
      (cond
       ((looking-at wgrep-line-file-regexp)
        (let* ((fn (match-string-no-properties 1))
               (line (string-to-number (match-string 3)))
               (start (match-beginning 0))
               (end (match-end 0))
               (fprop (wgrep-construct-filename-property fn))
               (flen (length fn)))
          ;; check relative path grep result
          ;; grep result may be --context result with number between 2 colon.
          ;; ./filename-1-:10:
          ;; that make misunderstand font-locking
          ;; check file existence decrease risk of the misunderstanding.
          (when (or (gethash fn cache nil)
                    (and (file-exists-p fn)
                         (puthash fn t cache)))
            (put-text-property start end 'wgrep-line-filename fn)
            (put-text-property start end 'wgrep-line-number line)
            (put-text-property start (+ start flen) fprop fn)
            ;; handle backward and forward following options.
            ;; -A (--after-context) -B (--before-context) -C (--context)
            (save-excursion
              (wgrep-prepare-context-while fn line -1 fprop flen))
            (wgrep-prepare-context-while fn line 1 fprop flen)
            ;; end of context output `--'.
            (forward-line -1))))
       (t
        ;; Add property but this may be removed by `wgrep-prepare-context-while'
        (put-text-property (line-beginning-position)
                           (line-end-position)
                           'wgrep-ignore t)))
      (forward-line 1))))

(defun wgrep-current-file-and-linum ()
  (save-excursion
    (forward-line 0)
    (let ((fn (get-text-property (point) 'wgrep-line-filename))
          (linum (get-text-property (point) 'wgrep-line-number)))
      (when (and fn linum)
        (list fn linum)))))

(defun wgrep-restore-from-temp-buffer ()
  (cond
   ((and wgrep-sibling-buffer
         (buffer-live-p wgrep-sibling-buffer))
    (let ((grepbuf (current-buffer))
          (tmpbuf wgrep-sibling-buffer)
          (header (wgrep-current-file-and-linum))
          (savedc (current-column))
          (savedp (point))
          (inhibit-read-only t)
          (wgrep-inhibit-modification-hook t)
          buffer-read-only)
      (erase-buffer)
      (with-current-buffer tmpbuf
        (append-to-buffer grepbuf (point-min) (point-max)))
      (goto-char (point-min))
      ;; restore previous cursor
      (or (and header
               (apply 'wgrep-goto-grep-line header)
               (move-to-column savedc))
          (goto-char (min (point-max) savedp)))
      (wgrep-cleanup-temp-buffer)))
   (t
    ;; non fatal error
    (message "Error! Saved buffer is unavailable."))))

(defun wgrep-prepare-to-edit ()
  (unless wgrep-prepared
    (save-excursion
      (let ((inhibit-read-only t)
            (wgrep-inhibit-modification-hook t)
            buffer-read-only)
        (funcall (or wgrep-header&footer-parser
                     ;; TODO FIXME: workaround compat for previous code.
                     (and (boundp 'wgrep-header/footer-parser)
                          wgrep-header/footer-parser)))
        (wgrep-prepare-context)
        (setq wgrep-prepared t)))))

(defun wgrep-prepare-header&footer ()
  (let (beg end)
    ;; Set read-only grep result header
    (goto-char (point-min))
    (setq beg (point-min))
    ;; See `compilation-start'
    (forward-line 4)
    (setq end (point))
    (put-text-property beg end 'read-only t)
    (put-text-property beg end 'wgrep-header t)
    ;; Set read-only grep result footer
    (goto-char (point-max))
    (forward-line -1)
    (when (re-search-backward "^$" end t)
      (setq beg (point))
      (setq end (point-max))
      (when beg
        (put-text-property beg end 'read-only t)
        (put-text-property beg end 'wgrep-footer t)))))

(defun wgrep-set-header&footer-read-only (state)
  (let ((inhibit-read-only t)
        (wgrep-inhibit-modification-hook t))
    ;; header
    (let ((header-end (next-single-property-change (point-min) 'wgrep-header)))
      (when header-end
        (put-text-property (point-min) header-end 'read-only state)))
    ;; footer
    (let ((footer-beg (next-single-property-change (point-min) 'wgrep-footer)))
      (when footer-beg
        (put-text-property footer-beg (point-max) 'read-only state)))))

;;;
;;; Editing handlers
;;;

;; get overlay BEG and END is passed by `after-change-functions'
(defun wgrep-editing-overlay (&optional start end)
  (let ((beg (or start (line-beginning-position)))
        (fin (or end (line-end-position)))
        ov bol eol
        ;; beginning/end of grep
        bog eog)
    (goto-char beg)
    (setq bol (line-beginning-position))
    (goto-char fin)
    (setq eol (line-end-position))
    (catch 'done
      (dolist (o (overlays-in bol eol))
        ;; find overlay that have changed by user.
        (when (overlay-get o 'wgrep-changed)
          (setq ov o)
          (throw 'done o))))
    (if ov
        (setq bog (min beg (overlay-start ov))
              eog (max (overlay-end ov) fin))
      (setq bog bol
            eog eol))
    (goto-char bog)
    (cond
     ;; When handling whole line, BOL equal beginning of edit.
     ((and (null ov) start (= bog start)))
     ((get-text-property (point) 'wgrep-line-filename)
      (let* ((header-end
              (next-single-property-change (point) 'wgrep-line-filename nil eol))
             (filename (get-text-property (point) 'wgrep-line-filename))
             (linum (get-text-property (point) 'wgrep-line-number))
             (value (buffer-substring-no-properties header-end eog))
             contents-begin)
        (goto-char header-end)
        (setq contents-begin (point-marker))
        ;; create editing overlay
        (cond
         ((null ov)
          (let ((old (wgrep-get-old-text filename linum)))
            (setq ov (wgrep-make-overlay bog eog))
            (overlay-put ov 'wgrep-contents-begin contents-begin)
            (overlay-put ov 'wgrep-filename filename)
            (overlay-put ov 'wgrep-linum linum)
            (overlay-put ov 'wgrep-changed t)
            (overlay-put ov 'priority 0)
            (overlay-put ov 'evaporate t)
            (overlay-put ov 'wgrep-old-text old)))
         (t
          (move-overlay ov bog eog)))
        (overlay-put ov 'wgrep-edit-text value))))
    ov))

(defun wgrep-after-change-function (beg end _leng-before)
  (cond
   (wgrep-inhibit-modification-hook nil)
   ((= (point-min) (point-max))
    ;; cleanup when first executing
    (wgrep-cleanup-overlays (point-min) (point-max)))
   (t
    (wgrep-put-change-face beg end))))

(defun wgrep-put-change-face (beg end)
  (save-excursion
    ;; `looking-at' may destroy match data while replace by regexp.
    (save-match-data
      (let ((ov (wgrep-editing-overlay beg end)))
        ;; delete overlay if text is same as old value.
        (cond
         ;; not a valid point
         ((null ov))
         ((string= (overlay-get ov 'wgrep-old-text)
                   (overlay-get ov 'wgrep-edit-text))
          ;; back to unchanged
          (delete-overlay ov))
         (t
          (overlay-put ov 'face 'wgrep-face)))))))

;;;
;;; Save grep buffer to file buffer/disk
;;;

(defun wgrep-display-physical-data ()
  (cond
   ;; `funcall' is a trick to suppress the elint warnings.
   ((derived-mode-p 'image-mode)
    ;; toggle to raw data if buffer has image.
    (when (image-get-display-property)
      (image-mode-as-text)))
   (t nil)))

(defun wgrep-set-result (ov face &optional message)
  (overlay-put ov 'face face)
  (overlay-put ov 'priority 1)
  (overlay-put ov 'wgrep-reject-message message))

(defun wgrep-put-done-result (ov)
  (wgrep-set-result ov 'wgrep-done-face))

(defun wgrep-put-reject-result (ov error-data)
  (let ((message (mapconcat (lambda (x) (format "%s" x)) error-data " ")))
    (wgrep-set-result ov 'wgrep-reject-face message)))

(defun wgrep-put-reject-result-all (editor error-data)
  (dolist (edit (cdr editor))
    (let ((result (nth 3 edit)))
      (wgrep-put-reject-result result error-data))))

(defun wgrep-after-save-hook ()
  (remove-hook 'after-save-hook 'wgrep-after-save-hook t)
  (dolist (ov (wgrep-file-overlays))
    (delete-overlay ov)))

(defun wgrep-put-overlay-to-file-buffer (beg end)
  "*Highlight the changes in the file"
  (let ((ov
         (catch 'done
           (dolist (o (overlays-in beg end))
             (when (overlay-get o 'wgrep)
               (move-overlay o beg end)
               (throw 'done o)))
           (wgrep-make-overlay beg end))))
    (overlay-put ov 'face 'wgrep-file-face)
    (overlay-put ov 'priority 0)
    (add-hook 'after-save-hook 'wgrep-after-save-hook nil t)
    ov))

(defun wgrep-let-destructive-overlay (ov)
  (dolist (prop '(modification-hooks insert-in-front-hooks insert-behind-hooks))
    (overlay-put
     ov prop
     `(,(lambda (ov after-p &rest _ignore)
          (when after-p
            (delete-overlay ov)))))))

(defun wgrep-replace-to-new-line (new-text)
  ;; delete grep extracted region (restricted to a line)
  (delete-region (line-beginning-position) (line-end-position))
  (let ((beg (point)))
    (insert new-text)
    (let* ((end (point))
           ;; highlight the changed line
           (ov (wgrep-put-overlay-to-file-buffer beg end)))
      ;; make overlay volatile.
      (wgrep-let-destructive-overlay ov))))

(defun wgrep-flush-whole-line ()
  (wgrep-put-overlay-to-file-buffer
   (line-beginning-position) (line-end-position))
  (wgrep-delete-whole-line))

;; EDITOR ::= FILE (absolute-path) . EDITS
;; EDITS ::= EDIT [...]
;; EDIT ::= linum-or-marker old-text new-text result-overlay edit-field-overlay
(defun wgrep-gather-editor ()
  (let (res)
    (dolist (edit-field (wgrep-edit-field-overlays))
      (goto-char (overlay-start edit-field))
      (forward-line 0)
      (cond
       ;; ignore removed line or removed overlay
       ((eq (overlay-start edit-field) (overlay-end edit-field)))
       ((get-text-property (point) 'wgrep-line-filename)
        (let* ((name (get-text-property (point) 'wgrep-line-filename))
               (linum (get-text-property (point) 'wgrep-line-number))
               (start (next-single-property-change
                       (point) 'wgrep-line-filename nil (line-end-position)))
               (file (expand-file-name name default-directory))
               (old (overlay-get edit-field 'wgrep-old-text))
               (new (overlay-get edit-field 'wgrep-edit-text))
               result)
          ;; wgrep-result overlay show the committing of this editing
          (catch 'done
            (dolist (o (overlays-in (overlay-start edit-field) (overlay-end edit-field)))
              (when (overlay-get o 'wgrep-result)
                ;; get existing overlay
                (setq result o)
                (throw 'done t)))
            ;; create overlay to show result of committing
            (setq result (wgrep-make-overlay start (overlay-end edit-field)))
            (overlay-put result 'wgrep-result t))
          (setq res
                (cons
                 (list file (list linum old new result edit-field))
                 res))))))
    (nreverse res)))

(defun wgrep-compute-transaction ()
  (let ((editors (wgrep-gather-editor))
        editor-group tran)
    (dolist (editor editors)
      (let* ((file (car editor))
             (edits (cdr editor))
             (editor-cache (assoc file editor-group)))
        (unless editor-cache
          (setq editor-cache (cons file nil))
          (setq editor-group (cons editor-cache editor-group)))
        ;; construct with current settings
        (setcdr editor-cache (append (cdr editor-cache) edits))))
    (setq editor-group (nreverse editor-group))

    ;; Check file accessibility
    (dolist (editor editor-group)
      (let ((file (car editor)))
        (condition-case err
            (progn
              (wgrep-check-file file)
              (setq tran (cons editor tran)))
          (wgrep-error
           (wgrep-put-reject-result-all editor (cdr err))))))

    (nreverse tran)))

(defun wgrep-compute-linum-to-marker (edits)
  ;; Convert linum to marker.
  ;; When new text contains newline destroy linum access.
  (dolist (edit edits)
    (let ((linum (car edit)))
      ;; get a marker
      (wgrep-goto-line linum)
      (setcar edit (point-marker)))))

(defun wgrep-commit-edits (editor)
  (let ((file (car editor))
        (edits (cdr editor)))
    (wgrep-compute-linum-to-marker edits)
    (let ((done 0)
          (first-result nil)
          (inhibit-read-only wgrep-change-readonly-file))
      (dolist (edit edits)
        (let ((marker (nth 0 edit))
              (old (nth 1 edit))
              (new (nth 2 edit))
              (result-ov (nth 3 edit))
              (edit-ov (nth 4 edit)))
          (condition-case err
              (progn
                (unless first-result
                  (setq first-result result-ov))
                (wgrep-apply-change marker old new)
                (wgrep-put-done-result result-ov)
                (delete-overlay edit-ov)
                (setq done (1+ done)))
            (error
             (wgrep-put-reject-result result-ov (cdr err))))))
      (cond
       ((or (not wgrep-auto-apply-disk)
            (= done 0)))
       (buffer-file-name
        (basic-save-buffer))
       (t
        (let ((coding-system-for-write buffer-file-coding-system))
          (write-region (point-min) (point-max) file nil 'no-msg))))
      (list done first-result))))

(defun wgrep-commit-file (editor)
  ;; Apply EDITOR to file/buffer. See `wgrep-compute-transaction'.
  ;; Return succeeded count and first result overlay in *grep* buffer.
  (let* ((file (car editor))
         (open-buffer (get-file-buffer file))
         (buffer
          (cond
           (open-buffer open-buffer)
           (wgrep-auto-apply-disk
            (let ((buf (generate-new-buffer "*TMP <wgrep>*")))
              (with-current-buffer buf
                ;; To detect coding-system and set `buffer-file-coding-system'.
                (insert-file-contents file))
              buf))
           (t
            (find-file-noselect file)))))
    (unwind-protect
        (with-current-buffer buffer
          (save-restriction
            (widen)
            (wgrep-display-physical-data)

            (cond
             ((and (not wgrep-change-readonly-file)
                   buffer-read-only)
              (wgrep-put-reject-result-all
               editor
               (list (format "Buffer \"%s\" is read-only." (buffer-name))))
              (list 0 nil))
             (t
              (wgrep-commit-edits editor)))))
      (when wgrep-auto-apply-disk
        (when (null open-buffer)
          (kill-buffer buffer))))))

(defun wgrep-apply-change (marker old new)
  "The changes in the *grep* buffer are applied to the file.
NEW may be nil this means deleting whole line."
  (let ((coding buffer-file-coding-system))
    (goto-char marker)
    ;; check BOM
    (when (and (= (point-min-marker) marker)
               coding
               (coding-system-get coding :bom))
      (setq old (wgrep-string-replace-bom old coding))
      (when new
        (setq new (wgrep-string-replace-bom new coding))))
    ;; Check buffer line was modified after execute grep.
    (unless (string= old
                     (buffer-substring-no-properties
                      (line-beginning-position) (line-end-position)))
      (signal 'wgrep-error (list "Buffer was changed after grep.")))
    (cond
     (new
      (wgrep-replace-to-new-line new))
     (t
      ;; new nil means flush whole line.
      (wgrep-flush-whole-line)))))

;;;
;;; UI
;;;

(defface wgrep-face
  '((((class color)
      (background dark))
     (:background "SlateGray1" :foreground "Black"))
    (((class color)
      (background light))
     (:background "ForestGreen" :foreground "white"))
    (t
     ()))
  "*Face used for the changed text in the grep buffer."
  :group 'wgrep)

(defface wgrep-delete-face
  '((((class color)
      (background dark))
     (:background "SlateGray1" :foreground "pink"))
    (((class color)
      (background light))
     (:background "ForestGreen" :foreground "pink"))
    (t
     ()))
  "*Face used for the deleted whole line in the grep buffer."
  :group 'wgrep)

(defface wgrep-file-face
  '((((class color)
      (background dark))
     (:background "gray30" :foreground "white"))
    (((class color)
      (background light))
     (:background "ForestGreen" :foreground "white"))
    (t
     ()))
  "*Face used for the changed text in the file buffer."
  :group 'wgrep)

(defface wgrep-reject-face
  '((((class color)
      (background dark))
     (:foreground "HotPink" :weight bold))
    (((class color)
      (background light))
     (:foreground "Red" :weight bold))
    (t
     ()))
  "*Face used for the line in the grep buffer that can not be applied to
a file."
  :group 'wgrep)

(defface wgrep-done-face
  '((((class color)
      (background dark))
     (:foreground "LightSkyBlue"))
    (((class color)
      (background light))
     (:foreground "Blue"))
    (t
     ()))
  "*Face used for the line in the grep buffer that can be applied to a file."
  :group 'wgrep)

(defun wgrep-maybe-echo-error-at-point ()
  (when (null (current-message))
    (let ((ov (catch 'found
                (dolist (o (overlays-in (line-beginning-position)
                                        (line-end-position)))
                  (when (overlay-get o 'wgrep-reject-message)
                    (throw 'found o))))))
      (when ov
        (let (message-log-max)
          (message "%s" (overlay-get ov 'wgrep-reject-message)))))))

;;;
;;; Commands
;;;

(defun wgrep-finish-edit ()
  "Apply changes to file buffers.
These changes are not immediately saved to disk unless
`wgrep-auto-save-buffer' is non-nil."
  (interactive)
  (let* ((tran (wgrep-compute-transaction))
         (all-length (length tran))
         (wgrep-auto-apply-disk nil)
         (done 0))
    (cond
     (wgrep-auto-save-buffer
      (setq wgrep-auto-apply-disk t))
     ((> all-length wgrep-too-many-file-length)
      (when (y-or-n-p (eval-when-compile
                        (concat
                         "Edited files are too many."
                         " Apply the changes to disk with non-confirmation?")))
        (setq wgrep-auto-apply-disk t))))
    (while tran
      (let* ((editor (car tran))
             (committed (wgrep-commit-file editor))
             (count (nth 0 committed))
             (result (nth 1 committed)))
        (when result
          (goto-char (overlay-start result))
          (forward-line 0))
        (setq done (+ done count))
        (setq tran (cdr tran))
        (let (message-log-max)
          (message "Writing %d files, %d files are left..."
                   all-length (length tran)))
        (redisplay t)))
    (wgrep-cleanup-temp-buffer)
    (wgrep-to-original-mode)
    (let ((msg (format "(%d changed)" done))
          (ovs (wgrep-edit-field-overlays)))
      (cond
       ((null ovs)
        (if (= done 0)
            (message "(No changes to be performed)")
          (message "Successfully finished. %s" msg)))
       ((= (length ovs) 1)
        (message "There is an unapplied change. %s" msg))
       (t
        (message "There are %d unapplied changes. %s"
                 (length ovs) msg))))))

(defun wgrep-exit ()
  "Return to original mode."
  (interactive)
  (if (and (buffer-modified-p)
           (y-or-n-p (format "Buffer %s modified; save changes? "
                             (current-buffer))))
      (wgrep-finish-edit)
    (wgrep-abort-changes)))

(defun wgrep-abort-changes ()
  "Discard all changes and return to original mode."
  (interactive)
  (wgrep-cleanup-overlays (point-min) (point-max))
  (wgrep-restore-from-temp-buffer)
  (wgrep-to-original-mode)
  (message "Changes discarded"))

(defun wgrep-remove-change (beg end)
  "Remove changes in the region between BEG and END."
  (interactive "r")
  (wgrep-cleanup-overlays beg end)
  (setq mark-active nil))

(defun wgrep-remove-all-change ()
  "Remove changes in the whole buffer."
  (interactive)
  (wgrep-cleanup-overlays (point-min) (point-max)))

(defun wgrep-toggle-readonly-area ()
  "Toggle read-only area to remove a whole line.

See the following example: you obviously don't want to edit the first line.
If grep matches a lot of lines, it's hard to edit the grep buffer.
After toggling to editable, you can call
`delete-matching-lines', `delete-non-matching-lines'.

Example:
----------------------------------------------
./.svn/text-base/some.el.svn-base:87:(hoge)
./some.el:87:(hoge)
----------------------------------------------
"
  (interactive)
  (let ((modified (buffer-modified-p))
        (read-only (not wgrep-readonly-state)))
    (wgrep-set-readonly-area read-only)
    (wgrep-set-header&footer-read-only read-only)
    (set-buffer-modified-p modified)
    (if wgrep-readonly-state
        (message "Removing the whole line is now disabled.")
      (message "Removing the whole line is now enabled."))))

(defun wgrep-change-to-wgrep-mode ()
  "Change to wgrep mode.

When the *grep* buffer is huge, this might freeze your Emacs
for several minutes.
"
  (interactive)
  (unless (wgrep-process-exited-p)
    (error "Active process working"))
  (wgrep-prepare-to-edit)
  (wgrep-set-readonly-area t)
  (set (make-local-variable 'query-replace-skip-read-only) t)
  (add-hook 'after-change-functions 'wgrep-after-change-function nil t)
  (add-hook 'post-command-hook 'wgrep-maybe-echo-error-at-point nil t)
  (use-local-map wgrep-mode-map)
  (buffer-disable-undo)
  (wgrep-clone-to-temp-buffer)
  (setq buffer-read-only nil)
  (buffer-enable-undo)
  ;; restore modified status
  (set-buffer-modified-p (wgrep-edit-field-overlays))
  (setq buffer-undo-list nil)
  (message "%s" (substitute-command-keys
                 "Press \\[wgrep-finish-edit] when finished \
or \\[wgrep-abort-changes] to abort changes.")))

(defun wgrep-save-all-buffers ()
  "Save the buffers that wgrep changed."
  (interactive)
  (let ((count 0))
    (dolist (b (buffer-list))
      (with-current-buffer b
        (let ((ovs (wgrep-file-overlays)))
          (when (and ovs (buffer-modified-p))
            (basic-save-buffer)
            (setq count (1+ count))))))
    (cond
     ((= count 0)
      (message "No buffer has been saved."))
     ((= count 1)
      (message "Buffer has been saved."))
     (t
      (message "%d buffers have been saved." count)))))

(defun wgrep-mark-deletion ()
  "Mark as delete to current line.
This change will be applied when \\[wgrep-finish-edit]."
  (interactive)
  (save-excursion
    (let ((ov (wgrep-editing-overlay)))
      (unless ov
        (error "Not a grep result"))
      (condition-case nil
          (progn
            (overlay-put ov 'wgrep-edit-text nil)
            (let ((wgrep-inhibit-modification-hook t)
                  (begin (overlay-get ov 'wgrep-contents-begin))
                  (end (overlay-end ov)))
              (delete-region begin end)
              (overlay-put ov 'face 'wgrep-delete-face)))
        (error
         (delete-overlay ov))))))

(unless wgrep-mode-map
  (let ((map (make-sparse-keymap)))

    (define-key map "\C-c\C-c" 'wgrep-finish-edit)
    (define-key map "\C-c\C-d" 'wgrep-mark-deletion)
    (define-key map "\C-c\C-e" 'wgrep-finish-edit)
    (define-key map "\C-c\C-p" 'wgrep-toggle-readonly-area)
    (define-key map "\C-c\C-r" 'wgrep-remove-change)
    (define-key map "\C-x\C-s" 'wgrep-finish-edit)
    (define-key map "\C-c\C-u" 'wgrep-remove-all-change)
    (define-key map "\C-c\C-k" 'wgrep-abort-changes)
    (define-key map "\C-x\C-q" 'wgrep-exit)

    (setq wgrep-mode-map map)))

;;;
;;; Entry point
;;;

(defun wgrep-setup-internal ()
  (setq wgrep-original-mode-map (current-local-map))
  (define-key wgrep-original-mode-map
    wgrep-enable-key 'wgrep-change-to-wgrep-mode)
  ;; delete previous wgrep overlays
  (wgrep-cleanup-overlays (point-min) (point-max))
  (remove-hook 'post-command-hook 'wgrep-maybe-echo-error-at-point t)
  (run-hooks 'wgrep-setup-hook))

;;;###autoload
(defun wgrep-setup ()
  "Setup wgrep preparation."
  (cond
   ((and (boundp 'grep-use-null-filename-separator)
         grep-use-null-filename-separator
         ;; FIXME: command may contain "--null" text in search text
         ;; (e.g. grep -nH -e "searching --null argument")
         ;; `grep-use-null-filename-separator' is non-nil
         ;; enough to reduce that confusion.
         (let ((command (car-safe compilation-arguments)))
           (and (stringp command)
                (string-match "[\s\t]--null[\s\t]" command))))
    (set (make-local-variable 'wgrep-line-file-regexp)
         wgrep-null-file-separator-header-regexp))
   (t
    (set (make-local-variable 'wgrep-line-file-regexp)
         wgrep-colon-file-separator-header-regexp)))
  (wgrep-setup-internal))

;;;
;;; activate/deactivate marmalade install or github install.
;;;

;;;###autoload
(add-hook 'grep-setup-hook 'wgrep-setup)

;; For `unload-feature'
(defun wgrep-unload-function ()
  (remove-hook 'grep-setup-hook 'wgrep-setup))

(provide 'wgrep)

;;; wgrep.el ends here