diff options
Diffstat (limited to 'lisp/vc/diff-mode.el')
| -rw-r--r-- | lisp/vc/diff-mode.el | 287 |
1 files changed, 175 insertions, 112 deletions
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index cd1e1b9d087..511cc89778d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -55,6 +55,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) +(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-find-revision-no-save "vc") @@ -162,57 +163,55 @@ and hunk-based syntax highlighting otherwise as a fallback." ;;;; keymap, menu, ... ;;;; -(easy-mmode-defmap diff-mode-shared-map - '(("n" . diff-hunk-next) - ("N" . diff-file-next) - ("p" . diff-hunk-prev) - ("P" . diff-file-prev) - ("\t" . diff-hunk-next) - ([backtab] . diff-hunk-prev) - ("k" . diff-hunk-kill) - ("K" . diff-file-kill) - ("}" . diff-file-next) ; From compilation-minor-mode. - ("{" . diff-file-prev) - ("\C-m" . diff-goto-source) - ([mouse-2] . diff-goto-source) - ("W" . widen) - ("o" . diff-goto-source) ; other-window - ("A" . diff-ediff-patch) - ("r" . diff-restrict-view) - ("R" . diff-reverse-direction) - ([remap undo] . diff-undo)) - "Basic keymap for `diff-mode', bound to various prefix keys." - :inherit special-mode-map) - -(easy-mmode-defmap diff-mode-map - `(("\e" . ,(let ((map (make-sparse-keymap))) - ;; We want to inherit most bindings from diff-mode-shared-map, - ;; but not all since they may hide useful M-<foo> global - ;; bindings when editing. - (set-keymap-parent map diff-mode-shared-map) - (dolist (key '("A" "r" "R" "g" "q" "W" "z")) - (define-key map key nil)) - map)) - ;; From compilation-minor-mode. - ("\C-c\C-c" . diff-goto-source) - ;; By analogy with the global C-x 4 a binding. - ("\C-x4A" . diff-add-change-log-entries-other-window) - ;; Misc operations. - ("\C-c\C-a" . diff-apply-hunk) - ("\C-c\C-e" . diff-ediff-patch) - ("\C-c\C-n" . diff-restrict-view) - ("\C-c\C-s" . diff-split-hunk) - ("\C-c\C-t" . diff-test-hunk) - ("\C-c\C-r" . diff-reverse-direction) - ("\C-c\C-u" . diff-context->unified) - ;; `d' because it duplicates the context :-( --Stef - ("\C-c\C-d" . diff-unified->context) - ("\C-c\C-w" . diff-ignore-whitespace-hunk) - ;; `l' because it "refreshes" the hunk like C-l refreshes the screen - ("\C-c\C-l" . diff-refresh-hunk) - ("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-( - ("\C-c\C-f" . next-error-follow-minor-mode)) - "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") +(defvar-keymap diff-mode-shared-map + :parent special-mode-map + "n" #'diff-hunk-next + "N" #'diff-file-next + "p" #'diff-hunk-prev + "P" #'diff-file-prev + "TAB" #'diff-hunk-next + "<backtab>" #'diff-hunk-prev + "k" #'diff-hunk-kill + "K" #'diff-file-kill + "}" #'diff-file-next ; From compilation-minor-mode. + "{" #'diff-file-prev + "RET" #'diff-goto-source + "<mouse-2>" #'diff-goto-source + "W" #'widen + "o" #'diff-goto-source ; other-window + "A" #'diff-ediff-patch + "r" #'diff-restrict-view + "R" #'diff-reverse-direction + "<remap> <undo>" #'diff-undo) + +(defvar-keymap diff-mode-map + :doc "Keymap for `diff-mode'. See also `diff-mode-shared-map'." + "ESC" (let ((map (define-keymap :parent diff-mode-shared-map))) + ;; We want to inherit most bindings from + ;; `diff-mode-shared-map', but not all since they may hide + ;; useful `M-<foo>' global bindings when editing. + (dolist (key '("A" "r" "R" "g" "q" "W" "z")) + (keymap-set map key nil)) + map) + ;; From compilation-minor-mode. + "C-c C-c" #'diff-goto-source + ;; By analogy with the global C-x 4 a binding. + "C-x 4 A" #'diff-add-change-log-entries-other-window + ;; Misc operations. + "C-c C-a" #'diff-apply-hunk + "C-c C-e" #'diff-ediff-patch + "C-c C-n" #'diff-restrict-view + "C-c C-s" #'diff-split-hunk + "C-c C-t" #'diff-test-hunk + "C-c C-r" #'diff-reverse-direction + "C-c C-u" #'diff-context->unified + ;; `d' because it duplicates the context :-( --Stef + "C-c C-d" #'diff-unified->context + "C-c C-w" #'diff-ignore-whitespace-hunk + ;; `l' because it "refreshes" the hunk like C-l refreshes the screen + "C-c C-l" #'diff-refresh-hunk + "C-c C-b" #'diff-refine-hunk ;No reason for `b' :-( + "C-c C-f" #'next-error-follow-minor-mode) (easy-menu-define diff-mode-menu diff-mode-map "Menu for `diff-mode'." @@ -267,11 +266,12 @@ and hunk-based syntax highlighting otherwise as a fallback." (defcustom diff-minor-mode-prefix "\C-c=" "Prefix key for `diff-minor-mode' commands." - :type '(choice (string "\e") (string "C-c=") string)) + :type '(choice (string "ESC") + (string "\C-c=") string)) -(easy-mmode-defmap diff-minor-mode-map - `((,diff-minor-mode-prefix . ,diff-mode-shared-map)) - "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.") +(defvar-keymap diff-minor-mode-map + :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." + (key-description diff-minor-mode-prefix) diff-mode-shared-map) (define-minor-mode diff-auto-refine-mode "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). @@ -894,6 +894,9 @@ data such as \"Index: ...\" and such." ;; Fix the original hunk-header. (diff-fixup-modifs start pos)))) +(defun diff--outline-level () + (if (string-match-p diff-hunk-header-re (match-string 0)) + 2 1)) ;;;; ;;;; jump to other buffers @@ -1476,6 +1479,14 @@ See `after-change-functions' for the meaning of BEG, END and LEN." (defvar whitespace-style) (defvar whitespace-trailing-regexp) +(defvar-local diff-mode-read-only nil + "Non-nil when read-only diff buffer uses short keys.") + +;; It should be lower than `outline-minor-mode' and `view-mode'. +(or (assq 'diff-mode-read-only minor-mode-map-alist) + (nconc minor-mode-map-alist + (list (cons 'diff-mode-read-only diff-mode-shared-map)))) + ;;;###autoload (define-derived-mode diff-mode fundamental-mode "Diff" "Major mode for viewing/editing context diffs. @@ -1494,7 +1505,6 @@ a diff with \\[diff-reverse-direction]. (setq-local font-lock-defaults diff-font-lock-defaults) (add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local) - (setq-local outline-regexp diff-outline-regexp) (setq-local imenu-generic-expression diff-imenu-generic-expression) ;; These are not perfect. They would be better done separately for @@ -1514,23 +1524,23 @@ a diff with \\[diff-reverse-direction]. (diff-setup-whitespace) - (if diff-default-read-only - (setq buffer-read-only t)) + ;; read-only setup + (when diff-default-read-only + (setq buffer-read-only t)) + (when buffer-read-only + (setq diff-mode-read-only t)) + (add-hook 'read-only-mode-hook + (lambda () + (setq diff-mode-read-only buffer-read-only)) + nil t) + ;; setup change hooks (if (not diff-update-on-the-fly) (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) (make-local-variable 'diff-unhandled-changes) (add-hook 'after-change-functions #'diff-after-change-function nil t) (add-hook 'post-command-hook #'diff-post-command-hook nil t)) - ;; Neat trick from Dave Love to add more bindings in read-only mode: - (let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map))) - (add-to-list 'minor-mode-overriding-map-alist ro-bind) - ;; Turn off this little trick in case the buffer is put in view-mode. - (add-hook 'view-mode-hook - (lambda () - (setq minor-mode-overriding-map-alist - (delq ro-bind minor-mode-overriding-map-alist))) - nil t)) + ;; add-log support (setq-local add-log-current-defun-function #'diff-current-defun) (setq-local add-log-buffer-file-name-function @@ -1539,11 +1549,7 @@ a diff with \\[diff-reverse-direction]. #'diff--filter-substring) (unless buffer-file-name (hack-dir-local-variables-non-file-buffer)) - (save-excursion - (setq-local diff-buffer-type - (if (re-search-forward "^diff --git" nil t) - 'git - nil)))) + (diff-setup-buffer-type)) ;;;###autoload (define-minor-mode diff-minor-mode @@ -1579,6 +1585,21 @@ modified lines of the diff." "^[-+!] .*?\\([\t ]+\\)$" "^[-+!<>].*?\\([\t ]+\\)$")))) +(defun diff-setup-buffer-type () + "Try to guess the `diff-buffer-type' from content of current Diff mode buffer. +`outline-regexp' is updated accordingly." + (save-excursion + (goto-char (point-min)) + (setq-local diff-buffer-type + (if (re-search-forward "^diff --git" nil t) + 'git + nil))) + (when (eq diff-buffer-type 'git) + (setq diff-outline-regexp + (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)"))) + (setq-local outline-level #'diff--outline-level) + (setq-local outline-regexp diff-outline-regexp)) + (defun diff-delete-if-empty () ;; An empty diff file means there's no more diffs to integrate, so we ;; can just remove the file altogether. Very handy for .rej files if we @@ -2251,21 +2272,24 @@ Return new point, if it was moved." "Iterate over all hunks between point and MAX. Call FUN with two args (BEG and END) for each hunk." (save-excursion - (let* ((beg (or (ignore-errors (diff-beginning-of-hunk)) - (ignore-errors (diff-hunk-next) (point)) - max))) - (while (< beg max) - (goto-char beg) - (cl-assert (looking-at diff-hunk-header-re)) - (let ((end - (save-excursion (diff-end-of-hunk) (point)))) - (cl-assert (< beg end)) - (funcall fun beg end) - (goto-char end) - (setq beg (if (looking-at diff-hunk-header-re) - end - (or (ignore-errors (diff-hunk-next) (point)) - max)))))))) + (catch 'malformed + (let* ((beg (or (ignore-errors (diff-beginning-of-hunk)) + (ignore-errors (diff-hunk-next) (point)) + max))) + (while (< beg max) + (goto-char beg) + (unless (looking-at diff-hunk-header-re) + (throw 'malformed nil)) + (let ((end + (save-excursion (diff-end-of-hunk) (point)))) + (unless (< beg end) + (throw 'malformed nil)) + (funcall fun beg end) + (goto-char end) + (setq beg (if (looking-at diff-hunk-header-re) + end + (or (ignore-errors (diff-hunk-next) (point)) + max))))))))) (defun diff--font-lock-refined (max) "Apply hunk refinement from font-lock." @@ -2579,37 +2603,75 @@ fixed, visit it in a buffer." (save-excursion ;; FIXME: Include the first space for context-style hunks! (while (re-search-forward "^[-+! ]" limit t) - (let ((spec (alist-get (char-before) - '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) - (?- . (left-fringe diff-fringe-del diff-indicator-removed)) - (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) - (?\s . (left-fringe diff-fringe-nul fringe)))))) - (put-text-property (match-beginning 0) (match-end 0) 'display spec)))) + (unless (eq (get-text-property (match-beginning 0) 'face) 'diff-header) + (let ((spec + (alist-get + (char-before) + '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) + (?- . (left-fringe diff-fringe-del diff-indicator-removed)) + (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) + (?\s . (left-fringe diff-fringe-nul fringe)))))) + (put-text-property (match-beginning 0) (match-end 0) + 'display spec))))) ;; Mimicks the output of Magit's diff. ;; FIXME: This has only been tested with Git's diff output. + ;; FIXME: Add support for Git's "rename from/to"? (while (re-search-forward "^diff " limit t) - ;; FIXME: Switching between context<->unified leads to messed up - ;; file headers by cutting the `display' property in chunks! + ;; We split the regexp match into a search plus a looking-at because + ;; we want to use LIMIT for the search but we still want to match + ;; all the header's lines even if LIMIT falls in the middle of it. (when (save-excursion (forward-line 0) (looking-at (eval-when-compile - (concat "diff.*\n" - "\\(?:\\(?:new file\\|deleted\\).*\n\\)?" - "\\(?:index.*\n\\)?" - "--- \\(?:" null-device "\\|a/\\(.*\\)\\)\n" - "\\+\\+\\+ \\(?:" null-device "\\|b/\\(.*\\)\\)\n")))) - (put-text-property (match-beginning 0) - (or (match-beginning 2) (match-beginning 1)) - 'display (propertize - (cond - ((null (match-beginning 1)) "new file ") - ((null (match-beginning 2)) "deleted ") - (t "modified ")) - 'face '(diff-file-header diff-header))) - (unless (match-beginning 2) - (put-text-property (match-end 1) (1- (match-end 0)) - 'display ""))))) + (let* ((index "\\(?:index.*\n\\)?") + (file4 (concat + "\\(?:" null-device "\\|[ab]/\\(?4:.*\\)\\)")) + (file5 (concat + "\\(?:" null-device "\\|[ab]/\\(?5:.*\\)\\)")) + (header (concat "--- " file4 "\n" + "\\+\\+\\+ " file5 "\n")) + (binary (concat + "Binary files " file4 + " and " file5 " \\(?7:differ\\)\n")) + (horb (concat "\\(?:" header "\\|" binary "\\)"))) + (concat "diff.*?\\(?: a/\\(.*?\\) b/\\(.*\\)\\)?\n" + "\\(?:\\(?:old\\|new\\) mode .*\n\\)*" + "\\(?:" + ;; For new/deleted files, there might be no + ;; header (and no hunk) if the file is/was empty. + "\\(?3:new\\(?6:\\)\\|deleted\\) file.*\n" + index "\\(?:" horb "\\)?" + ;; Normal case. + "\\|" index horb "\\)"))))) + ;; The file names can be extracted either from the `diff' line + ;; or from the two header lines. Prefer the header line info if + ;; available since the `diff' line is ambiguous in case the + ;; file names include " b/" or " a/". + ;; FIXME: This prettification throws away all the information + ;; about file modes (and the index hashes). + (let ((oldfile (or (match-string 4) (match-string 1))) + (newfile (or (match-string 5) (match-string 2))) + (kind (if (match-beginning 7) " BINARY" + (unless (or (match-beginning 4) (match-beginning 5)) + " empty")))) + (add-text-properties + (match-beginning 0) (1- (match-end 0)) + (list 'display + (propertize + (cond + ((match-beginning 3) + (concat (capitalize (match-string 3)) kind " file" + " " + (if (match-beginning 6) newfile oldfile))) + ((null (match-string 4)) + (concat "New" kind " file " newfile)) + ((null (match-string 2)) + (concat "Deleted" kind " file " oldfile)) + (t + (concat "Modified" kind " file " oldfile))) + 'face '(diff-file-header diff-header)) + 'font-lock-multiline t)))))) nil) ;;; Syntax highlighting from font-lock @@ -2654,7 +2716,8 @@ When OLD is non-nil, highlight the hunk from the old source." ;; Trim a trailing newline to find hunk in diff-syntax-fontify-props ;; in diffs that have no newline at end of diff file. (text (string-trim-right - (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) + (or (with-demoted-errors "Error getting hunk text: %S" + (diff-hunk-text hunk (not old) nil)) ""))) (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?") (if old (match-string 1) |