wgrep.el (40736B)
1 ;;; wgrep.el --- Writable grep buffer -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2010-2020,2023 Masahiro Hayashi 4 ;; Copyright (C) 2002-2009 Matsushita Akihisa <akihisa@mail.ne.jp> 5 6 ;; Author: Masahiro Hayashi <mhayashi1120@gmail.com> 7 ;; Keywords: grep edit extensions 8 ;; URL: http://github.com/mhayashi1120/Emacs-wgrep/raw/master/wgrep.el 9 ;; Emacs: GNU Emacs 25 or later 10 ;; Package-Requires: ((emacs "25.1")) 11 ;; Version: 3.0.0 12 13 ;; This program is free software; you can redistribute it and/or 14 ;; modify it under the terms of the GNU General Public License as 15 ;; published by the Free Software Foundation; either version 3, or (at 16 ;; your option) any later version. 17 18 ;; This program is distributed in the hope that it will be useful, but 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21 ;; General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26 ;; Boston, MA 02110-1301, USA. 27 28 ;;; Commentary: 29 30 ;; ## Summary: 31 32 ;; wgrep allows you to edit a grep buffer and apply those changes to 33 ;; the file buffer like `sed` interactively. No need to learn sed 34 ;; script, just learn Emacs. 35 36 ;; ## Install: 37 38 ;; Put this file into load-path'ed directory, and byte compile it if 39 ;; desired. And put the following expression into your ~/.emacs. 40 ;; 41 ;; (require 'wgrep) 42 43 ;; ## Usage: 44 45 ;; You can edit the text in the *grep* buffer after typing `C-c C-p` . 46 ;; After that the changed text is highlighted. 47 ;; The following keybindings are defined: 48 49 ;; * `C-c C-e`: Apply the changes to file buffers. 50 ;; * `C-c C-u`: All changes are unmarked and ignored. 51 ;; * `C-c C-d`: Mark as delete to current line (including newline). 52 ;; * `C-c C-r`: Remove the changes in the region (these changes are not 53 ;; applied to the files. Of course, the remaining 54 ;; changes can still be applied to the files.) 55 ;; * `C-c C-p`: Toggle read-only area. 56 ;; * `C-c C-k`: Discard all changes and exit. 57 ;; * `C-x C-q`: Exit wgrep mode. 58 59 ;; * To save all buffers that wgrep has changed, run 60 ;; 61 ;; M-x wgrep-save-all-buffers 62 63 ;; * To save buffer automatically when `wgrep-finish-edit'. 64 ;; 65 ;; (setq wgrep-auto-save-buffer t) 66 67 ;; * You can change the default key binding to switch to wgrep. 68 ;; 69 ;; (setq wgrep-enable-key "r") 70 71 ;; * To apply all changes regardless of whether or not buffer is read-only. 72 ;; 73 ;; (setq wgrep-change-readonly-file t) 74 75 ;; ### Trivial features: 76 77 ;; - wdired.el like interface. 78 ;; - Support GNU grep `--context` (`-A` `-B` and `-C`) option. 79 ;; - Can handle too many files. 80 ;; - Can handle newline insertion in *grep* buffer. 81 ;; - Delete whole line include newline. 82 83 ;; ### Similar software: 84 85 ;; [GNU sed](https://www.gnu.org/software/sed/) 86 ;; [helm-ag](https://github.com/syohex/emacs-helm-ag) has a similar feature. 87 88 ;; ## History: 89 90 ;; This program was forked from Matsushita Akihisa's [grep-edit.el 91 ;; v2.11](http://www.bookshelf.jp/elc/grep-edit.el). As this website is 92 ;; now inaccessible, 93 ;; [emacswiki.org's](https://www.emacswiki.org/emacs/grep-edit.el) copy 94 ;; may be consulted. 95 96 ;; Imported version can be downloaded from this orphan commit: 97 ;; https://github.com/mhayashi1120/Emacs-wgrep/tree/import-original-author/ 98 99 ;; Following added implementations and differences. 100 ;; * Support GNU grep context option -A -B and -C 101 ;; * Some bugfix. (wrong coloring text etc..) 102 ;; * wdired.el like interface. 103 ;; * Remove all advice. 104 ;; * Bind to local variables. (grep-a-lot.el works well) 105 ;; * After save buffer, colored face will be removed. 106 ;; * Change face easy to see. 107 ;; * Reinforce checking error. 108 ;; * Support removing whole line include new-line. 109 110 ;;; Code: 111 112 (require 'grep) 113 114 (declare-function image-get-display-property "image-mode.el" ()) 115 (declare-function image-mode-as-text "image-mode.el" ()) 116 117 (defgroup wgrep nil 118 "Customize wgrep" 119 :prefix "wgrep-" 120 :group 'grep) 121 122 ;;; 123 ;;; Variable / Constant 124 ;;; 125 126 ;;;; 127 ;;;; Customize 128 ;;;; 129 130 (defcustom wgrep-change-readonly-file nil 131 "Non-nil means to enable change read-only files." 132 :group 'wgrep 133 :type 'boolean) 134 135 (defcustom wgrep-enable-key "\C-c\C-p" 136 "This variable will be obsoleted in the future release. 137 Key to enable `wgrep-mode'." 138 :group 'wgrep 139 :type 'string) 140 141 (defcustom wgrep-auto-save-buffer nil 142 "Non-nil means do `basic-save-buffer' automatically while `wgrep-finish-edit'." 143 :group 'wgrep 144 :type 'boolean) 145 146 (defcustom wgrep-too-many-file-length 10 147 "Number to detect as too many files." 148 :group 'wgrep 149 :type 'number) 150 151 (defvar wgrep-setup-hook nil 152 "Hooks to run when setting up wgrep.") 153 154 (defvar wgrep-mode-map nil) 155 156 ;;;; 157 ;;;; Internal variable 158 ;;;; 159 160 (defvar wgrep-readonly-state nil) 161 (make-variable-buffer-local 'wgrep-readonly-state) 162 163 (defvar wgrep-prepared nil) 164 (make-variable-buffer-local 'wgrep-prepared) 165 166 (defvar wgrep-sibling-buffer nil) 167 (make-variable-buffer-local 'wgrep-sibling-buffer) 168 169 (defvar wgrep-original-mode-map nil) 170 (make-variable-buffer-local 'wgrep-original-mode-map) 171 172 (defvar wgrep-inhibit-modification-hook nil) 173 174 (defvar wgrep-auto-apply-disk nil 175 "Internal use `wgrep-auto-save-buffer' or too many file is editing.") 176 177 (defvar wgrep-acceptable-modes nil) 178 (make-obsolete 'wgrep-acceptable-modes nil "2.1.1") 179 180 ;; Suppress elint warning 181 ;; GNU Emacs have this variable at least version 21 or later 182 (defvar auto-coding-regexp-alist) 183 184 ;;;; 185 ;;;; Constant 186 ;;;; 187 188 ;; These regexp come from `grep-regexp-alist' at grep.el 189 (eval-and-compile 190 (defconst wgrep-null-file-separator-header-regexp 191 "\\(?1:[^\0\n]+\\)\\(?:\0\\)\\(?3:[0-9]+\\):") 192 193 (defconst wgrep-colon-file-separator-header-regexp 194 "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?3:[1-9][0-9]*\\)[\t ]*:")) 195 196 ;; Generalized regexp, but wrong matching when colon `:' and null `\0' 197 ;; is contained in grep result. 198 (defconst wgrep-default-line-header-regexp 199 (eval-when-compile 200 (concat 201 "^" 202 "\\(?:" 203 ;; `--null' argument is used. 204 wgrep-null-file-separator-header-regexp 205 "\\|" 206 ;; Fallback regexp 207 wgrep-colon-file-separator-header-regexp 208 "\\)"))) 209 210 ;;;; 211 ;;;; Error 212 ;;;; 213 214 (define-error 'wgrep-error "wgrep error") 215 216 ;;;; 217 ;;;; Overridable functions / regexp 218 ;;;; 219 220 (defvar wgrep-line-file-regexp wgrep-default-line-header-regexp 221 "Regexp that match to line header of grep result. 222 223 That capture 1: filename 3: line-number 224 End of this match equals start of file contents. 225 ") 226 227 (defvar wgrep-results-parser 'wgrep-parse-command-results 228 "This function parse line oriented command output and set following properties. 229 `wgrep-line-filename', `wgrep-line-number', `wgrep-ignore' and 230 `wgrep-construct-filename-property' function construct the property name with 231 `wgrep-line-filename' and the value is same. This property is used for searching 232 correct point of filename. 233 Not like `wgrep-header&footer-parser' should not set `read-only' property.") 234 235 ;; Previously named `wgrep-header/footer-parser` this name violate `package-lint` 236 ;; conventions. 237 (defvar wgrep-header&footer-parser 'wgrep-prepare-header&footer 238 "This function should set text properties `read-only' and `wgrep-header' to 239 non editable region.") 240 241 ;;; 242 ;;; Basic utilities 243 ;;; 244 245 ;;;; 246 ;;;; misc 247 ;;;; 248 249 ;;Hack function 250 (defun wgrep-string-replace-bom (string cs) 251 (let ((regexp (car (rassq (coding-system-base cs) auto-coding-regexp-alist))) 252 ;;TODO check ack-grep 253 ;; FIXME: `find-operation-coding-system' is not exactly correct. 254 ;; However almost case is ok like this bom function. 255 ;; e.g. (let ((default-process-coding-system 'some-coding)) 256 ;; (call-interactively 'grep)) 257 (grep-cs (or (find-operation-coding-system 'call-process grep-program) 258 (terminal-coding-system))) 259 str) 260 (if (and regexp 261 (setq str (encode-coding-string string grep-cs)) 262 (string-match regexp str)) 263 (decode-coding-string (substring str (match-end 0)) cs) 264 string))) 265 266 (defun wgrep-delete-whole-line () 267 (delete-region (line-beginning-position) 268 (line-beginning-position 2))) 269 270 (defun wgrep-goto-line (line) 271 (goto-char (point-min)) 272 (forward-line (1- line))) 273 274 (defun wgrep-process-exited-p () 275 (let ((proc (get-buffer-process (current-buffer)))) 276 (or (null proc) 277 (eq (process-status proc) 'exit)))) 278 279 ;;;; 280 ;;;; error 281 ;;;; 282 283 (defun wgrep-check-file (file) 284 (unless (file-exists-p file) 285 (signal 'wgrep-error (list "File does not exist."))) 286 (unless (file-writable-p file) 287 (signal 'wgrep-error (list "File is not writable.")))) 288 289 ;;;; 290 ;;;; overlay 291 ;;;; 292 293 (defun wgrep-cleanup-overlays (beg end) 294 (dolist (ov (overlays-in beg end)) 295 (when (overlay-get ov 'wgrep) 296 (delete-overlay ov)))) 297 298 (defun wgrep-make-overlay (beg end) 299 (let ((o (make-overlay beg end nil nil t))) 300 (overlay-put o 'wgrep t) 301 o)) 302 303 (defun wgrep-file-overlays () 304 (save-restriction 305 (widen) 306 (let (res) 307 (dolist (ov (overlays-in (point-min) (point-max))) 308 (when (overlay-get ov 'wgrep) 309 (setq res (cons ov res)))) 310 (nreverse res)))) 311 312 (defun wgrep-edit-field-overlays () 313 (let (res) 314 (dolist (ov (overlays-in (point-min) (point-max))) 315 (when (overlay-get ov 'wgrep-changed) 316 (setq res (cons ov res)))) 317 (sort res (lambda (x y) (< (overlay-start x) (overlay-start y)))))) 318 319 ;;; 320 ;;; grep result handler 321 ;;; 322 323 (defun wgrep-construct-filename-property (filename) 324 (intern (format "wgrep-fn-%s" filename))) 325 326 (defun wgrep-goto-grep-line (file number) 327 (let ((first (point)) 328 (fprop (wgrep-construct-filename-property file)) 329 fn next) 330 (catch 'found 331 ;; FIXME 332 ;; In a huge buffer, `next-single-property-change' loop make 333 ;; slow down the program. 334 ;; 1. sketchy move by filename (wgrep-fn-* property). 335 ;; 2. search filename and line-number in text property. 336 ;; 3. return to 1. while search is done or EOB. 337 338 (goto-char (point-min)) 339 340 (while (setq next (next-single-property-change (point) fprop)) 341 (goto-char next) 342 (while (and (not (eobp)) 343 (or (null (setq fn (get-text-property 344 (line-beginning-position) 345 'wgrep-line-filename))) 346 (string= fn file))) 347 (when fn 348 (let ((num (get-text-property (point) 'wgrep-line-number)) 349 (start (next-single-property-change (point) 'wgrep-line-number))) 350 (when (eq number num) 351 (goto-char start) 352 (throw 'found t)))) 353 (forward-line 1))) 354 (goto-char first) 355 nil))) 356 357 (defun wgrep-get-old-text (file number) 358 (when (and wgrep-sibling-buffer 359 (buffer-live-p wgrep-sibling-buffer)) 360 (with-current-buffer wgrep-sibling-buffer 361 (when (wgrep-goto-grep-line file number) 362 (buffer-substring-no-properties 363 (point) (line-end-position)))))) 364 365 ;;; 366 ;;; Prepare and parse grep <-> wgrep 367 ;;; 368 369 (defun wgrep-to-original-mode () 370 (kill-local-variable 'query-replace-skip-read-only) 371 (remove-hook 'after-change-functions 'wgrep-after-change-function t) 372 ;; do not remove `wgrep-maybe-echo-error-at-point' that display 373 ;; errors at point 374 (use-local-map wgrep-original-mode-map) 375 (set-buffer-modified-p nil) 376 (setq buffer-undo-list nil) 377 (setq buffer-read-only t)) 378 379 (defun wgrep-goto-first-found () 380 (let ((header (previous-single-property-change (point-max) 'wgrep-header))) 381 (cond 382 (header 383 (goto-char header) 384 header) 385 (t 386 (goto-char (point-min)) 387 (point))))) 388 389 (defun wgrep-goto-end-of-found () 390 (let ((footer (next-single-property-change (point-min) 'wgrep-footer))) 391 (cond 392 (footer 393 (goto-char footer) 394 footer) 395 (t 396 (goto-char (point-max)) 397 (point-max))))) 398 399 (defun wgrep-cleanup-temp-buffer () 400 "Cleanup temp buffer in *grep* buffer." 401 (let ((origin-buffer (current-buffer))) 402 (dolist (buf (buffer-list)) 403 (with-current-buffer buf 404 (when (eq origin-buffer wgrep-sibling-buffer) 405 (kill-buffer buf))))) 406 (setq wgrep-sibling-buffer nil)) 407 408 (defun wgrep-clone-to-temp-buffer () 409 (wgrep-cleanup-temp-buffer) 410 (let ((grepbuf (current-buffer)) 411 (tmpbuf (generate-new-buffer " *wgrep temp* "))) 412 (setq wgrep-sibling-buffer tmpbuf) 413 (add-hook 'kill-buffer-hook 'wgrep-cleanup-temp-buffer nil t) 414 (append-to-buffer tmpbuf (point-min) (point-max)) 415 (with-current-buffer tmpbuf 416 (setq wgrep-sibling-buffer grepbuf)) 417 tmpbuf)) 418 419 (defun wgrep-set-readonly-area (state) 420 (let ((inhibit-read-only t) 421 (wgrep-inhibit-modification-hook t) 422 pos start end) 423 (save-excursion 424 ;; set readonly grep result filename 425 (setq pos (point-min)) 426 (while (setq start (next-single-property-change 427 pos 'wgrep-line-filename)) 428 (setq end (next-single-property-change 429 start 'wgrep-line-filename)) 430 (put-text-property start end 'read-only state) 431 (put-text-property (1- end) end 'rear-nonsticky t) 432 ;; set readonly all newline at end of grep line 433 (when (eq (char-before start) ?\n) 434 (put-text-property (1- start) start 'read-only state)) 435 (setq pos end)) 436 (setq pos (point-min)) 437 (while (setq start (next-single-property-change 438 pos 'wgrep-ignore)) 439 (setq end (next-single-property-change 440 start 'wgrep-ignore)) 441 (put-text-property start end 'read-only state) 442 ;; set readonly all newline at end of grep line 443 (when (eq (char-before start) ?\n) 444 (put-text-property (1- start) start 'read-only state)) 445 (setq pos end)) 446 ;; set readonly last of grep line 447 (let ((footer (or (next-single-property-change (point-min) 'wgrep-footer) 448 ;; to consider empty footer. 449 (point-max)))) 450 (when (eq (char-before footer) ?\n) 451 (put-text-property (1- footer) footer 'read-only state)))) 452 (setq wgrep-readonly-state state))) 453 454 (defun wgrep-prepare-context () 455 (save-restriction 456 (let ((start (wgrep-goto-first-found)) 457 (end (wgrep-goto-end-of-found))) 458 (narrow-to-region start end) 459 (goto-char (point-min)) 460 (funcall wgrep-results-parser)))) 461 462 ;; -A -B -C output may be misunderstood and set read-only. 463 ;; Context match break font-lock if context have at least two `:'. 464 ;; e.g. 465 ;; filename-1-2010-01-01 23:59:99 466 ;; filename:2:hoge 467 ;; filename-3-20:10:25 468 (defun wgrep-prepare-context-while (filename line direction fprop flen) 469 (let* ((next (+ direction line)) 470 (fregexp (regexp-quote filename))) 471 (forward-line direction) 472 (while (looking-at (format "^%s[-\0]%d-" fregexp next)) 473 (let ((start (match-beginning 0)) 474 (end (match-end 0)) 475 (bol (line-beginning-position)) 476 (eol (line-end-position))) 477 (put-text-property start end 'wgrep-line-filename filename) 478 (put-text-property start end 'wgrep-line-number next) 479 (put-text-property start (+ start flen) fprop filename) 480 (remove-text-properties bol eol '(wgrep-ignore)) 481 (forward-line direction) 482 (setq next (+ direction next)))))) 483 484 (defun wgrep-parse-command-results () 485 (let ((cache (make-hash-table))) 486 (while (not (eobp)) 487 (cond 488 ((looking-at wgrep-line-file-regexp) 489 (let* ((fn (match-string-no-properties 1)) 490 (line (string-to-number (match-string 3))) 491 (start (match-beginning 0)) 492 (end (match-end 0)) 493 (fprop (wgrep-construct-filename-property fn)) 494 (flen (length fn))) 495 ;; check relative path grep result 496 ;; grep result may be --context result with number between 2 colon. 497 ;; ./filename-1-:10: 498 ;; that make misunderstand font-locking 499 ;; check file existence decrease risk of the misunderstanding. 500 (when (or (gethash fn cache nil) 501 (and (file-exists-p fn) 502 (puthash fn t cache))) 503 (put-text-property start end 'wgrep-line-filename fn) 504 (put-text-property start end 'wgrep-line-number line) 505 (put-text-property start (+ start flen) fprop fn) 506 ;; handle backward and forward following options. 507 ;; -A (--after-context) -B (--before-context) -C (--context) 508 (save-excursion 509 (wgrep-prepare-context-while fn line -1 fprop flen)) 510 (wgrep-prepare-context-while fn line 1 fprop flen) 511 ;; end of context output `--'. 512 (forward-line -1)))) 513 (t 514 ;; Add property but this may be removed by `wgrep-prepare-context-while' 515 (put-text-property (line-beginning-position) 516 (line-end-position) 517 'wgrep-ignore t))) 518 (forward-line 1)))) 519 520 (defun wgrep-current-file-and-linum () 521 (save-excursion 522 (forward-line 0) 523 (let ((fn (get-text-property (point) 'wgrep-line-filename)) 524 (linum (get-text-property (point) 'wgrep-line-number))) 525 (when (and fn linum) 526 (list fn linum))))) 527 528 (defun wgrep-restore-from-temp-buffer () 529 (cond 530 ((and wgrep-sibling-buffer 531 (buffer-live-p wgrep-sibling-buffer)) 532 (let ((grepbuf (current-buffer)) 533 (tmpbuf wgrep-sibling-buffer) 534 (header (wgrep-current-file-and-linum)) 535 (savedc (current-column)) 536 (savedp (point)) 537 (inhibit-read-only t) 538 (wgrep-inhibit-modification-hook t) 539 buffer-read-only) 540 (erase-buffer) 541 (with-current-buffer tmpbuf 542 (append-to-buffer grepbuf (point-min) (point-max))) 543 (goto-char (point-min)) 544 ;; restore previous cursor 545 (or (and header 546 (apply 'wgrep-goto-grep-line header) 547 (move-to-column savedc)) 548 (goto-char (min (point-max) savedp))) 549 (wgrep-cleanup-temp-buffer))) 550 (t 551 ;; non fatal error 552 (message "Error! Saved buffer is unavailable.")))) 553 554 (defun wgrep-prepare-to-edit () 555 (unless wgrep-prepared 556 (save-excursion 557 (let ((inhibit-read-only t) 558 (wgrep-inhibit-modification-hook t) 559 buffer-read-only) 560 (funcall (or wgrep-header&footer-parser 561 ;; TODO FIXME: workaround compat for previous code. 562 (and (boundp 'wgrep-header/footer-parser) 563 wgrep-header/footer-parser))) 564 (wgrep-prepare-context) 565 (setq wgrep-prepared t))))) 566 567 (defun wgrep-prepare-header&footer () 568 (let (beg end) 569 ;; Set read-only grep result header 570 (goto-char (point-min)) 571 (setq beg (point-min)) 572 ;; See `compilation-start' 573 (forward-line 4) 574 (setq end (point)) 575 (put-text-property beg end 'read-only t) 576 (put-text-property beg end 'wgrep-header t) 577 ;; Set read-only grep result footer 578 (goto-char (point-max)) 579 (forward-line -1) 580 (when (re-search-backward "^$" end t) 581 (setq beg (point)) 582 (setq end (point-max)) 583 (when beg 584 (put-text-property beg end 'read-only t) 585 (put-text-property beg end 'wgrep-footer t))))) 586 587 (defun wgrep-set-header&footer-read-only (state) 588 (let ((inhibit-read-only t) 589 (wgrep-inhibit-modification-hook t)) 590 ;; header 591 (let ((header-end (next-single-property-change (point-min) 'wgrep-header))) 592 (when header-end 593 (put-text-property (point-min) header-end 'read-only state))) 594 ;; footer 595 (let ((footer-beg (next-single-property-change (point-min) 'wgrep-footer))) 596 (when footer-beg 597 (put-text-property footer-beg (point-max) 'read-only state))))) 598 599 ;;; 600 ;;; Editing handlers 601 ;;; 602 603 ;; get overlay BEG and END is passed by `after-change-functions' 604 (defun wgrep-editing-overlay (&optional start end) 605 (let ((beg (or start (line-beginning-position))) 606 (fin (or end (line-end-position))) 607 ov bol eol 608 ;; beginning/end of grep 609 bog eog) 610 (goto-char beg) 611 (setq bol (line-beginning-position)) 612 (goto-char fin) 613 (setq eol (line-end-position)) 614 (catch 'done 615 (dolist (o (overlays-in bol eol)) 616 ;; find overlay that have changed by user. 617 (when (overlay-get o 'wgrep-changed) 618 (setq ov o) 619 (throw 'done o)))) 620 (if ov 621 (setq bog (min beg (overlay-start ov)) 622 eog (max (overlay-end ov) fin)) 623 (setq bog bol 624 eog eol)) 625 (goto-char bog) 626 (cond 627 ;; When handling whole line, BOL equal beginning of edit. 628 ((and (null ov) start (= bog start))) 629 ((get-text-property (point) 'wgrep-line-filename) 630 (let* ((header-end 631 (next-single-property-change (point) 'wgrep-line-filename nil eol)) 632 (filename (get-text-property (point) 'wgrep-line-filename)) 633 (linum (get-text-property (point) 'wgrep-line-number)) 634 (value (buffer-substring-no-properties header-end eog)) 635 contents-begin) 636 (goto-char header-end) 637 (setq contents-begin (point-marker)) 638 ;; create editing overlay 639 (cond 640 ((null ov) 641 (let ((old (wgrep-get-old-text filename linum))) 642 (setq ov (wgrep-make-overlay bog eog)) 643 (overlay-put ov 'wgrep-contents-begin contents-begin) 644 (overlay-put ov 'wgrep-filename filename) 645 (overlay-put ov 'wgrep-linum linum) 646 (overlay-put ov 'wgrep-changed t) 647 (overlay-put ov 'priority 0) 648 (overlay-put ov 'evaporate t) 649 (overlay-put ov 'wgrep-old-text old))) 650 (t 651 (move-overlay ov bog eog))) 652 (overlay-put ov 'wgrep-edit-text value)))) 653 ov)) 654 655 (defun wgrep-after-change-function (beg end _leng-before) 656 (cond 657 (wgrep-inhibit-modification-hook nil) 658 ((= (point-min) (point-max)) 659 ;; cleanup when first executing 660 (wgrep-cleanup-overlays (point-min) (point-max))) 661 (t 662 (wgrep-put-change-face beg end)))) 663 664 (defun wgrep-put-change-face (beg end) 665 (save-excursion 666 ;; `looking-at' may destroy match data while replace by regexp. 667 (save-match-data 668 (let ((ov (wgrep-editing-overlay beg end))) 669 ;; delete overlay if text is same as old value. 670 (cond 671 ;; not a valid point 672 ((null ov)) 673 ((string= (overlay-get ov 'wgrep-old-text) 674 (overlay-get ov 'wgrep-edit-text)) 675 ;; back to unchanged 676 (delete-overlay ov)) 677 (t 678 (overlay-put ov 'face 'wgrep-face))))))) 679 680 ;;; 681 ;;; Save grep buffer to file buffer/disk 682 ;;; 683 684 (defun wgrep-display-physical-data () 685 (cond 686 ;; `funcall' is a trick to suppress the elint warnings. 687 ((derived-mode-p 'image-mode) 688 ;; toggle to raw data if buffer has image. 689 (when (image-get-display-property) 690 (image-mode-as-text))) 691 (t nil))) 692 693 (defun wgrep-set-result (ov face &optional message) 694 (overlay-put ov 'face face) 695 (overlay-put ov 'priority 1) 696 (overlay-put ov 'wgrep-reject-message message)) 697 698 (defun wgrep-put-done-result (ov) 699 (wgrep-set-result ov 'wgrep-done-face)) 700 701 (defun wgrep-put-reject-result (ov error-data) 702 (let ((message (mapconcat (lambda (x) (format "%s" x)) error-data " "))) 703 (wgrep-set-result ov 'wgrep-reject-face message))) 704 705 (defun wgrep-put-reject-result-all (editor error-data) 706 (dolist (edit (cdr editor)) 707 (let ((result (nth 3 edit))) 708 (wgrep-put-reject-result result error-data)))) 709 710 (defun wgrep-after-save-hook () 711 (remove-hook 'after-save-hook 'wgrep-after-save-hook t) 712 (dolist (ov (wgrep-file-overlays)) 713 (delete-overlay ov))) 714 715 (defun wgrep-put-overlay-to-file-buffer (beg end) 716 "*Highlight the changes in the file" 717 (let ((ov 718 (catch 'done 719 (dolist (o (overlays-in beg end)) 720 (when (overlay-get o 'wgrep) 721 (move-overlay o beg end) 722 (throw 'done o))) 723 (wgrep-make-overlay beg end)))) 724 (overlay-put ov 'face 'wgrep-file-face) 725 (overlay-put ov 'priority 0) 726 (add-hook 'after-save-hook 'wgrep-after-save-hook nil t) 727 ov)) 728 729 (defun wgrep-let-destructive-overlay (ov) 730 (dolist (prop '(modification-hooks insert-in-front-hooks insert-behind-hooks)) 731 (overlay-put 732 ov prop 733 `(,(lambda (ov after-p &rest _ignore) 734 (when after-p 735 (delete-overlay ov))))))) 736 737 (defun wgrep-replace-to-new-line (new-text) 738 ;; delete grep extracted region (restricted to a line) 739 (delete-region (line-beginning-position) (line-end-position)) 740 (let ((beg (point))) 741 (insert new-text) 742 (let* ((end (point)) 743 ;; highlight the changed line 744 (ov (wgrep-put-overlay-to-file-buffer beg end))) 745 ;; make overlay volatile. 746 (wgrep-let-destructive-overlay ov)))) 747 748 (defun wgrep-flush-whole-line () 749 (wgrep-put-overlay-to-file-buffer 750 (line-beginning-position) (line-end-position)) 751 (wgrep-delete-whole-line)) 752 753 ;; EDITOR ::= FILE (absolute-path) . EDITS 754 ;; EDITS ::= EDIT [...] 755 ;; EDIT ::= linum-or-marker old-text new-text result-overlay edit-field-overlay 756 (defun wgrep-gather-editor () 757 (let (res) 758 (dolist (edit-field (wgrep-edit-field-overlays)) 759 (goto-char (overlay-start edit-field)) 760 (forward-line 0) 761 (cond 762 ;; ignore removed line or removed overlay 763 ((eq (overlay-start edit-field) (overlay-end edit-field))) 764 ((get-text-property (point) 'wgrep-line-filename) 765 (let* ((name (get-text-property (point) 'wgrep-line-filename)) 766 (linum (get-text-property (point) 'wgrep-line-number)) 767 (start (next-single-property-change 768 (point) 'wgrep-line-filename nil (line-end-position))) 769 (file (expand-file-name name default-directory)) 770 (old (overlay-get edit-field 'wgrep-old-text)) 771 (new (overlay-get edit-field 'wgrep-edit-text)) 772 result) 773 ;; wgrep-result overlay show the committing of this editing 774 (catch 'done 775 (dolist (o (overlays-in (overlay-start edit-field) (overlay-end edit-field))) 776 (when (overlay-get o 'wgrep-result) 777 ;; get existing overlay 778 (setq result o) 779 (throw 'done t))) 780 ;; create overlay to show result of committing 781 (setq result (wgrep-make-overlay start (overlay-end edit-field))) 782 (overlay-put result 'wgrep-result t)) 783 (setq res 784 (cons 785 (list file (list linum old new result edit-field)) 786 res)))))) 787 (nreverse res))) 788 789 (defun wgrep-compute-transaction () 790 (let ((editors (wgrep-gather-editor)) 791 editor-group tran) 792 (dolist (editor editors) 793 (let* ((file (car editor)) 794 (edits (cdr editor)) 795 (editor-cache (assoc file editor-group))) 796 (unless editor-cache 797 (setq editor-cache (cons file nil)) 798 (setq editor-group (cons editor-cache editor-group))) 799 ;; construct with current settings 800 (setcdr editor-cache (append (cdr editor-cache) edits)))) 801 (setq editor-group (nreverse editor-group)) 802 803 ;; Check file accessibility 804 (dolist (editor editor-group) 805 (let ((file (car editor))) 806 (condition-case err 807 (progn 808 (wgrep-check-file file) 809 (setq tran (cons editor tran))) 810 (wgrep-error 811 (wgrep-put-reject-result-all editor (cdr err)))))) 812 813 (nreverse tran))) 814 815 (defun wgrep-compute-linum-to-marker (edits) 816 ;; Convert linum to marker. 817 ;; When new text contains newline destroy linum access. 818 (dolist (edit edits) 819 (let ((linum (car edit))) 820 ;; get a marker 821 (wgrep-goto-line linum) 822 (setcar edit (point-marker))))) 823 824 (defun wgrep-commit-edits (editor) 825 (let ((file (car editor)) 826 (edits (cdr editor))) 827 (wgrep-compute-linum-to-marker edits) 828 (let ((done 0) 829 (first-result nil) 830 (inhibit-read-only wgrep-change-readonly-file)) 831 (dolist (edit edits) 832 (let ((marker (nth 0 edit)) 833 (old (nth 1 edit)) 834 (new (nth 2 edit)) 835 (result-ov (nth 3 edit)) 836 (edit-ov (nth 4 edit))) 837 (condition-case err 838 (progn 839 (unless first-result 840 (setq first-result result-ov)) 841 (wgrep-apply-change marker old new) 842 (wgrep-put-done-result result-ov) 843 (delete-overlay edit-ov) 844 (setq done (1+ done))) 845 (error 846 (wgrep-put-reject-result result-ov (cdr err)))))) 847 (cond 848 ((or (not wgrep-auto-apply-disk) 849 (= done 0))) 850 (buffer-file-name 851 (basic-save-buffer)) 852 (t 853 (let ((coding-system-for-write buffer-file-coding-system)) 854 (write-region (point-min) (point-max) file nil 'no-msg)))) 855 (list done first-result)))) 856 857 (defun wgrep-commit-file (editor) 858 ;; Apply EDITOR to file/buffer. See `wgrep-compute-transaction'. 859 ;; Return succeeded count and first result overlay in *grep* buffer. 860 (let* ((file (car editor)) 861 (open-buffer (get-file-buffer file)) 862 (buffer 863 (cond 864 (open-buffer open-buffer) 865 (wgrep-auto-apply-disk 866 (let ((buf (generate-new-buffer "*TMP <wgrep>*"))) 867 (with-current-buffer buf 868 ;; To detect coding-system and set `buffer-file-coding-system'. 869 (insert-file-contents file)) 870 buf)) 871 (t 872 (find-file-noselect file))))) 873 (unwind-protect 874 (with-current-buffer buffer 875 (save-restriction 876 (widen) 877 (wgrep-display-physical-data) 878 879 (cond 880 ((and (not wgrep-change-readonly-file) 881 buffer-read-only) 882 (wgrep-put-reject-result-all 883 editor 884 (list (format "Buffer \"%s\" is read-only." (buffer-name)))) 885 (list 0 nil)) 886 (t 887 (wgrep-commit-edits editor))))) 888 (when wgrep-auto-apply-disk 889 (when (null open-buffer) 890 (kill-buffer buffer)))))) 891 892 (defun wgrep-apply-change (marker old new) 893 "The changes in the *grep* buffer are applied to the file. 894 NEW may be nil this means deleting whole line." 895 (let ((coding buffer-file-coding-system)) 896 (goto-char marker) 897 ;; check BOM 898 (when (and (= (point-min-marker) marker) 899 coding 900 (coding-system-get coding :bom)) 901 (setq old (wgrep-string-replace-bom old coding)) 902 (when new 903 (setq new (wgrep-string-replace-bom new coding)))) 904 ;; Check buffer line was modified after execute grep. 905 (unless (string= old 906 (buffer-substring-no-properties 907 (line-beginning-position) (line-end-position))) 908 (signal 'wgrep-error (list "Buffer was changed after grep."))) 909 (cond 910 (new 911 (wgrep-replace-to-new-line new)) 912 (t 913 ;; new nil means flush whole line. 914 (wgrep-flush-whole-line))))) 915 916 ;;; 917 ;;; UI 918 ;;; 919 920 (defface wgrep-face 921 '((((class color) 922 (background dark)) 923 (:background "SlateGray1" :foreground "Black")) 924 (((class color) 925 (background light)) 926 (:background "ForestGreen" :foreground "white")) 927 (t 928 ())) 929 "*Face used for the changed text in the grep buffer." 930 :group 'wgrep) 931 932 (defface wgrep-delete-face 933 '((((class color) 934 (background dark)) 935 (:background "SlateGray1" :foreground "pink")) 936 (((class color) 937 (background light)) 938 (:background "ForestGreen" :foreground "pink")) 939 (t 940 ())) 941 "*Face used for the deleted whole line in the grep buffer." 942 :group 'wgrep) 943 944 (defface wgrep-file-face 945 '((((class color) 946 (background dark)) 947 (:background "gray30" :foreground "white")) 948 (((class color) 949 (background light)) 950 (:background "ForestGreen" :foreground "white")) 951 (t 952 ())) 953 "*Face used for the changed text in the file buffer." 954 :group 'wgrep) 955 956 (defface wgrep-reject-face 957 '((((class color) 958 (background dark)) 959 (:foreground "HotPink" :weight bold)) 960 (((class color) 961 (background light)) 962 (:foreground "Red" :weight bold)) 963 (t 964 ())) 965 "*Face used for the line in the grep buffer that can not be applied to 966 a file." 967 :group 'wgrep) 968 969 (defface wgrep-done-face 970 '((((class color) 971 (background dark)) 972 (:foreground "LightSkyBlue")) 973 (((class color) 974 (background light)) 975 (:foreground "Blue")) 976 (t 977 ())) 978 "*Face used for the line in the grep buffer that can be applied to a file." 979 :group 'wgrep) 980 981 (defun wgrep-maybe-echo-error-at-point () 982 (when (null (current-message)) 983 (let ((ov (catch 'found 984 (dolist (o (overlays-in (line-beginning-position) 985 (line-end-position))) 986 (when (overlay-get o 'wgrep-reject-message) 987 (throw 'found o)))))) 988 (when ov 989 (let (message-log-max) 990 (message "%s" (overlay-get ov 'wgrep-reject-message))))))) 991 992 ;;; 993 ;;; Commands 994 ;;; 995 996 (defun wgrep-finish-edit () 997 "Apply changes to file buffers. 998 These changes are not immediately saved to disk unless 999 `wgrep-auto-save-buffer' is non-nil." 1000 (interactive) 1001 (let* ((tran (wgrep-compute-transaction)) 1002 (all-length (length tran)) 1003 (wgrep-auto-apply-disk nil) 1004 (done 0)) 1005 (cond 1006 (wgrep-auto-save-buffer 1007 (setq wgrep-auto-apply-disk t)) 1008 ((> all-length wgrep-too-many-file-length) 1009 (when (y-or-n-p (eval-when-compile 1010 (concat 1011 "Edited files are too many." 1012 " Apply the changes to disk with non-confirmation?"))) 1013 (setq wgrep-auto-apply-disk t)))) 1014 (while tran 1015 (let* ((editor (car tran)) 1016 (committed (wgrep-commit-file editor)) 1017 (count (nth 0 committed)) 1018 (result (nth 1 committed))) 1019 (when result 1020 (goto-char (overlay-start result)) 1021 (forward-line 0)) 1022 (setq done (+ done count)) 1023 (setq tran (cdr tran)) 1024 (let (message-log-max) 1025 (message "Writing %d files, %d files are left..." 1026 all-length (length tran))) 1027 (redisplay t))) 1028 (wgrep-cleanup-temp-buffer) 1029 (wgrep-to-original-mode) 1030 (let ((msg (format "(%d changed)" done)) 1031 (ovs (wgrep-edit-field-overlays))) 1032 (cond 1033 ((null ovs) 1034 (if (= done 0) 1035 (message "(No changes to be performed)") 1036 (message "Successfully finished. %s" msg))) 1037 ((= (length ovs) 1) 1038 (message "There is an unapplied change. %s" msg)) 1039 (t 1040 (message "There are %d unapplied changes. %s" 1041 (length ovs) msg)))))) 1042 1043 (defun wgrep-exit () 1044 "Return to original mode." 1045 (interactive) 1046 (if (and (buffer-modified-p) 1047 (y-or-n-p (format "Buffer %s modified; save changes? " 1048 (current-buffer)))) 1049 (wgrep-finish-edit) 1050 (wgrep-abort-changes))) 1051 1052 (defun wgrep-abort-changes () 1053 "Discard all changes and return to original mode." 1054 (interactive) 1055 (wgrep-cleanup-overlays (point-min) (point-max)) 1056 (wgrep-restore-from-temp-buffer) 1057 (wgrep-to-original-mode) 1058 (message "Changes discarded")) 1059 1060 (defun wgrep-remove-change (beg end) 1061 "Remove changes in the region between BEG and END." 1062 (interactive "r") 1063 (wgrep-cleanup-overlays beg end) 1064 (setq mark-active nil)) 1065 1066 (defun wgrep-remove-all-change () 1067 "Remove changes in the whole buffer." 1068 (interactive) 1069 (wgrep-cleanup-overlays (point-min) (point-max))) 1070 1071 (defun wgrep-toggle-readonly-area () 1072 "Toggle read-only area to remove a whole line. 1073 1074 See the following example: you obviously don't want to edit the first line. 1075 If grep matches a lot of lines, it's hard to edit the grep buffer. 1076 After toggling to editable, you can call 1077 `delete-matching-lines', `delete-non-matching-lines'. 1078 1079 Example: 1080 ---------------------------------------------- 1081 ./.svn/text-base/some.el.svn-base:87:(hoge) 1082 ./some.el:87:(hoge) 1083 ---------------------------------------------- 1084 " 1085 (interactive) 1086 (let ((modified (buffer-modified-p)) 1087 (read-only (not wgrep-readonly-state))) 1088 (wgrep-set-readonly-area read-only) 1089 (wgrep-set-header&footer-read-only read-only) 1090 (set-buffer-modified-p modified) 1091 (if wgrep-readonly-state 1092 (message "Removing the whole line is now disabled.") 1093 (message "Removing the whole line is now enabled.")))) 1094 1095 (defun wgrep-change-to-wgrep-mode () 1096 "Change to wgrep mode. 1097 1098 When the *grep* buffer is huge, this might freeze your Emacs 1099 for several minutes. 1100 " 1101 (interactive) 1102 (unless (wgrep-process-exited-p) 1103 (error "Active process working")) 1104 (wgrep-prepare-to-edit) 1105 (wgrep-set-readonly-area t) 1106 (set (make-local-variable 'query-replace-skip-read-only) t) 1107 (add-hook 'after-change-functions 'wgrep-after-change-function nil t) 1108 (add-hook 'post-command-hook 'wgrep-maybe-echo-error-at-point nil t) 1109 (use-local-map wgrep-mode-map) 1110 (buffer-disable-undo) 1111 (wgrep-clone-to-temp-buffer) 1112 (setq buffer-read-only nil) 1113 (buffer-enable-undo) 1114 ;; restore modified status 1115 (set-buffer-modified-p (wgrep-edit-field-overlays)) 1116 (setq buffer-undo-list nil) 1117 (message "%s" (substitute-command-keys 1118 "Press \\[wgrep-finish-edit] when finished \ 1119 or \\[wgrep-abort-changes] to abort changes."))) 1120 1121 (defun wgrep-save-all-buffers () 1122 "Save the buffers that wgrep changed." 1123 (interactive) 1124 (let ((count 0)) 1125 (dolist (b (buffer-list)) 1126 (with-current-buffer b 1127 (let ((ovs (wgrep-file-overlays))) 1128 (when (and ovs (buffer-modified-p)) 1129 (basic-save-buffer) 1130 (setq count (1+ count)))))) 1131 (cond 1132 ((= count 0) 1133 (message "No buffer has been saved.")) 1134 ((= count 1) 1135 (message "Buffer has been saved.")) 1136 (t 1137 (message "%d buffers have been saved." count))))) 1138 1139 (defun wgrep-mark-deletion () 1140 "Mark as delete to current line. 1141 This change will be applied when \\[wgrep-finish-edit]." 1142 (interactive) 1143 (save-excursion 1144 (let ((ov (wgrep-editing-overlay))) 1145 (unless ov 1146 (error "Not a grep result")) 1147 (condition-case nil 1148 (progn 1149 (overlay-put ov 'wgrep-edit-text nil) 1150 (let ((wgrep-inhibit-modification-hook t) 1151 (begin (overlay-get ov 'wgrep-contents-begin)) 1152 (end (overlay-end ov))) 1153 (delete-region begin end) 1154 (overlay-put ov 'face 'wgrep-delete-face))) 1155 (error 1156 (delete-overlay ov)))))) 1157 1158 (unless wgrep-mode-map 1159 (let ((map (make-sparse-keymap))) 1160 1161 (define-key map "\C-c\C-c" 'wgrep-finish-edit) 1162 (define-key map "\C-c\C-d" 'wgrep-mark-deletion) 1163 (define-key map "\C-c\C-e" 'wgrep-finish-edit) 1164 (define-key map "\C-c\C-p" 'wgrep-toggle-readonly-area) 1165 (define-key map "\C-c\C-r" 'wgrep-remove-change) 1166 (define-key map "\C-x\C-s" 'wgrep-finish-edit) 1167 (define-key map "\C-c\C-u" 'wgrep-remove-all-change) 1168 (define-key map "\C-c\C-k" 'wgrep-abort-changes) 1169 (define-key map "\C-x\C-q" 'wgrep-exit) 1170 1171 (setq wgrep-mode-map map))) 1172 1173 ;;; 1174 ;;; Entry point 1175 ;;; 1176 1177 (defun wgrep-setup-internal () 1178 (setq wgrep-original-mode-map (current-local-map)) 1179 (define-key wgrep-original-mode-map 1180 wgrep-enable-key 'wgrep-change-to-wgrep-mode) 1181 ;; delete previous wgrep overlays 1182 (wgrep-cleanup-overlays (point-min) (point-max)) 1183 (remove-hook 'post-command-hook 'wgrep-maybe-echo-error-at-point t) 1184 (run-hooks 'wgrep-setup-hook)) 1185 1186 ;;;###autoload 1187 (defun wgrep-setup () 1188 "Setup wgrep preparation." 1189 (cond 1190 ((and (boundp 'grep-use-null-filename-separator) 1191 grep-use-null-filename-separator 1192 ;; FIXME: command may contain "--null" text in search text 1193 ;; (e.g. grep -nH -e "searching --null argument") 1194 ;; `grep-use-null-filename-separator' is non-nil 1195 ;; enough to reduce that confusion. 1196 (let ((command (car-safe compilation-arguments))) 1197 (and (stringp command) 1198 (string-match "[\s\t]--null[\s\t]" command)))) 1199 (set (make-local-variable 'wgrep-line-file-regexp) 1200 wgrep-null-file-separator-header-regexp)) 1201 (t 1202 (set (make-local-variable 'wgrep-line-file-regexp) 1203 wgrep-colon-file-separator-header-regexp))) 1204 (wgrep-setup-internal)) 1205 1206 ;;; 1207 ;;; activate/deactivate marmalade install or github install. 1208 ;;; 1209 1210 ;;;###autoload 1211 (add-hook 'grep-setup-hook 'wgrep-setup) 1212 1213 ;; For `unload-feature' 1214 (defun wgrep-unload-function () 1215 (remove-hook 'grep-setup-hook 'wgrep-setup)) 1216 1217 (provide 'wgrep) 1218 1219 ;;; wgrep.el ends here