wgrep.el

;;; wgrep.el --- Writable grep buffer and apply the changes to files

;; Author: Masahiro Hayashi <mhayashi1120@gmail.com>
;; Keywords: grep edit extensions
;; URL: http://github.com/mhayashi1120/Emacs-wgrep/raw/master/wgrep.el
;; Emacs: GNU Emacs 22 or later
;; Version: 2.1.10

;; 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:

;; wgrep allows you to edit a grep buffer and apply those changes to
;; the file buffer.

;;; 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 wheather or not buffer is read-only.
;;
;; (setq wgrep-change-readonly-file t)

;;; History:

;; This program is a forked version. the original version can be downloaded from
;; http://www.bookshelf.jp/elc/grep-edit.el

;; 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)

(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 `save-buffer' automatically while `wgrep-finish-edit'."
  :group 'wgrep
  :type 'boolean)

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

(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)

(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)

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

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

(defconst wgrep-default-line-header-regexp
  ;; This regexp come from Emacs-25 grep.el
  ;; Capture subexp 2 is still exists for the backward compatibility.
  ;; But will be removed in future release.
  "^\\(.*?[^/\n]\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)[ \t]*:")

(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)
(defvar wgrep-header/footer-parser 'wgrep-prepare-header/footer)

(defvar wgrep-inhibit-modification-hook nil)

(defvar wgrep-mode-map nil)
(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-[" '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)))

;;;###autoload
(defun wgrep-setup ()
  "Setup wgrep preparation."
  (wgrep-setup-internal))

(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))

(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)))))))

(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-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))))

(put 'wgrep-error 'error-conditions '(wgrep-error error))
(put 'wgrep-error 'error-message "wgrep error")

(defun wgrep-get-file-buffer (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.")))
  (or (get-file-buffer file)
      (find-file-noselect file)))

(defun wgrep-check-buffer ()
  "Check the file's status. If it is possible to change the file, return t"
  (when (and (not wgrep-change-readonly-file)
             buffer-read-only)
    (signal 'wgrep-error
            (list (format "Buffer \"%s\" is read-only." (buffer-name))))))

(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-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-after-save-hook ()
  (remove-hook 'after-save-hook 'wgrep-after-save-hook t)
  (dolist (ov (wgrep-file-overlays))
    (delete-overlay ov)))

(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-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))
        end)
    (insert new-text)
    (let* ((end (point))
           ;; hilight 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))

;;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-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-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-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-edit-overlays ()
  (let (res)
    (dolist (ov (overlays-in (point-min) (point-max)))
      (when (overlay-get ov 'wgrep-changed)
        (setq res (cons ov res))))
    (nreverse res)))

(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)))))))

;; 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-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-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 ((all-tran (wgrep-compute-transaction))
        done)
    (dolist (buf-tran all-tran)
      (let ((commited (wgrep-commit-buffer (car buf-tran) (cdr buf-tran))))
        (setq done (append done commited))))
    (wgrep-cleanup-temp-buffer)
    (wgrep-to-original-mode)
    (let ((msg (format "(%d changed)" (length done)))
          (ovs (wgrep-edit-overlays)))
      (cond
       ((null ovs)
        (if (= (length 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-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))))))

(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))))

(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))
               (fstart (match-beginning 1))
               (fend (match-end 1))
               (lstart (match-beginning 3))
               (lend (match-end 3))
               (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-delete-whole-line ()
  (delete-region (line-beginning-position) (line-beginning-position 2)))

(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-goto-line (line)
  (goto-char (point-min))
  (forward-line (1- line)))

;; -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-%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-construct-filename-property (filename)
  (intern (format "wgrep-fn-%s" filename)))

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

(defun wgrep-prepare-to-edit ()
  (unless wgrep-prepared
    (save-excursion
      (let ((inhibit-read-only t)
            (wgrep-inhibit-modification-hook t)
            buffer-read-only)
        (funcall 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)))))

(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-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-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-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-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-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))))))

(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)))

;; return alist like following
;; key ::= buffer
;; value ::= linum old-text new-text result-overlay edit-overlay
(defun wgrep-transaction-editing-list ()
  (let (res)
    (dolist (ov (wgrep-edit-overlays))
      (goto-char (overlay-start ov))
      (forward-line 0)
      (cond
       ;; ignore removed line or removed overlay
       ((eq (overlay-start ov) (overlay-end ov)))
       ((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))
               (file-error nil)
               (buffer (condition-case err
                           (wgrep-get-file-buffer file)
                         (wgrep-error
                          (setq file-error (cdr err))
                          nil)))
               (old (overlay-get ov 'wgrep-old-text))
               (new (overlay-get ov 'wgrep-edit-text))
               result)
          ;; wgrep-result overlay show the commiting of this editing
          (catch 'done
            (dolist (o (overlays-in (overlay-start ov) (overlay-end ov)))
              (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 ov)))
            (overlay-put result 'wgrep-result t))
          (if file-error
              (wgrep-put-reject-result result file-error)
            (setq res
                  (cons
                   (list buffer linum old new result ov)
                   res)))))))
    (nreverse res)))

(defun wgrep-compute-transaction ()
  (let ((edit-list (wgrep-transaction-editing-list))
        ;; key ::= buffer
        ;; value ::= edit [edit ...]
        ;; edit ::= linum old-text new-text result-overlay edit-overlay
        all-tran)
    (dolist (x edit-list)
      (let* ((buffer (car x))
             (edit (cdr x))
             (pair (assq buffer all-tran)))
        (unless pair
          (setq pair (cons buffer nil))
          (setq all-tran (cons pair all-tran)))
        ;; construct with current settings
        (setcdr pair (cons edit (cdr pair)))))
    ;; Convert linum to marker.
    ;; When new text contains newline destroy linum access.
    (dolist (buffer-tran all-tran)
      (let ((buffer (car buffer-tran))
            (edit-tran (cdr buffer-tran)))
        (with-current-buffer buffer
          (save-restriction
            (widen)
            (dolist (edit edit-tran)
              (let ((linum (car edit)))
                ;; get a marker
                (wgrep-goto-line linum)
                (setcar edit (point-marker))))))))
    all-tran))

(defun wgrep-commit-buffer (buffer tran)
  ;; Apply TRAN to BUFFER.
  ;; See `wgrep-compute-transaction'
  (with-current-buffer buffer
    (save-restriction
      (widen)
      (wgrep-display-physical-data)
      (let ((inhibit-read-only wgrep-change-readonly-file)
            done)
        (dolist (info tran)
          (let ((marker (nth 0 info))
                (old (nth 1 info))
                (new (nth 2 info))
                (result (nth 3 info))
                (ov (nth 4 info)))
            (condition-case err
                (progn
                  ;; check the buffer while each of overlays
                  ;; to set a result message.
                  (wgrep-check-buffer)
                  (wgrep-apply-change marker old new)
                  (wgrep-put-done-result result)
                  (delete-overlay ov)
                  (setq done (cons ov done)))
              (error
               (wgrep-put-reject-result result (cdr err))))))
        (when (and wgrep-auto-save-buffer done)
          (basic-save-buffer))
        (nreverse done)))))

(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)))))

;;;
;;; 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