1221 lines
40 KiB
EmacsLisp
1221 lines
40 KiB
EmacsLisp
|
;;; 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
|