diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index b18eb81fee1..867ebc92d75 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2829,6 +2829,53 @@ compilation-find-buffer (current-buffer) (next-error-find-buffer avoid-current 'compilation-buffer-internal-p))) +(defun compilation--update-markers (loc marker screen-columns first-column) + "Update markers in LOC, and set MARKER to location pointed by LOC. +SCREEN-COLUMNS and FIRST-COLUMN are the value of +`compilation-error-screen-columns' and `compilation-first-column' to use +if they are not set buffer-locally in the target buffer." + (with-current-buffer + (if (bufferp (caar (compilation--loc->file-struct loc))) + (caar (compilation--loc->file-struct loc)) + (apply #'compilation-find-file + marker + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc)))) + (let ((screen-columns + ;; Obey the compilation-error-screen-columns of the target + ;; buffer if its major mode set it buffer-locally. + (if (local-variable-p 'compilation-error-screen-columns) + compilation-error-screen-columns screen-columns)) + (compilation-first-column + (if (local-variable-p 'compilation-first-column) + compilation-first-column first-column)) + (last 1)) + (save-restriction + (widen) + (goto-char (point-min)) + ;; Treat file's found lines in forward order, 1 by 1. + (dolist (line (reverse (cddr (compilation--loc->file-struct loc)))) + (when (car line) ; else this is a filename without a line# + (compilation-beginning-of-line (- (car line) last -1)) + (setq last (car line))) + ;; Treat line's found columns and store/update a marker for each. + (dolist (col (cdr line)) + (if (compilation--loc->col col) + (if (eq (compilation--loc->col col) -1) + ;; Special case for range end. + (end-of-line) + (compilation-move-to-column (compilation--loc->col col) + screen-columns)) + (beginning-of-line) + (skip-chars-forward " \t")) + (if (compilation--loc->marker col) + (set-marker (compilation--loc->marker col) (point)) + (setf (compilation--loc->marker col) (point-marker))) + ;; (setf (compilation--loc->timestamp col) timestamp) + )))))) + ;;;###autoload (defun compilation-next-error-function (n &optional reset) "Advance to the next error message and visit the file where the error was. @@ -2838,7 +2885,6 @@ compilation-next-error-function (setq compilation-current-error nil)) (let* ((screen-columns compilation-error-screen-columns) (first-column compilation-first-column) - (last 1) (msg (compilation-next-error (or n 1) nil (or compilation-current-error compilation-messages-start @@ -2850,9 +2896,9 @@ compilation-next-error-function (user-error "No next error")) (setq compilation-current-error (point-marker) overlay-arrow-position - (if (bolp) - compilation-current-error - (copy-marker (line-beginning-position)))) + (if (bolp) + compilation-current-error + (copy-marker (line-beginning-position)))) ;; If loc contains no marker, no error in that file has been visited. ;; If the marker is invalid the buffer has been killed. ;; So, recalculate all markers for that file. @@ -2869,46 +2915,7 @@ compilation-next-error-function ;; (equal (compilation--loc->timestamp loc) ;; (setq timestamp compilation-buffer-modtime))) ) - (with-current-buffer - (if (bufferp (caar (compilation--loc->file-struct loc))) - (caar (compilation--loc->file-struct loc)) - (apply #'compilation-find-file - marker - (caar (compilation--loc->file-struct loc)) - (cadr (car (compilation--loc->file-struct loc))) - (compilation--file-struct->formats - (compilation--loc->file-struct loc)))) - (let ((screen-columns - ;; Obey the compilation-error-screen-columns of the target - ;; buffer if its major mode set it buffer-locally. - (if (local-variable-p 'compilation-error-screen-columns) - compilation-error-screen-columns screen-columns)) - (compilation-first-column - (if (local-variable-p 'compilation-first-column) - compilation-first-column first-column))) - (save-restriction - (widen) - (goto-char (point-min)) - ;; Treat file's found lines in forward order, 1 by 1. - (dolist (line (reverse (cddr (compilation--loc->file-struct loc)))) - (when (car line) ; else this is a filename without a line# - (compilation-beginning-of-line (- (car line) last -1)) - (setq last (car line))) - ;; Treat line's found columns and store/update a marker for each. - (dolist (col (cdr line)) - (if (compilation--loc->col col) - (if (eq (compilation--loc->col col) -1) - ;; Special case for range end. - (end-of-line) - (compilation-move-to-column (compilation--loc->col col) - screen-columns)) - (beginning-of-line) - (skip-chars-forward " \t")) - (if (compilation--loc->marker col) - (set-marker (compilation--loc->marker col) (point)) - (setf (compilation--loc->marker col) (point-marker))) - ;; (setf (compilation--loc->timestamp col) timestamp) - )))))) + (compilation--update-markers loc marker screen-columns first-column)) (compilation-goto-locus marker (compilation--loc->marker loc) (compilation--loc->marker end-loc)) (setf (compilation--loc->visited loc) t))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 657349cbdff..1b1de0ef77d 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -295,6 +295,8 @@ grep-mode-map (define-key map "}" #'compilation-next-file) (define-key map "\t" #'compilation-next-error) (define-key map [backtab] #'compilation-previous-error) + + (define-key map "e" #'grep-edit-minor-mode) map) "Keymap for grep buffers. `compilation-minor-mode-map' is a cdr of this.") @@ -1029,6 +1031,66 @@ grep command-args) #'grep-mode)) +(defun grep-edit--prepare-buffer () + "Mark relevant regions read-only, and add relevant occur text-properties." + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + (dummy (make-marker)) + match) + (while (setq match (text-property-search-forward 'compilation-annotation)) + (add-text-properties (prop-match-beginning match) (prop-match-end match) + '(read-only t))) + (goto-char (point-min)) + (while (setq match (text-property-search-forward 'compilation-message)) + (add-text-properties (prop-match-beginning match) (prop-match-end match) + '(read-only t occur-prefix t)) + (let ((loc (compilation--message->loc (prop-match-value match))) + m) + ;; Update the markers if necessary. + (unless (and (compilation--loc->marker loc) + (marker-buffer (compilation--loc->marker loc))) + (compilation--update-markers loc dummy compilation-error-screen-columns compilation-first-column)) + (setq m (compilation--loc->marker loc)) + (add-text-properties (prop-match-beginning match) + (or (next-single-property-change + (prop-match-end match) + 'compilation-message) + (1+ (pos-eol))) + `(occur-target ((,m . ,m))))))))) + +(defvar grep-edit-minor-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map (kbd "C-c C-c") #'grep-edit-save-changes) + map) + "Keymap for `grep-edit-minor-mode'.") + +(define-minor-mode grep-edit-minor-mode + "Minor mode for editing *grep* buffers. +In this mode, changes to the *grep* buffer are applied to the +originating files." + :lighter " Grep-Edit" + (if (null grep-edit-minor-mode) + (progn + (setq buffer-read-only t) + (buffer-disable-undo) + (remove-hook 'after-change-functions #'occur-after-change-function t) + (use-local-map grep-mode-map)) + (grep-edit--prepare-buffer) + (use-local-map grep-edit-minor-mode-map) + (setq buffer-read-only nil) + (buffer-enable-undo) + (add-hook 'after-change-functions #'occur-after-change-function nil t) + (message (substitute-command-keys + "Editing: \\[grep-edit-save-changes] to return to Grep mode.")))) + +(defun grep-edit-save-changes () + "Switch back to Grep mode." + (interactive) + (when grep-edit-minor-mode + (message "Switching to Grep mode.") + (grep-edit-minor-mode -1))) ;;;###autoload (defun grep-find (command-args)