Mercurial > emacs
diff lisp/diff-mode.el @ 88155:d7ddb3e565de
sync with trunk
| author | Henrik Enberg <henrik.enberg@telia.com> |
|---|---|
| date | Mon, 16 Jan 2006 00:03:54 +0000 |
| parents | 37645a051842 |
| children |
line wrap: on
line diff
--- a/lisp/diff-mode.el Sun Jan 15 23:02:10 2006 +0000 +++ b/lisp/diff-mode.el Mon Jan 16 00:03:54 2006 +0000 @@ -1,6 +1,7 @@ ;;; diff-mode.el --- a mode for viewing/editing context diffs -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: convenience patch diff @@ -19,8 +20,8 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -28,7 +29,7 @@ ;; commands, editing and various conversions as well as jumping ;; to the corresponding source file. -;; Inspired by Pavel Machek's patch-mode.el (<pavel@atrey.karlin.mff.cuni.cz>) +;; Inspired by Pavel Machek's patch-mode.el (<pavel@@atrey.karlin.mff.cuni.cz>) ;; Some efforts were spent to have it somewhat compatible with XEmacs' ;; diff-mode as well as with compilation-minor-mode @@ -38,32 +39,32 @@ ;; Todo: -;; - Improve narrowed-view support. -;; - re-enable (conditionally) the `compile' support after improving it to use -;; the same code as diff-goto-source. -;; - Support for # comments in context->unified. -;; - Allow diff.el to use diff-mode. -;; This mostly means ability to jump from half-hunk to half-hunk -;; in context (and normal) diffs and to jump to the corresponding -;; (i.e. new or old) file. +;; - Add a `delete-after-apply' so C-c C-a automatically deletes hunks. +;; Also allow C-c C-a to delete already-applied hunks. +;; +;; - Try `diff <file> <hunk>' to try and fuzzily discover the source location +;; of a hunk. Show then the changes between <file> and <hunk> and make it +;; possible to apply them to <file>, <hunk-src>, or <hunk-dst>. +;; Or maybe just make it into a ".rej to diff3-markers converter". +;; +;; - Refine hunk on a word-by-word basis. +;; ;; - Handle `diff -b' output in context->unified. -;; Low priority: -;; - Spice up the minor-mode with font-lock support. -;; - Recognize pcl-cvs' special string for `cvs-execute-single'. - ;;; Code: (eval-when-compile (require 'cl)) +(defvar add-log-buffer-file-name-function) + (defgroup diff-mode () - "Major mode for viewing/editing diffs" + "Major mode for viewing/editing diffs." :version "21.1" :group 'tools :group 'diff) -(defcustom diff-default-read-only t +(defcustom diff-default-read-only nil "If non-nil, `diff-mode' buffers default to being read-only." :type 'boolean :group 'diff-mode) @@ -71,7 +72,8 @@ (defcustom diff-jump-to-old-file nil "*Non-nil means `diff-goto-source' jumps to the old file. Else, it jumps to the new file." - :type '(boolean)) + :type 'boolean + :group 'diff-mode) (defcustom diff-update-on-the-fly t "*Non-nil means hunk headers are kept up-to-date on-the-fly. @@ -80,15 +82,20 @@ either be done on the fly (but this sometimes interacts poorly with the undo mechanism) or whenever the file is written (can be slow when editing big diffs)." - :type '(boolean)) + :type 'boolean + :group 'diff-mode) (defcustom diff-advance-after-apply-hunk t "*Non-nil means `diff-apply-hunk' will move to the next hunk after applying." - :type 'boolean) + :type 'boolean + :group 'diff-mode) -(defvar diff-mode-hook nil - "Run after setting up the `diff-mode' major mode.") +(defcustom diff-mode-hook nil + "Run after setting up the `diff-mode' major mode." + :type 'hook + :options '(diff-delete-empty-files diff-make-unified) + :group 'diff-mode) (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -109,7 +116,7 @@ ("}" . diff-file-next) ("{" . diff-file-prev) ("\C-m" . diff-goto-source) - ([mouse-2] . diff-mouse-goto-source) + ([mouse-2] . diff-goto-source) ;; From XEmacs' diff-mode. ("W" . widen) ;;("." . diff-goto-source) ;display-buffer @@ -127,7 +134,8 @@ ("r" . diff-restrict-view) ("R" . diff-reverse-direction) ("U" . diff-context->unified) - ("C" . diff-unified->context)) + ("C" . diff-unified->context) + ("q" . quit-window)) "Basic keymap for `diff-mode', bound to various prefix keys.") (easy-mmode-defmap diff-mode-map @@ -135,9 +143,11 @@ ;; From compilation-minor-mode. ("\C-c\C-c" . diff-goto-source) ;; Misc operations. + ("\C-c\C-r" . diff-refine-hunk) ("\C-c\C-s" . diff-split-hunk) ("\C-c\C-a" . diff-apply-hunk) - ("\C-c\C-t" . diff-test-hunk)) + ("\C-c\C-t" . diff-test-hunk) + ("\C-c\C-f" . next-error-follow-minor-mode)) "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") (easy-menu-define diff-mode-menu diff-mode-map @@ -155,7 +165,8 @@ (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 "\e") (string "C-c=") string) + :group 'diff-mode) (easy-mmode-defmap diff-minor-mode-map `((,diff-minor-mode-prefix . ,diff-mode-shared-map)) @@ -166,99 +177,173 @@ ;;;; font-lock support ;;;; -(defface diff-header-face - '((((type tty pc) (class color) (background light)) - (:foreground "blue1" :weight bold)) - (((type tty pc) (class color) (background dark)) - (:foreground "green" :weight bold)) +(defface diff-header + '((((class color) (min-colors 88) (background light)) + :background "grey85") + (((class color) (min-colors 88) (background dark)) + :background "grey45") (((class color) (background light)) - (:background "grey85")) + :foreground "blue1" :weight bold) (((class color) (background dark)) - (:background "grey45")) - (t (:weight bold))) - "`diff-mode' face inherited by hunk and index header faces.") -(defvar diff-header-face 'diff-header-face) + :foreground "green" :weight bold) + (t :weight bold)) + "`diff-mode' face inherited by hunk and index header faces." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-header-face 'face-alias 'diff-header) +(defvar diff-header-face 'diff-header) + +(defface diff-file-header + '((((class color) (min-colors 88) (background light)) + :background "grey70" :weight bold) + (((class color) (min-colors 88) (background dark)) + :background "grey60" :weight bold) + (((class color) (background light)) + :foreground "green" :weight bold) + (((class color) (background dark)) + :foreground "cyan" :weight bold) + (t :weight bold)) ; :height 1.3 + "`diff-mode' face used to highlight file header lines." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-file-header-face 'face-alias 'diff-file-header) +(defvar diff-file-header-face 'diff-file-header) -(defface diff-file-header-face - '((((type tty pc) (class color) (background light)) - (:foreground "yellow" :weight bold)) - (((type tty pc) (class color) (background dark)) - (:foreground "cyan" :weight bold)) - (((class color) (background light)) - (:background "grey70" :weight bold)) - (((class color) (background dark)) - (:background "grey60" :weight bold)) - (t (:weight bold))) ; :height 1.3 - "`diff-mode' face used to highlight file header lines.") -(defvar diff-file-header-face 'diff-file-header-face) +(defface diff-index + '((t :inherit diff-file-header)) + "`diff-mode' face used to highlight index header lines." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-index-face 'face-alias 'diff-index) +(defvar diff-index-face 'diff-index) + +(defface diff-hunk-header + '((t :inherit diff-header)) + "`diff-mode' face used to highlight hunk header lines." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-hunk-header-face 'face-alias 'diff-hunk-header) +(defvar diff-hunk-header-face 'diff-hunk-header) -(defface diff-index-face - '((t (:inherit diff-file-header-face))) - "`diff-mode' face used to highlight index header lines.") -(defvar diff-index-face 'diff-index-face) +(defface diff-removed + '((t :inherit diff-changed)) + "`diff-mode' face used to highlight removed lines." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-removed-face 'face-alias 'diff-removed) +(defvar diff-removed-face 'diff-removed) -(defface diff-hunk-header-face - '((t (:inherit diff-header-face))) - "`diff-mode' face used to highlight hunk header lines.") -(defvar diff-hunk-header-face 'diff-hunk-header-face) +(defface diff-added + '((t :inherit diff-changed)) + "`diff-mode' face used to highlight added lines." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-added-face 'face-alias 'diff-added) +(defvar diff-added-face 'diff-added) -(defface diff-removed-face - '((t (:inherit diff-changed-face))) - "`diff-mode' face used to highlight removed lines.") -(defvar diff-removed-face 'diff-removed-face) +(defface diff-changed + '((((type tty pc) (class color) (background light)) + :foreground "magenta" :weight bold :slant italic) + (((type tty pc) (class color) (background dark)) + :foreground "yellow" :weight bold :slant italic)) + "`diff-mode' face used to highlight changed lines." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-changed-face 'face-alias 'diff-changed) +(defvar diff-changed-face 'diff-changed) -(defface diff-added-face - '((t (:inherit diff-changed-face))) - "`diff-mode' face used to highlight added lines.") -(defvar diff-added-face 'diff-added-face) +(defface diff-indicator-removed + '((t :inherit diff-removed)) + "`diff-mode' face used to highlight indicator of removed lines (-, <)." + :group 'diff-mode + :version "22.1") +(defvar diff-indicator-removed-face 'diff-indicator-removed) -(defface diff-changed-face - '((((type tty pc) (class color) (background light)) - (:foreground "magenta" :weight bold :slant italic)) - (((type tty pc) (class color) (background dark)) - (:foreground "yellow" :weight bold :slant italic)) - (t ())) - "`diff-mode' face used to highlight changed lines.") -(defvar diff-changed-face 'diff-changed-face) +(defface diff-indicator-added + '((t :inherit diff-added)) + "`diff-mode' face used to highlight indicator of added lines (+, >)." + :group 'diff-mode + :version "22.1") +(defvar diff-indicator-added-face 'diff-indicator-added) + +(defface diff-indicator-changed + '((t :inherit diff-changed)) + "`diff-mode' face used to highlight indicator of changed lines." + :group 'diff-mode + :version "22.1") +(defvar diff-indicator-changed-face 'diff-indicator-changed) -(defface diff-function-face - '((t (:inherit diff-context-face))) - "`diff-mode' face used to highlight function names produced by \"diff -p\".") -(defvar diff-function-face 'diff-function-face) +(defface diff-function + '((t :inherit diff-context)) + "`diff-mode' face used to highlight function names produced by \"diff -p\"." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-function-face 'face-alias 'diff-function) +(defvar diff-function-face 'diff-function) + +(defface diff-context + '((((class color grayscale) (min-colors 88)) :inherit shadow)) + "`diff-mode' face used to highlight context and other side-information." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-context-face 'face-alias 'diff-context) +(defvar diff-context-face 'diff-context) -(defface diff-context-face - '((((class color) (background light)) - (:foreground "grey50")) - (((class color) (background dark)) - (:foreground "grey70")) - (t )) - "`diff-mode' face used to highlight context and other side-information.") -(defvar diff-context-face 'diff-context-face) +(defface diff-nonexistent + '((t :inherit diff-file-header)) + "`diff-mode' face used to highlight nonexistent files in recursive diffs." + :group 'diff-mode) +;; backward-compatibility alias +(put 'diff-nonexistent-face 'face-alias 'diff-nonexistent) +(defvar diff-nonexistent-face 'diff-nonexistent) -(defface diff-nonexistent-face - '((t (:inherit diff-file-header-face))) - "`diff-mode' face used to highlight nonexistent files in recursive diffs.") -(defvar diff-nonexistent-face 'diff-nonexistent-face) +(defconst diff-yank-handler '(diff-yank-function)) +(defun diff-yank-function (text) + ;; FIXME: the yank-handler is now called separately on each piece of text + ;; with a yank-handler property, so the next-single-property-change call + ;; below will always return nil :-( --stef + (let ((mixed (next-single-property-change 0 'yank-handler text)) + (start (point))) + ;; First insert the text. + (insert text) + ;; If the text does not include any diff markers and if we're not + ;; yanking back into a diff-mode buffer, get rid of the prefixes. + (unless (or mixed (derived-mode-p 'diff-mode)) + (undo-boundary) ; Just in case the user wanted the prefixes. + (let ((re (save-excursion + (if (re-search-backward "^[><!][ \t]" start t) + (if (eq (char-after) ?!) + "^[!+- ][ \t]" "^[<>][ \t]") + "^[ <>!+-]")))) + (save-excursion + (while (re-search-backward re start t) + (replace-match "" t t))))))) + (defvar diff-font-lock-keywords - '(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified - (1 diff-hunk-header-face) - (2 diff-function-face)) - ("^--- .+ ----$" . diff-hunk-header-face) ;context - ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context - (1 diff-hunk-header-face) - (2 diff-function-face)) + `(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified + (1 diff-hunk-header-face) (2 diff-function-face)) + ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context + (1 diff-hunk-header-face) (2 diff-function-face)) ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header-face) ;context + ("^--- .+ ----$" . diff-hunk-header-face) ;context + ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal + ("^---$" . diff-hunk-header-face) ;normal ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n" (0 diff-header-face) (2 diff-file-header-face prepend)) - ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) - ("^!.*\n" . diff-changed-face) ;context - ("^[+>].*\n" . diff-added-face) - ("^[-<].*\n" . diff-removed-face) - ("^Index: \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend)) + ("^\\([-<]\\)\\(.*\n\\)" + (1 diff-indicator-removed-face) (2 diff-removed-face)) + ("^\\([+>]\\)\\(.*\n\\)" + (1 diff-indicator-added-face) (2 diff-added-face)) + ("^\\(!\\)\\(.*\n\\)" + (1 diff-indicator-changed-face) (2 diff-changed-face)) + ("^Index: \\(.+\\).*\n" + (0 diff-header-face) (1 diff-index-face prepend)) ("^Only in .*\n" . diff-nonexistent-face) - ("^#.*" . font-lock-string-face) - ("^[^-=+*!<>].*\n" . diff-context-face))) + ("^\\(#\\)\\(.*\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-comment-face)) + ("^[^-=+*!<>#].*\n" (0 diff-context-face)))) (defconst diff-font-lock-defaults '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil))) @@ -271,27 +356,19 @@ (nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs ;;;; -;;;; Compile support -;;;; - -(defvar diff-file-regexp-alist - '(("Index: \\(.+\\)" 1))) - -(defvar diff-error-regexp-alist - '(("@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@" nil 2) - ("--- \\([0-9]+\\),[0-9]+ ----" nil 1) - ("\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)" nil 3))) - -;;;; ;;;; Movement ;;;; (defconst diff-hunk-header-re "^\\(@@ -[0-9,]+ \\+[0-9,]+ @@.*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$") -(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+\\|\\*\\*\\* .+\n---\\|[^-+!<>0-9@* ]\\).+\n" (substring diff-hunk-header-re 1))) +(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* ]\\).+\n" (substring diff-hunk-header-re 1))) (defvar diff-narrowed-to nil) (defun diff-end-of-hunk (&optional style) - (if (looking-at diff-hunk-header-re) (goto-char (match-end 0))) + (when (looking-at diff-hunk-header-re) + (unless style + ;; Especially important for unified (because headers are ambiguous). + (setq style (cdr (assq (char-after) '((?@ . unified) (?* . context)))))) + (goto-char (match-end 0))) (let ((end (and (re-search-forward (case style ;; A `unified' header is ambiguous. (unified (concat "^[^-+# \\]\\|" @@ -322,12 +399,15 @@ (defun diff-end-of-file () (re-search-forward "^[-+#!<>0-9@* \\]" nil t) - (re-search-forward "^[^-+#!<>0-9@* \\]" nil 'move) - (beginning-of-line)) + (re-search-forward (concat "^[^-+#!<>0-9@* \\]\\|" diff-file-header-re) + nil 'move) + (if (match-beginning 1) + (goto-char (match-beginning 1)) + (beginning-of-line))) ;; Define diff-{hunk,file}-{prev,next} (easy-mmode-define-navigation - diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk) + diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view) (easy-mmode-define-navigation diff-file diff-file-header-re "file" diff-end-of-hunk) @@ -348,7 +428,8 @@ (interactive) (diff-beginning-of-hunk) (let* ((start (point)) - (nexthunk (ignore-errors (diff-hunk-next) (point))) + (nexthunk (when (re-search-forward diff-hunk-header-re nil t) + (match-beginning 0))) (firsthunk (ignore-errors (goto-char start) (diff-beginning-of-file) (diff-hunk-next) (point))) @@ -374,6 +455,7 @@ (re-search-backward "^Index: " prevhunk t)))) (when index (setq start index)) (diff-end-of-file) + (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs. (kill-region start (point)))) (defun diff-kill-junk () @@ -450,6 +532,47 @@ (match-string 4 str) (substring str (match-end 6) (match-end 5)))))) +(defun diff-tell-file-name (old name) + "Tell Emacs where the find the source file of the current hunk. +If the OLD prefix arg is passed, tell the file NAME of the old file." + (interactive + (let* ((old current-prefix-arg) + (fs (diff-hunk-file-names current-prefix-arg))) + (unless fs (error "No file name to look for")) + (list old (read-file-name (format "File for %s: " (car fs)) + nil (diff-find-file-name old) t)))) + (let ((fs (diff-hunk-file-names old))) + (unless fs (error "No file name to look for")) + (push (cons fs name) diff-remembered-files-alist))) + +(defun diff-hunk-file-names (&optional old) + "Give the list of file names textually mentioned for the current hunk." + (save-excursion + (unless (looking-at diff-file-header-re) + (or (ignore-errors (diff-beginning-of-file)) + (re-search-forward diff-file-header-re nil t))) + (let ((limit (save-excursion + (condition-case () + (progn (diff-hunk-prev) (point)) + (error (point-min))))) + (header-files + (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\(\\s-.*\\)?\n[-+][-+][-+] \\(\\S-+\\)") + (list (if old (match-string 1) (match-string 3)) + (if old (match-string 3) (match-string 1))) + (forward-line 1) nil))) + (delq nil + (append + (when (and (not old) + (save-excursion + (re-search-backward "^Index: \\(.+\\)" limit t))) + (list (match-string 1))) + header-files + (when (re-search-backward + "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" + nil t) + (list (if old (match-string 2) (match-string 4)) + (if old (match-string 4) (match-string 2))))))))) + (defun diff-find-file-name (&optional old) "Return the file corresponding to the current patch. Non-nil OLD means that we want the old file." @@ -457,24 +580,7 @@ (unless (looking-at diff-file-header-re) (or (ignore-errors (diff-beginning-of-file)) (re-search-forward diff-file-header-re nil t))) - (let* ((limit (save-excursion - (condition-case () - (progn (diff-hunk-prev) (point)) - (error (point-min))))) - (header-files - (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\(\\s-.*\\)?\n[-+][-+][-+] \\(\\S-+\\)") - (list (if old (match-string 1) (match-string 3)) - (if old (match-string 3) (match-string 1))) - (forward-line 1) nil)) - (fs (append - (when (save-excursion - (re-search-backward "^Index: \\(.+\\)" limit t)) - (list (match-string 1))) - header-files - (when (re-search-backward "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" nil t) - (list (if old (match-string 2) (match-string 4)) - (if old (match-string 4) (match-string 2)))))) - (fs (delq nil fs))) + (let ((fs (diff-hunk-file-names old))) (or ;; use any previously used preference (cdr (assoc fs diff-remembered-files-alist)) @@ -504,14 +610,6 @@ file))))) -(defun diff-mouse-goto-source (event) - "Run `diff-goto-source' for the diff at a mouse click." - (interactive "e") - (save-excursion - (mouse-set-point event) - (diff-goto-source))) - - (defun diff-ediff-patch () "Call `ediff-patch-file' on the current buffer." (interactive) @@ -570,7 +668,7 @@ (while (progn (setq last-pt (point)) (= (forward-line -1) 0)) (case (char-after) - (? (insert " ") (setq modif nil) (backward-char 1)) + (?\s (insert " ") (setq modif nil) (backward-char 1)) (?+ (delete-region (point) last-pt) (setq modif t)) (?- (if (not modif) (progn (forward-char 1) @@ -595,7 +693,7 @@ (let ((modif nil) (delete nil)) (while (not (eobp)) (case (char-after) - (? (insert " ") (setq modif nil) (backward-char 1)) + (?\s (insert " ") (setq modif nil) (backward-char 1)) (?- (setq delete t) (setq modif t)) (?+ (if (not modif) (progn (forward-char 1) @@ -653,7 +751,7 @@ (while (< (point) pt2) (case (char-after) ((?! ?-) (delete-char 2) (insert "-") (forward-line 1)) - (?\ ;merge with the other half of the chunk + (?\s ;merge with the other half of the chunk (let* ((endline2 (save-excursion (goto-char pt2) (forward-line 1) (point))) @@ -663,7 +761,7 @@ (insert "+" (prog1 (buffer-substring (+ pt2 2) endline2) (delete-region pt2 endline2)))) - (?\ ;FIXME: check consistency + (?\s ;FIXME: check consistency (delete-region pt2 endline2) (delete-char 1) (forward-line 1)) @@ -744,7 +842,7 @@ (t (when (and first last (< first last)) (insert (delete-and-extract-region first last))) (setq first nil last nil) - (equal ?\ c))) + (equal ?\s c))) (forward-line 1)))))))))) (defun diff-fixup-modifs (start end) @@ -759,9 +857,12 @@ (goto-char end) (diff-end-of-hunk) (let ((plus 0) (minus 0) (space 0) (bang 0)) (while (and (= (forward-line -1) 0) (<= start (point))) - (if (not (looking-at "\\(@@ -[0-9,]+ \\+[0-9,]+ @@.*\\|[-*][-*][-*] .+ [-*][-*][-*][-*]\\)$")) + (if (not (looking-at + (concat "@@ -[0-9,]+ \\+[0-9,]+ @@" + "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$" + "\\|--- .+\n\\+\\+\\+ "))) (case (char-after) - (?\ (incf space)) + (?\s (incf space)) (?+ (incf plus)) (?- (incf minus)) (?! (incf bang)) @@ -847,9 +948,14 @@ (diff-fixup-modifs (point) (cdr diff-unhandled-changes))))) (setq diff-unhandled-changes nil))) -;;;; -;;;; The main function -;;;; +(defun diff-next-error (arg reset) + ;; Select a window that displays the current buffer so that point + ;; movements are reflected in that window. Otherwise, the user might + ;; never see the hunk corresponding to the source she's jumping to. + (pop-to-buffer (current-buffer)) + (if reset (goto-char (point-min))) + (diff-hunk-next arg) + (diff-goto-source)) ;;;###autoload (define-derived-mode diff-mode fundamental-mode "Diff" @@ -857,11 +963,11 @@ Supports unified and context diffs as well as (to a lesser extent) normal diffs. When the buffer is read-only, the ESC prefix is not necessary. -IF you edit the buffer manually, diff-mode will try to update the hunk +If you edit the buffer manually, diff-mode will try to update the hunk headers for you on-the-fly. You can also switch between context diff and unified diff with \\[diff-context->unified], -or vice versa with \\[diff-unified->context] and you can also revert the direction of +or vice versa with \\[diff-unified->context] and you can also reverse the direction of a diff with \\[diff-reverse-direction]." (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults) (set (make-local-variable 'outline-regexp) diff-outline-regexp) @@ -877,38 +983,25 @@ ;; (set (make-local-variable 'paragraph-separate) paragraph-start) ;; (set (make-local-variable 'page-delimiter) "--- [^\t]+\t") ;; compile support - - ;;;; compile support is not good enough yet. It should be merged - ;;;; with diff.el's support. - (set (make-local-variable 'compilation-file-regexp-alist) - diff-file-regexp-alist) - (set (make-local-variable 'compilation-error-regexp-alist) - diff-error-regexp-alist) - (when (string-match "\\.rej\\'" (or buffer-file-name "")) - (set (make-local-variable 'compilation-current-file) - (substring buffer-file-name 0 (match-beginning 0)))) - ;; Be careful not to change compilation-last-buffer when we're just - ;; doing a C-x v = (for example). - (if (boundp 'compilation-last-buffer) - (let ((compilation-last-buffer compilation-last-buffer)) - (compilation-minor-mode 1)) - (compilation-minor-mode 1)) - ;; M-RET and RET should be done by diff-mode because the `compile' - ;; support is significantly less good. - (add-to-list 'minor-mode-overriding-map-alist - (cons 'compilation-minor-mode (make-sparse-keymap))) + (set (make-local-variable 'next-error-function) 'diff-next-error) (when (and (> (point-max) (point-min)) diff-default-read-only) (toggle-read-only t)) ;; setup change hooks (if (not diff-update-on-the-fly) - (add-hook 'write-contents-hooks 'diff-write-contents-hooks) + (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: - (add-to-list 'minor-mode-overriding-map-alist - (cons 'buffer-read-only diff-mode-shared-map)) + (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 (set (make-local-variable 'add-log-current-defun-function) 'diff-current-defun) @@ -919,15 +1012,38 @@ (define-minor-mode diff-minor-mode "Minor mode for viewing/editing context diffs. \\{diff-minor-mode-map}" - nil " Diff" nil + :group 'diff-mode :lighter " Diff" ;; FIXME: setup font-lock ;; setup change hooks (if (not diff-update-on-the-fly) - (add-hook 'write-contents-hooks 'diff-write-contents-hooks) + (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))) +;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 + ;; remove hunks as we apply them. + (when (and buffer-file-name + (eq 0 (nth 7 (file-attributes buffer-file-name)))) + (delete-file buffer-file-name))) + +(defun diff-delete-empty-files () + "Arrange for empty diff files to be removed." + (add-hook 'after-save-hook 'diff-delete-if-empty nil t)) + +(defun diff-make-unified () + "Turn context diffs into unified diffs if applicable." + (if (save-excursion + (goto-char (point-min)) + (and (looking-at diff-hunk-header-re) (eq (char-after) ?*))) + (let ((mod (buffer-modified-p))) + (unwind-protect + (diff-context->unified (point-min) (point-max)) + (restore-buffer-modified-p mod))))) ;;; ;;; Misc operations that have proved useful at some point. @@ -1091,12 +1207,17 @@ (goto-line (string-to-number line)) (let* ((orig-pos (point)) (switched nil) + ;; FIXME: Check for case where both OLD and NEW are found. (pos (or (diff-find-text (car old)) (progn (setq switched t) (diff-find-text (car new))) (progn (setq switched nil) - (diff-find-approx-text (car old))) + (condition-case nil + (diff-find-approx-text (car old)) + (invalid-regexp nil))) ;Regex too big. (progn (setq switched t) - (diff-find-approx-text (car new))) + (condition-case nil + (diff-find-approx-text (car new)) + (invalid-regexp nil))) ;Regex too big. (progn (setq switched nil) nil)))) (nconc (list buf) @@ -1127,7 +1248,8 @@ With a prefix argument, REVERSE the hunk." (interactive "P") (destructuring-bind (buf line-offset pos old new &optional switched) - (diff-find-source-location nil reverse) + ;; If REVERSE go to the new file, otherwise go to the old. + (diff-find-source-location (not reverse) reverse) (cond ((null line-offset) (error "Can't find the text to patch")) @@ -1159,21 +1281,25 @@ With a prefix argument, try to REVERSE the hunk." (interactive "P") (destructuring-bind (buf line-offset pos src dst &optional switched) - (diff-find-source-location nil reverse) + ;; If REVERSE go to the new file, otherwise go to the old. + (diff-find-source-location (not reverse) reverse) (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) -(defun diff-goto-source (&optional other-file) +(defalias 'diff-mouse-goto-source 'diff-goto-source) + +(defun diff-goto-source (&optional other-file event) "Jump to the corresponding source line. `diff-jump-to-old-file' (or its opposite if the OTHER-FILE prefix arg is given) determines whether to jump to the old or the new file. If the prefix arg is bigger than 8 (for example with \\[universal-argument] \\[universal-argument]) then `diff-jump-to-old-file' is also set, for the next invocations." - (interactive "P") + (interactive (list current-prefix-arg last-input-event)) ;; When pointing at a removal line, we probably want to jump to ;; the old location, and else to the new (i.e. as if reverting). ;; This is a convenient detail when using smerge-diff. + (if event (posn-set-point (event-end event))) (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) (destructuring-bind (buf line-offset pos src dst &optional switched) (diff-find-source-location other-file rev) @@ -1185,9 +1311,12 @@ (defun diff-current-defun () "Find the name of function at point. For use in `add-log-current-defun-function'." - (destructuring-bind (buf line-offset pos src dst &optional switched) - (diff-find-source-location) - (save-excursion + (save-excursion + (when (looking-at diff-hunk-header-re) + (forward-line 1) + (re-search-forward "^[^ ]" nil t)) + (destructuring-bind (buf line-offset pos src dst &optional switched) + (diff-find-source-location) (beginning-of-line) (or (when (memq (char-after) '(?< ?-)) ;; Cursor is pointing at removed text. This could be a removed @@ -1204,6 +1333,49 @@ (goto-char (+ (car pos) (cdr src))) (add-log-current-defun)))))) +(defun diff-refine-hunk () + "Refine the current hunk by ignoring space differences." + (interactive) + (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk) (point)))) + (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b"))) + (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") + (error "Can't find line number")) + (string-to-number (match-string 1)))) + (hunk (delete-and-extract-region + (point) (save-excursion (diff-end-of-hunk) (point)))) + (lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1. + (file1 (make-temp-file "diff1")) + (file2 (make-temp-file "diff2")) + (coding-system-for-read buffer-file-coding-system) + old new) + (unwind-protect + (save-excursion + (setq old (diff-hunk-text hunk nil char-offset)) + (setq new (diff-hunk-text hunk t char-offset)) + (write-region (concat lead (car old)) nil file1 nil 'nomessage) + (write-region (concat lead (car new)) nil file2 nil 'nomessage) + (with-temp-buffer + (let ((status + (call-process diff-command nil t nil + opts file1 file2))) + (case status + (0 nil) ;Nothing to reformat. + (1 (goto-char (point-min)) + ;; Remove the file-header. + (when (re-search-forward diff-hunk-header-re nil t) + (delete-region (point-min) (match-beginning 0)))) + (t (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert hunk))) + (setq hunk (buffer-string)) + (unless (memq status '(0 1)) + (error "Diff returned: %s" status))))) + ;; Whatever happens, put back some equivalent text: either the new + ;; one or the original one in case some error happened. + (insert hunk) + (delete-file file1) + (delete-file file2)))) + ;; provide the package (provide 'diff-mode) @@ -1242,4 +1414,5 @@ ;; use `combine-after-change-calls' to minimize the slowdown of font-lock. ;; +;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66 ;;; diff-mode.el ends here