(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
[bpt/emacs.git] / lisp / diff-mode.el
CommitLineData
610a6418
SM
1;;; diff-mode.el --- A mode for viewing/editing context diffs
2
2b960ac0 3;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
610a6418
SM
4
5;; Author: Stefan Monnier <monnier@cs.yale.edu>
6;; Keywords: patch diff
610a6418
SM
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
24
25;;; Commentary:
26
cdbb79c1 27;; Provides support for font-lock, outline, navigation
610a6418
SM
28;; commands, editing and various conversions as well as jumping
29;; to the corresponding source file.
30
610a6418
SM
31;; inspired by Pavel Machek's patch-mode.el (<pavel@atrey.karlin.mff.cuni.cz>)
32;; some efforts were spent to have it somewhat compatible with XEmacs'
33;; diff-mode as well as with compilation-minor-mode
34
35;; to use it, simply add to your .emacs the following lines:
36;;
37;; (autoload 'diff-mode "diff-mode" "Diff major mode" t)
38;; (add-to-list 'auto-mode-alist '("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode))
39
40;; Bugs:
41
027ac3f8 42;; - Reverse doesn't work with normal diffs.
610a6418
SM
43
44;; Todo:
45
027ac3f8 46;; - Improve narrowed-view support.
cdbb79c1
SM
47;; - re-enable (conditionally) the `compile' support after improving it to use
48;; the same code as diff-goto-source.
027ac3f8 49;; - Support for # comments in context->unified.
027ac3f8
SM
50;; - Allow diff.el to use diff-mode.
51;; This mostly means ability to jump from half-hunk to half-hunk
52;; in context (and normal) diffs and to jump to the corresponding
53;; (i.e. new or old) file.
027ac3f8 54;; - Handle `diff -b' output in context->unified.
610a6418 55
cd632e57
SM
56;; Low priority:
57;; - Spice up the minor-mode with font-lock support.
58;; - Recognize pcl-cvs' special string for `cvs-execute-single'.
59
610a6418
SM
60;;; Code:
61
62(eval-when-compile (require 'cl))
63
64
65(defgroup diff-mode ()
3cec9c57 66 "Major mode for viewing/editing diffs"
ccce6558 67 :version "21.1"
610a6418
SM
68 :group 'tools
69 :group 'diff)
70
769dd0f1
SM
71(defcustom diff-default-read-only t
72 "If non-nil, `diff-mode' buffers default to being read-only."
73 :type 'boolean
74 :group 'diff-mode)
75
e8a1ed31 76(defcustom diff-jump-to-old-file nil
610a6418
SM
77 "*Non-nil means `diff-goto-source' jumps to the old file.
78Else, it jumps to the new file."
610a6418
SM
79 :type '(boolean))
80
e8a1ed31 81(defcustom diff-update-on-the-fly t
610a6418
SM
82 "*Non-nil means hunk headers are kept up-to-date on-the-fly.
83When editing a diff file, the line numbers in the hunk headers
84need to be kept consistent with the actual diff. This can
85either be done on the fly (but this sometimes interacts poorly with the
86undo mechanism) or whenever the file is written (can be slow
87when editing big diffs)."
610a6418
SM
88 :type '(boolean))
89
00df919e
MB
90(defcustom diff-advance-after-apply-hunk t
91 "*Non-nil means `diff-apply-hunk' will move to the next hunk after applying."
00df919e
MB
92 :type 'boolean)
93
94
610a6418
SM
95(defvar diff-mode-hook nil
96 "Run after setting up the `diff-mode' major mode.")
97
98(defvar diff-outline-regexp
99 "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
100
cd632e57 101;;;;
610a6418 102;;;; keymap, menu, ...
cd632e57 103;;;;
610a6418 104
d87e5627 105(easy-mmode-defmap diff-mode-shared-map
027ac3f8 106 '(;; From Pavel Machek's patch-mode.
d87e5627
SM
107 ("n" . diff-hunk-next)
108 ("N" . diff-file-next)
109 ("p" . diff-hunk-prev)
110 ("P" . diff-file-prev)
111 ("k" . diff-hunk-kill)
112 ("K" . diff-file-kill)
027ac3f8 113 ;; From compilation-minor-mode.
d87e5627
SM
114 ("}" . diff-file-next)
115 ("{" . diff-file-prev)
610a6418 116 ("\C-m" . diff-goto-source)
ccce6558 117 ([mouse-2] . diff-mouse-goto-source)
027ac3f8 118 ;; From XEmacs' diff-mode.
610a6418
SM
119 ("W" . widen)
120 ;;("." . diff-goto-source) ;display-buffer
121 ;;("f" . diff-goto-source) ;find-file
122 ("o" . diff-goto-source) ;other-window
123 ;;("w" . diff-goto-source) ;other-frame
124 ;;("N" . diff-narrow)
125 ;;("h" . diff-show-header)
126 ;;("j" . diff-show-difference) ;jump to Nth diff
127 ;;("q" . diff-quit)
128 (" " . scroll-up)
129 ("\177" . scroll-down)
027ac3f8 130 ;; Our very own bindings.
610a6418
SM
131 ("A" . diff-ediff-patch)
132 ("r" . diff-restrict-view)
133 ("R" . diff-reverse-direction)
134 ("U" . diff-context->unified)
135 ("C" . diff-unified->context))
0b82e382 136 "Basic keymap for `diff-mode', bound to various prefix keys.")
610a6418 137
d87e5627 138(easy-mmode-defmap diff-mode-map
610a6418 139 `(("\e" . ,diff-mode-shared-map)
027ac3f8
SM
140 ;; From compilation-minor-mode.
141 ("\C-c\C-c" . diff-goto-source)
142 ;; Misc operations.
cd632e57 143 ("\C-c\C-s" . diff-split-hunk)
3cec9c57
SM
144 ("\C-c\C-a" . diff-apply-hunk)
145 ("\C-c\C-t" . diff-test-hunk))
610a6418
SM
146 "Keymap for `diff-mode'. See also `diff-mode-shared-map'.")
147
148(easy-menu-define diff-mode-menu diff-mode-map
149 "Menu for `diff-mode'."
150 '("Diff"
151 ["Jump to Source" diff-goto-source t]
cd632e57
SM
152 ["Apply hunk" diff-apply-hunk t]
153 ["Apply diff with Ediff" diff-ediff-patch t]
610a6418
SM
154 ["-----" nil nil]
155 ["Reverse direction" diff-reverse-direction t]
156 ["Context -> Unified" diff-context->unified t]
157 ["Unified -> Context" diff-unified->context t]
158 ;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)]
159 ))
160
3cec9c57 161(defcustom diff-minor-mode-prefix "\C-c="
0b82e382 162 "Prefix key for `diff-minor-mode' commands."
3cec9c57 163 :type '(choice (string "\e") (string "C-c=") string))
0b82e382 164
d87e5627
SM
165(easy-mmode-defmap diff-minor-mode-map
166 `((,diff-minor-mode-prefix . ,diff-mode-shared-map))
0b82e382
SM
167 "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.")
168
610a6418 169
cd632e57 170;;;;
610a6418 171;;;; font-lock support
cd632e57 172;;;;
610a6418 173
c0aa75f7 174(defface diff-header-face
86a27a3a 175 '((((type tty pc) (class color) (background light))
34460354 176 (:foreground "blue1" :bold t))
86a27a3a 177 (((type tty pc) (class color) (background dark))
34460354 178 (:foreground "green" :bold t))
86a27a3a 179 (((class color) (background light))
3cec9c57 180 (:background "grey85"))
9244f2c7
SM
181 (((class color) (background dark))
182 (:background "grey45"))
3cec9c57 183 (t (:bold t)))
1eabc5e6 184 "`diff-mode' face inherited by hunk and index header faces.")
c0aa75f7
SM
185(defvar diff-header-face 'diff-header-face)
186
610a6418 187(defface diff-file-header-face
86a27a3a 188 '((((type tty pc) (class color) (background light))
34460354 189 (:foreground "yellow" :bold t))
86a27a3a 190 (((type tty pc) (class color) (background dark))
34460354 191 (:foreground "cyan" :bold t))
86a27a3a 192 (((class color) (background light))
370d860c 193 (:background "grey70" :bold t))
9244f2c7
SM
194 (((class color) (background dark))
195 (:background "grey60" :bold t))
370d860c 196 (t (:bold t))) ; :height 1.3
1eabc5e6 197 "`diff-mode' face used to highlight file header lines.")
610a6418
SM
198(defvar diff-file-header-face 'diff-file-header-face)
199
200(defface diff-index-face
c0aa75f7 201 '((t (:inherit diff-file-header-face)))
1eabc5e6 202 "`diff-mode' face used to highlight index header lines.")
610a6418
SM
203(defvar diff-index-face 'diff-index-face)
204
205(defface diff-hunk-header-face
c0aa75f7 206 '((t (:inherit diff-header-face)))
1eabc5e6 207 "`diff-mode' face used to highlight hunk header lines.")
610a6418
SM
208(defvar diff-hunk-header-face 'diff-hunk-header-face)
209
210(defface diff-removed-face
c0aa75f7 211 '((t (:inherit diff-changed-face)))
1eabc5e6 212 "`diff-mode' face used to highlight removed lines.")
610a6418
SM
213(defvar diff-removed-face 'diff-removed-face)
214
215(defface diff-added-face
c0aa75f7 216 '((t (:inherit diff-changed-face)))
1eabc5e6 217 "`diff-mode' face used to highlight added lines.")
610a6418
SM
218(defvar diff-added-face 'diff-added-face)
219
220(defface diff-changed-face
86a27a3a 221 '((((type tty pc) (class color) (background light))
34460354 222 (:foreground "magenta" :bold t :italic t))
86a27a3a 223 (((type tty pc) (class color) (background dark))
34460354 224 (:foreground "yellow" :bold t :italic t))
86a27a3a 225 (t ()))
1eabc5e6 226 "`diff-mode' face used to highlight changed lines.")
610a6418
SM
227(defvar diff-changed-face 'diff-changed-face)
228
34460354
EZ
229(defface diff-function-face
230 '((t (:inherit diff-context-face)))
1eabc5e6 231 "`diff-mode' face used to highlight function names produced by \"diff -p\".")
34460354
EZ
232(defvar diff-function-face 'diff-function-face)
233
9244f2c7
SM
234(defface diff-context-face
235 '((((class color) (background light))
236 (:foreground "grey50"))
237 (((class color) (background dark))
238 (:foreground "grey70"))
239 (t ))
1eabc5e6 240 "`diff-mode' face used to highlight context and other side-information.")
9244f2c7 241(defvar diff-context-face 'diff-context-face)
c0aa75f7 242
7dfb000f 243(defface diff-nonexistent-face
469fc0a2 244 '((t (:inherit diff-file-header-face)))
1eabc5e6 245 "`diff-mode' face used to highlight nonexistent files in recursive diffs.")
7dfb000f 246(defvar diff-nonexistent-face 'diff-nonexistent-face)
469fc0a2 247
610a6418 248(defvar diff-font-lock-keywords
c0aa75f7 249 '(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified
19e713d8 250 (1 diff-hunk-header-face)
34460354 251 (2 diff-function-face))
469fc0a2 252 ("^--- .+ ----$" . diff-hunk-header-face) ;context
a62d56ab 253 ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context
19e713d8 254 (1 diff-hunk-header-face)
34460354 255 (2 diff-function-face))
370d860c 256 ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header-face) ;context
a6373340 257 ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n"
c0aa75f7 258 (0 diff-header-face) (2 diff-file-header-face prepend))
610a6418
SM
259 ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face)
260 ("^!.*\n" . diff-changed-face) ;context
261 ("^[+>].*\n" . diff-added-face)
262 ("^[-<].*\n" . diff-removed-face)
c0aa75f7 263 ("^Index: \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend))
7dfb000f 264 ("^Only in .*\n" . diff-nonexistent-face)
0e104800 265 ("^#.*" . font-lock-string-face)
9244f2c7 266 ("^[^-=+*!<>].*\n" . diff-context-face)))
610a6418
SM
267
268(defconst diff-font-lock-defaults
0e104800 269 '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil)))
610a6418 270
ccce6558
DL
271(defvar diff-imenu-generic-expression
272 ;; Prefer second name as first is most likely to be a backup or
824693e7
DL
273 ;; version-control name. The [\t\n] at the end of the unidiff pattern
274 ;; catches Debian source diff files (which lack the trailing date).
275 '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
ccce6558
DL
276 (nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
277
610a6418
SM
278;;;;
279;;;; Compile support
280;;;;
281
282(defvar diff-file-regexp-alist
283 '(("Index: \\(.+\\)" 1)))
284
285(defvar diff-error-regexp-alist
286 '(("@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@" nil 2)
287 ("--- \\([0-9]+\\),[0-9]+ ----" nil 1)
288 ("\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)" nil 3)))
289
cd632e57 290;;;;
610a6418 291;;;; Movement
cd632e57 292;;;;
610a6418 293
c0078a04 294(defconst diff-hunk-header-re "^\\(@@ -[0-9,]+ \\+[0-9,]+ @@.*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")
610a6418
SM
295(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+\\|\\*\\*\\* .+\n---\\|[^-+!<>0-9@* ]\\).+\n" (substring diff-hunk-header-re 1)))
296(defvar diff-narrowed-to nil)
297
298(defun diff-end-of-hunk (&optional style)
299 (if (looking-at diff-hunk-header-re) (goto-char (match-end 0)))
0e104800 300 (let ((end (and (re-search-forward (case style
1eabc5e6
SM
301 ;; A `unified' header is ambiguous.
302 (unified (concat "^[^-+# \\]\\|"
303 diff-file-header-re))
0e104800
SM
304 (context "^[^-+#! \\]")
305 (normal "^[^<>#\\]")
306 (t "^[^-+#!<> \\]"))
307 nil t)
308 (match-beginning 0))))
309 ;; The return value is used by easy-mmode-define-navigation.
310 (goto-char (or end (point-max)))))
610a6418
SM
311
312(defun diff-beginning-of-hunk ()
313 (beginning-of-line)
314 (unless (looking-at diff-hunk-header-re)
315 (forward-line 1)
316 (condition-case ()
317 (re-search-backward diff-hunk-header-re)
318 (error (error "Can't find the beginning of the hunk")))))
319
320(defun diff-beginning-of-file ()
321 (beginning-of-line)
322 (unless (looking-at diff-file-header-re)
323 (forward-line 2)
324 (condition-case ()
325 (re-search-backward diff-file-header-re)
326 (error (error "Can't find the beginning of the file")))))
327
328(defun diff-end-of-file ()
0e104800
SM
329 (re-search-forward "^[-+#!<>0-9@* \\]" nil t)
330 (re-search-forward "^[^-+#!<>0-9@* \\]" nil 'move)
610a6418
SM
331 (beginning-of-line))
332
d87e5627
SM
333;; Define diff-{hunk,file}-{prev,next}
334(easy-mmode-define-navigation
335 diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk)
336(easy-mmode-define-navigation
337 diff-file diff-file-header-re "file" diff-end-of-hunk)
610a6418
SM
338
339(defun diff-restrict-view (&optional arg)
340 "Restrict the view to the current hunk.
341If the prefix ARG is given, restrict the view to the current file instead."
342 (interactive "P")
343 (save-excursion
344 (if arg (diff-beginning-of-file) (diff-beginning-of-hunk))
345 (narrow-to-region (point)
346 (progn (if arg (diff-end-of-file) (diff-end-of-hunk))
347 (point)))
348 (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))))
349
350
d87e5627 351(defun diff-hunk-kill ()
610a6418
SM
352 "Kill current hunk."
353 (interactive)
354 (diff-beginning-of-hunk)
1eabc5e6
SM
355 (let* ((start (point))
356 (nexthunk (ignore-errors (diff-hunk-next) (point)))
357 (firsthunk (ignore-errors
358 (goto-char start)
359 (diff-beginning-of-file) (diff-hunk-next) (point)))
360 (nextfile (ignore-errors (diff-file-next) (point))))
361 (goto-char start)
610a6418
SM
362 (if (and firsthunk (= firsthunk start)
363 (or (null nexthunk)
364 (and nextfile (> nexthunk nextfile))))
1eabc5e6 365 ;; It's the only hunk for this file, so kill the file.
d87e5627 366 (diff-file-kill)
610a6418
SM
367 (diff-end-of-hunk)
368 (kill-region start (point)))))
369
d87e5627 370(defun diff-file-kill ()
610a6418
SM
371 "Kill current file's hunks."
372 (interactive)
373 (diff-beginning-of-file)
374 (let* ((start (point))
375 (prevhunk (save-excursion
376 (ignore-errors
d87e5627 377 (diff-hunk-prev) (point))))
610a6418
SM
378 (index (save-excursion
379 (re-search-backward "^Index: " prevhunk t))))
380 (when index (setq start index))
381 (diff-end-of-file)
382 (kill-region start (point))))
383
fef8c55b
SM
384(defun diff-kill-junk ()
385 "Kill spurious empty diffs."
386 (interactive)
387 (save-excursion
388 (let ((inhibit-read-only t))
389 (goto-char (point-min))
390 (while (re-search-forward (concat "^\\(Index: .*\n\\)"
391 "\\([^-+!* <>].*\n\\)*?"
392 "\\(\\(Index:\\) \\|"
393 diff-file-header-re "\\)")
394 nil t)
395 (delete-region (if (match-end 4) (match-beginning 0) (match-end 1))
396 (match-beginning 3))
397 (beginning-of-line)))))
398
cd632e57
SM
399(defun diff-count-matches (re start end)
400 (save-excursion
401 (let ((n 0))
402 (goto-char start)
403 (while (re-search-forward re end t) (incf n))
404 n)))
405
406(defun diff-split-hunk ()
407 "Split the current (unified diff) hunk at point into two hunks."
408 (interactive)
409 (beginning-of-line)
410 (let ((pos (point))
411 (start (progn (diff-beginning-of-hunk) (point))))
412 (unless (looking-at "@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@")
413 (error "diff-split-hunk only works on unified context diffs"))
414 (forward-line 1)
415 (let* ((start1 (string-to-number (match-string 1)))
416 (start2 (string-to-number (match-string 2)))
417 (newstart1 (+ start1 (diff-count-matches "^[- \t]" (point) pos)))
418 (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos))))
419 (goto-char pos)
420 ;; Hopefully the after-change-function will not screw us over.
421 (insert "@@ -" (number-to-string newstart1) ",1 +"
422 (number-to-string newstart2) ",1 @@\n")
423 ;; Fix the original hunk-header.
424 (diff-fixup-modifs start pos))))
425
426
610a6418
SM
427;;;;
428;;;; jump to other buffers
429;;;;
430
0b82e382
SM
431(defvar diff-remembered-files-alist nil)
432
610a6418
SM
433(defun diff-filename-drop-dir (file)
434 (when (string-match "/" file) (substring file (match-end 0))))
435
0b82e382
SM
436(defun diff-merge-strings (ancestor from to)
437 "Merge the diff between ANCESTOR and FROM into TO.
438Returns the merged string if successful or nil otherwise.
d87e5627 439The strings are assumed not to contain any \"\\n\" (i.e. end of line).
0b82e382
SM
440If ANCESTOR = FROM, returns TO.
441If ANCESTOR = TO, returns FROM.
442The heuristic is simplistic and only really works for cases
443like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")."
444 ;; Ideally, we want:
445 ;; AMB ANB CMD -> CND
446 ;; but that's ambiguous if `foo' or `bar' is empty:
447 ;; a/foo a/foo1 b/foo.c -> b/foo1.c but not 1b/foo.c or b/foo.c1
d87e5627 448 (let ((str (concat ancestor "\n" from "\n" to)))
0b82e382 449 (when (and (string-match (concat
d87e5627
SM
450 "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n"
451 "\\1\\(.*\\)\\3\n"
0b82e382
SM
452 "\\(.*\\(\\2\\).*\\)\\'") str)
453 (equal to (match-string 5 str)))
454 (concat (substring str (match-beginning 5) (match-beginning 6))
455 (match-string 4 str)
456 (substring str (match-end 6) (match-end 5))))))
457
610a6418
SM
458(defun diff-find-file-name (&optional old)
459 "Return the file corresponding to the current patch.
460Non-nil OLD means that we want the old file."
461 (save-excursion
462 (unless (looking-at diff-file-header-re)
463 (or (ignore-errors (diff-beginning-of-file))
464 (re-search-forward diff-file-header-re nil t)))
465 (let* ((limit (save-excursion
466 (condition-case ()
d87e5627 467 (progn (diff-hunk-prev) (point))
610a6418 468 (error (point-min)))))
83b7b03b 469 (header-files
30cdf899 470 (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\(\\s-.*\\)?\n[-+][-+][-+] \\(\\S-+\\)")
9b1ac2f6
SM
471 (list (if old (match-string 1) (match-string 3))
472 (if old (match-string 3) (match-string 1)))
83b7b03b 473 (forward-line 1) nil))
610a6418 474 (fs (append
610a6418
SM
475 (when (save-excursion
476 (re-search-backward "^Index: \\(.+\\)" limit t))
477 (list (match-string 1)))
83b7b03b 478 header-files
610a6418
SM
479 (when (re-search-backward "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" nil t)
480 (list (if old (match-string 2) (match-string 4))
481 (if old (match-string 4) (match-string 2))))))
0b82e382 482 (fs (delq nil fs)))
610a6418 483 (or
0b82e382
SM
484 ;; use any previously used preference
485 (cdr (assoc fs diff-remembered-files-alist))
486 ;; try to be clever and use previous choices as an inspiration
487 (dolist (rf diff-remembered-files-alist)
488 (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
489 (if (and newfile (file-exists-p newfile)) (return newfile))))
490 ;; look for each file in turn. If none found, try again but
491 ;; ignoring the first level of directory, ...
492 (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
493 (file nil nil))
494 ((or (null files)
495 (setq file (do* ((files files (cdr files))
496 (file (car files) (car files)))
497 ((or (null file) (file-exists-p file))
498 file))))
499 file))
500 ;; <foo>.rej patches implicitly apply to <foo>
610a6418
SM
501 (and (string-match "\\.rej\\'" (or buffer-file-name ""))
502 (let ((file (substring buffer-file-name 0 (match-beginning 0))))
503 (when (file-exists-p file) file)))
0b82e382
SM
504 ;; if all else fails, ask the user
505 (let ((file (read-file-name (format "Use file %s: " (or (first fs) ""))
506 nil (first fs) t (first fs))))
507 (set (make-local-variable 'diff-remembered-files-alist)
508 (cons (cons fs file) diff-remembered-files-alist))
610a6418
SM
509 file)))))
510
1b1b5dae 511
19e713d8
DL
512(defun diff-mouse-goto-source (event)
513 "Run `diff-goto-source' for the diff at a mouse click."
514 (interactive "e")
515 (save-excursion
516 (mouse-set-point event)
517 (diff-goto-source)))
610a6418 518
281096ed 519
610a6418
SM
520(defun diff-ediff-patch ()
521 "Call `ediff-patch-file' on the current buffer."
522 (interactive)
523 (condition-case err
0e104800 524 (ediff-patch-file nil (current-buffer))
610a6418
SM
525 (wrong-number-of-arguments (ediff-patch-file))))
526
527;;;;
528;;;; Conversion functions
529;;;;
530
531;;(defvar diff-inhibit-after-change nil
532;; "Non-nil means inhibit `diff-mode's after-change functions.")
533
534(defun diff-unified->context (start end)
535 "Convert unified diffs to context diffs.
536START and END are either taken from the region (if a prefix arg is given) or
537else cover the whole bufer."
538 (interactive (if current-prefix-arg
539 (list (mark) (point))
540 (list (point-min) (point-max))))
541 (unless (markerp end) (setq end (copy-marker end)))
542 (let (;;(diff-inhibit-after-change t)
543 (inhibit-read-only t))
544 (save-excursion
545 (goto-char start)
c0078a04 546 (while (and (re-search-forward "^\\(\\(---\\) .+\n\\(\\+\\+\\+\\) .+\\|@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@.*\\)$" nil t)
610a6418
SM
547 (< (point) end))
548 (combine-after-change-calls
549 (if (match-beginning 2)
0e104800 550 ;; we matched a file header
610a6418
SM
551 (progn
552 ;; use reverse order to make sure the indices are kept valid
553 (replace-match "---" t t nil 3)
554 (replace-match "***" t t nil 2))
555 ;; we matched a hunk header
556 (let ((line1 (match-string 4))
557 (lines1 (match-string 5))
558 (line2 (match-string 6))
559 (lines2 (match-string 7)))
560 (replace-match
561 (concat "***************\n*** " line1 ","
562 (number-to-string (+ (string-to-number line1)
563 (string-to-number lines1)
564 -1)) " ****"))
565 (forward-line 1)
566 (save-restriction
567 (narrow-to-region (point)
568 (progn (diff-end-of-hunk 'unified) (point)))
569 (let ((hunk (buffer-string)))
570 (goto-char (point-min))
571 (if (not (save-excursion (re-search-forward "^-" nil t)))
572 (delete-region (point) (point-max))
573 (goto-char (point-max))
574 (let ((modif nil) last-pt)
575 (while (progn (setq last-pt (point))
576 (= (forward-line -1) 0))
577 (case (char-after)
578 (? (insert " ") (setq modif nil) (backward-char 1))
579 (?+ (delete-region (point) last-pt) (setq modif t))
580 (?- (if (not modif)
581 (progn (forward-char 1)
582 (insert " "))
583 (delete-char 1)
584 (insert "! "))
585 (backward-char 2))
586 (?\\ (when (save-excursion (forward-line -1)
587 (= (char-after) ?+))
588 (delete-region (point) last-pt) (setq modif t)))
589 (t (setq modif nil))))))
590 (goto-char (point-max))
591 (save-excursion
592 (insert "--- " line2 ","
593 (number-to-string (+ (string-to-number line2)
594 (string-to-number lines2)
595 -1)) " ----\n" hunk))
596 ;;(goto-char (point-min))
597 (forward-line 1)
598 (if (not (save-excursion (re-search-forward "^+" nil t)))
599 (delete-region (point) (point-max))
600 (let ((modif nil) (delete nil))
601 (while (not (eobp))
602 (case (char-after)
603 (? (insert " ") (setq modif nil) (backward-char 1))
604 (?- (setq delete t) (setq modif t))
605 (?+ (if (not modif)
606 (progn (forward-char 1)
607 (insert " "))
608 (delete-char 1)
609 (insert "! "))
610 (backward-char 2))
611 (?\\ (when (save-excursion (forward-line 1)
612 (not (eobp)))
613 (setq delete t) (setq modif t)))
614 (t (setq modif nil)))
615 (let ((last-pt (point)))
616 (forward-line 1)
617 (when delete
618 (delete-region last-pt (point))
619 (setq delete nil)))))))))))))))
620
621(defun diff-context->unified (start end)
622 "Convert context diffs to unified diffs.
623START and END are either taken from the region (if a prefix arg is given) or
624else cover the whole bufer."
625 (interactive (if current-prefix-arg
626 (list (mark) (point))
627 (list (point-min) (point-max))))
628 (unless (markerp end) (setq end (copy-marker end)))
629 (let (;;(diff-inhibit-after-change t)
630 (inhibit-read-only t))
631 (save-excursion
632 (goto-char start)
c0078a04 633 (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)$" nil t)
610a6418
SM
634 (< (point) end))
635 (combine-after-change-calls
636 (if (match-beginning 2)
637 ;; we matched a file header
638 (progn
639 ;; use reverse order to make sure the indices are kept valid
640 (replace-match "+++" t t nil 3)
641 (replace-match "---" t t nil 2))
642 ;; we matched a hunk header
643 (let ((line1s (match-string 4))
644 (line1e (match-string 5))
645 (pt1 (match-beginning 0)))
646 (replace-match "")
647 (unless (re-search-forward
648 "^--- \\([0-9]+\\),\\(-?[0-9]+\\) ----$" nil t)
649 (error "Can't find matching `--- n1,n2 ----' line"))
650 (let ((line2s (match-string 1))
651 (line2e (match-string 2))
652 (pt2 (progn
653 (delete-region (progn (beginning-of-line) (point))
654 (progn (forward-line 1) (point)))
655 (point-marker))))
656 (goto-char pt1)
657 (forward-line 1)
658 (while (< (point) pt2)
659 (case (char-after)
660 ((?! ?-) (delete-char 2) (insert "-") (forward-line 1))
661 (?\ ;merge with the other half of the chunk
662 (let* ((endline2
663 (save-excursion
664 (goto-char pt2) (forward-line 1) (point)))
665 (c (char-after pt2)))
666 (case c
667 ((?! ?+)
668 (insert "+"
669 (prog1 (buffer-substring (+ pt2 2) endline2)
670 (delete-region pt2 endline2))))
671 (?\ ;FIXME: check consistency
672 (delete-region pt2 endline2)
673 (delete-char 1)
674 (forward-line 1))
675 (?\\ (forward-line 1))
676 (t (delete-char 1) (forward-line 1)))))
677 (t (forward-line 1))))
678 (while (looking-at "[+! ] ")
679 (if (/= (char-after) ?!) (forward-char 1)
680 (delete-char 1) (insert "+"))
681 (delete-char 1) (forward-line 1))
682 (save-excursion
683 (goto-char pt1)
684 (insert "@@ -" line1s ","
685 (number-to-string (- (string-to-number line1e)
686 (string-to-number line1s)
687 -1))
688 " +" line2s ","
689 (number-to-string (- (string-to-number line2e)
690 (string-to-number line2s)
691 -1)) " @@"))))))))))
692
693(defun diff-reverse-direction (start end)
694 "Reverse the direction of the diffs.
695START and END are either taken from the region (if a prefix arg is given) or
696else cover the whole bufer."
697 (interactive (if current-prefix-arg
698 (list (mark) (point))
699 (list (point-min) (point-max))))
700 (unless (markerp end) (setq end (copy-marker end)))
701 (let (;;(diff-inhibit-after-change t)
702 (inhibit-read-only t))
703 (save-excursion
704 (goto-char start)
c0078a04 705 (while (and (re-search-forward "^\\(\\([-*][-*][-*] \\)\\(.+\\)\n\\([-+][-+][-+] \\)\\(.+\\)\\|\\*\\{15\\}.*\n\\*\\*\\* \\(.+\\) \\*\\*\\*\\*\\|@@ -\\([0-9,]+\\) \\+\\([0-9,]+\\) @@.*\\)$" nil t)
610a6418
SM
706 (< (point) end))
707 (combine-after-change-calls
708 (cond
709 ;; a file header
710 ((match-beginning 2) (replace-match "\\2\\5\n\\4\\3" nil))
711 ;; a context-diff hunk header
712 ((match-beginning 6)
713 (let ((pt-lines1 (match-beginning 6))
714 (lines1 (match-string 6)))
715 (replace-match "" nil nil nil 6)
716 (forward-line 1)
717 (let ((half1s (point)))
0e104800 718 (while (looking-at "[-! \\][ \t]\\|#")
610a6418
SM
719 (when (= (char-after) ?-) (delete-char 1) (insert "+"))
720 (forward-line 1))
fef8c55b 721 (let ((half1 (delete-and-extract-region half1s (point))))
610a6418
SM
722 (unless (looking-at "^--- \\([0-9]+,-?[0-9]+\\) ----$")
723 (insert half1)
724 (error "Can't find matching `--- n1,n2 ----' line"))
725 (let ((str1 (match-string 1)))
726 (replace-match lines1 nil nil nil 1)
727 (forward-line 1)
728 (let ((half2s (point)))
0e104800 729 (while (looking-at "[!+ \\][ \t]\\|#")
610a6418
SM
730 (when (= (char-after) ?+) (delete-char 1) (insert "-"))
731 (forward-line 1))
fef8c55b 732 (let ((half2 (delete-and-extract-region half2s (point))))
0e104800 733 (insert (or half1 ""))
610a6418 734 (goto-char half1s)
0e104800 735 (insert (or half2 ""))))
610a6418
SM
736 (goto-char pt-lines1)
737 (insert str1))))))
738 ;; a unified-diff hunk header
739 ((match-beginning 7)
740 (replace-match "@@ -\\8 +\\7 @@" nil)
741 (forward-line 1)
742 (let ((c (char-after)) first last)
743 (while (case (setq c (char-after))
744 (?- (setq first (or first (point)))
745 (delete-char 1) (insert "+") t)
746 (?+ (setq last (or last (point)))
747 (delete-char 1) (insert "-") t)
0e104800 748 ((?\\ ?#) t)
610a6418 749 (t (when (and first last (< first last))
fef8c55b
SM
750 (let ((str
751 (save-excursion
752 (delete-and-extract-region first last))))
610a6418
SM
753 (insert str)))
754 (setq first nil last nil)
755 (equal ?\ c)))
756 (forward-line 1))))))))))
757
758(defun diff-fixup-modifs (start end)
759 "Fixup the hunk headers (in case the buffer was modified).
760START and END are either taken from the region (if a prefix arg is given) or
761else cover the whole bufer."
762 (interactive (if current-prefix-arg
763 (list (mark) (point))
764 (list (point-min) (point-max))))
765 (let ((inhibit-read-only t))
766 (save-excursion
767 (goto-char end) (diff-end-of-hunk)
768 (let ((plus 0) (minus 0) (space 0) (bang 0))
769 (while (and (= (forward-line -1) 0) (<= start (point)))
c0078a04 770 (if (not (looking-at "\\(@@ -[0-9,]+ \\+[0-9,]+ @@.*\\|[-*][-*][-*] .+ [-*][-*][-*][-*]\\)$"))
610a6418
SM
771 (case (char-after)
772 (?\ (incf space))
773 (?+ (incf plus))
774 (?- (incf minus))
775 (?! (incf bang))
0e104800 776 ((?\\ ?#) nil)
610a6418
SM
777 (t (setq space 0 plus 0 minus 0 bang 0)))
778 (cond
c0078a04 779 ((looking-at "@@ -[0-9]+,\\([0-9]*\\) \\+[0-9]+,\\([0-9]*\\) @@.*$")
610a6418
SM
780 (let* ((old1 (match-string 1))
781 (old2 (match-string 2))
782 (new1 (number-to-string (+ space minus)))
783 (new2 (number-to-string (+ space plus))))
784 (unless (string= new2 old2) (replace-match new2 t t nil 2))
785 (unless (string= new1 old1) (replace-match new1 t t nil 1))))
786 ((looking-at "--- \\([0-9]+\\),\\([0-9]*\\) ----$")
787 (when (> (+ space bang plus) 0)
788 (let* ((old1 (match-string 1))
789 (old2 (match-string 2))
790 (new (number-to-string
791 (+ space bang plus -1 (string-to-number old1)))))
792 (unless (string= new old2) (replace-match new t t nil 2)))))
793 ((looking-at "\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]*\\) \\*\\*\\*\\*$")
794 (when (> (+ space bang minus) 0)
795 (let* ((old (match-string 1))
796 (new (format
797 (concat "%0" (number-to-string (length old)) "d")
798 (+ space bang minus -1 (string-to-number old)))))
799 (unless (string= new old) (replace-match new t t nil 2))))))
800 (setq space 0 plus 0 minus 0 bang 0)))))))
801
802;;;;
803;;;; Hooks
804;;;;
805
806(defun diff-write-contents-hooks ()
807 "Fixup hunk headers if necessary."
808 (if (buffer-modified-p) (diff-fixup-modifs (point-min) (point-max)))
809 nil)
810
610a6418
SM
811;; It turns out that making changes in the buffer from within an
812;; *-change-function is asking for trouble, whereas making them
813;; from a post-command-hook doesn't pose much problems
814(defvar diff-unhandled-changes nil)
815(defun diff-after-change-function (beg end len)
816 "Remember to fixup the hunk header.
817See `after-change-functions' for the meaning of BEG, END and LEN."
c0078a04
SM
818 ;; Ignoring changes when inhibit-read-only is set is strictly speaking
819 ;; incorrect, but it turns out that inhibit-read-only is normally not set
820 ;; inside editing commands, while it tends to be set when the buffer gets
821 ;; updated by an async process or by a conversion function, both of which
822 ;; would rather not be uselessly slowed down by this hook.
610a6418
SM
823 (when (and (not undo-in-progress) (not inhibit-read-only))
824 (if diff-unhandled-changes
825 (setq diff-unhandled-changes
826 (cons (min beg (car diff-unhandled-changes))
827 (max beg (cdr diff-unhandled-changes))))
828 (setq diff-unhandled-changes (cons beg end)))))
829
830(defun diff-post-command-hook ()
831 "Fixup hunk headers if necessary."
832 (when (consp diff-unhandled-changes)
833 (ignore-errors
834 (save-excursion
fef8c55b 835 (goto-char (car diff-unhandled-changes))
1eabc5e6
SM
836 ;; We used to fixup modifs on all the changes, but it turns out
837 ;; that it's safer not to do it on big changes, for example
838 ;; when yanking a big diff, since we might then screw up perfectly
839 ;; correct values. -stef
840 ;; (unless (ignore-errors
841 ;; (diff-beginning-of-hunk)
842 ;; (save-excursion
843 ;; (diff-end-of-hunk)
844 ;; (> (point) (car diff-unhandled-changes))))
845 ;; (goto-char (car diff-unhandled-changes))
846 ;; (re-search-forward diff-hunk-header-re (cdr diff-unhandled-changes))
847 ;; (diff-beginning-of-hunk))
848 ;; (diff-fixup-modifs (point) (cdr diff-unhandled-changes))
849 (diff-beginning-of-hunk)
850 (when (save-excursion
851 (diff-end-of-hunk)
852 (> (point) (cdr diff-unhandled-changes)))
853 (diff-fixup-modifs (point) (cdr diff-unhandled-changes)))))
610a6418
SM
854 (setq diff-unhandled-changes nil)))
855
610a6418
SM
856;;;;
857;;;; The main function
858;;;;
859
610a6418 860;;;###autoload
d87e5627 861(define-derived-mode diff-mode fundamental-mode "Diff"
0b82e382 862 "Major mode for viewing/editing context diffs.
769dd0f1
SM
863Supports unified and context diffs as well as (to a lesser extent)
864normal diffs.
865When the buffer is read-only, the ESC prefix is not necessary."
610a6418
SM
866 (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
867 (set (make-local-variable 'outline-regexp) diff-outline-regexp)
ccce6558
DL
868 (set (make-local-variable 'imenu-generic-expression)
869 diff-imenu-generic-expression)
19e713d8
DL
870 ;; These are not perfect. They would be better done separately for
871 ;; context diffs and unidiffs.
872 ;; (set (make-local-variable 'paragraph-start)
873 ;; (concat "@@ " ; unidiff hunk
874 ;; "\\|\\*\\*\\* " ; context diff hunk or file start
875 ;; "\\|--- [^\t]+\t")) ; context or unidiff file
876 ;; ; start (first or second line)
877 ;; (set (make-local-variable 'paragraph-separate) paragraph-start)
878 ;; (set (make-local-variable 'page-delimiter) "--- [^\t]+\t")
879 ;; compile support
cdbb79c1
SM
880
881 ;;;; compile support is not good enough yet. Also it can be annoying
882 ;; and should thus only be enabled conditionally.
883 ;; (set (make-local-variable 'compilation-file-regexp-alist)
884 ;; diff-file-regexp-alist)
885 ;; (set (make-local-variable 'compilation-error-regexp-alist)
886 ;; diff-error-regexp-alist)
887 ;; (when (string-match "\\.rej\\'" (or buffer-file-name ""))
888 ;; (set (make-local-variable 'compilation-current-file)
889 ;; (substring buffer-file-name 0 (match-beginning 0))))
890 ;; (compilation-shell-minor-mode 1)
891
769dd0f1 892 (when (and (> (point-max) (point-min)) diff-default-read-only)
2b960ac0 893 (toggle-read-only t))
769dd0f1 894 ;; setup change hooks
e8a1ed31 895 (if (not diff-update-on-the-fly)
610a6418
SM
896 (add-hook 'write-contents-hooks 'diff-write-contents-hooks)
897 (make-local-variable 'diff-unhandled-changes)
3cec9c57
SM
898 (add-hook 'after-change-functions 'diff-after-change-function nil t)
899 (add-hook 'post-command-hook 'diff-post-command-hook nil t))
610a6418 900 ;; Neat trick from Dave Love to add more bindings in read-only mode:
fef8c55b 901 (add-to-list (make-local-variable 'minor-mode-overriding-map-alist)
281096ed
SM
902 (cons 'buffer-read-only diff-mode-shared-map))
903 ;; add-log support
904 (set (make-local-variable 'add-log-current-defun-function)
905 'diff-current-defun)
1b1b5dae
SM
906 (set (make-local-variable 'add-log-buffer-file-name-function)
907 'diff-find-file-name))
610a6418
SM
908
909;;;###autoload
0b82e382
SM
910(define-minor-mode diff-minor-mode
911 "Minor mode for viewing/editing context diffs.
912\\{diff-minor-mode-map}"
913 nil " Diff" nil
914 ;; FIXME: setup font-lock
fef8c55b 915 ;; setup change hooks
e8a1ed31 916 (if (not diff-update-on-the-fly)
fef8c55b
SM
917 (add-hook 'write-contents-hooks 'diff-write-contents-hooks)
918 (make-local-variable 'diff-unhandled-changes)
3cec9c57
SM
919 (add-hook 'after-change-functions 'diff-after-change-function nil t)
920 (add-hook 'post-command-hook 'diff-post-command-hook nil t)))
0b82e382 921
610a6418 922
027ac3f8
SM
923;;;
924;;; Misc operations that have proved useful at some point.
925;;;
926
927(defun diff-next-complex-hunk ()
928 "Jump to the next \"complex\" hunk.
929\"Complex\" is approximated by \"the hunk changes the number of lines\".
930Only works for unified diffs."
931 (interactive)
932 (while
933 (and (re-search-forward "^@@ [-0-9]+,\\([0-9]+\\) [+0-9]+,\\([0-9]+\\) @@"
934 nil t)
935 (equal (match-string 1) (match-string 2)))))
936
1eabc5e6
SM
937(defun diff-hunk-text (hunk destp char-offset)
938 "Return the literal source text from HUNK as (TEXT . OFFSET).
939if DESTP is nil TEXT is the source, otherwise the destination text.
940CHAR-OFFSET is a char-offset in HUNK, and OFFSET is the corresponding
941char-offset in TEXT."
3017133f 942 (with-temp-buffer
6e4e8a3b
SM
943 (insert hunk)
944 (goto-char (point-min))
945 (let ((src-pos nil)
946 (dst-pos nil)
947 (divider-pos nil)
948 (num-pfx-chars 2))
949 ;; Set the following variables:
950 ;; SRC-POS buffer pos of the source part of the hunk or nil if none
951 ;; DST-POS buffer pos of the destination part of the hunk or nil
952 ;; DIVIDER-POS buffer pos of any divider line separating the src & dst
953 ;; NUM-PFX-CHARS number of line-prefix characters used by this format"
954 (cond ((looking-at "^@@")
955 ;; unified diff
956 (setq num-pfx-chars 1)
957 (forward-line 1)
958 (setq src-pos (point) dst-pos (point)))
959 ((looking-at "^\\*\\*")
960 ;; context diff
961 (forward-line 2)
962 (setq src-pos (point))
963 (re-search-forward "^--- " nil t)
964 (forward-line 0)
965 (setq divider-pos (point))
966 (forward-line 1)
967 (setq dst-pos (point)))
968 ((looking-at "^[0-9]+a[0-9,]+$")
969 ;; normal diff, insert
970 (forward-line 1)
971 (setq dst-pos (point)))
972 ((looking-at "^[0-9,]+d[0-9]+$")
973 ;; normal diff, delete
974 (forward-line 1)
975 (setq src-pos (point)))
976 ((looking-at "^[0-9,]+c[0-9,]+$")
977 ;; normal diff, change
978 (forward-line 1)
979 (setq src-pos (point))
980 (re-search-forward "^---$" nil t)
981 (forward-line 0)
982 (setq divider-pos (point))
983 (forward-line 1)
984 (setq dst-pos (point)))
985 (t
986 (error "Unknown diff hunk type")))
987
988 (if (if destp (null dst-pos) (null src-pos))
989 ;; Implied empty text
990 (if char-offset '("" . 0) "")
991
992 ;; For context diffs, either side can be empty, (if there's only
993 ;; added or only removed text). We should then use the other side.
994 (cond ((equal src-pos divider-pos) (setq src-pos dst-pos))
995 ((equal dst-pos (point-max)) (setq dst-pos src-pos)))
996
997 (when char-offset (goto-char (+ (point-min) char-offset)))
998
999 ;; Get rid of anything except the desired text.
1000 (save-excursion
1001 ;; Delete unused text region
1002 (let ((keep (if destp dst-pos src-pos)))
1003 (when (and divider-pos (> divider-pos keep))
1004 (delete-region divider-pos (point-max)))
1005 (delete-region (point-min) keep))
1006 ;; Remove line-prefix characters, and unneeded lines (unified diffs).
1007 (let ((kill-char (if destp ?- ?+)))
1008 (goto-char (point-min))
1009 (while (not (eobp))
1010 (if (eq (char-after) kill-char)
1011 (delete-region (point) (progn (forward-line 1) (point)))
1012 (delete-char num-pfx-chars)
1013 (forward-line 1)))))
1014
1015 (let ((text (buffer-substring-no-properties (point-min) (point-max))))
1016 (if char-offset (cons text (- (point) (point-min))) text))))))
370d860c 1017
7530b6da 1018
c0aa75f7 1019(defun diff-find-text (text)
1eabc5e6 1020 "Return the buffer position (BEG . END) of the nearest occurrence of TEXT.
7530b6da 1021If TEXT isn't found, nil is returned."
7530b6da
MB
1022 (let* ((orig (point))
1023 (forw (and (search-forward text nil t)
1eabc5e6 1024 (cons (match-beginning 0) (match-end 0))))
7530b6da
MB
1025 (back (and (goto-char (+ orig (length text)))
1026 (search-backward text nil t)
1eabc5e6
SM
1027 (cons (match-beginning 0) (match-end 0)))))
1028 ;; Choose the closest match.
1029 (if (and forw back)
1030 (if (> (- (car forw) orig) (- orig (car back))) back forw)
1031 (or back forw))))
1032
1033(defun diff-find-approx-text (text)
1034 "Return the buffer position (BEG . END) of the nearest occurrence of TEXT.
1035Whitespace differences are ignored."
1036 (let* ((orig (point))
1037 (re (concat "^[ \t\n\f]*"
1038 (mapconcat 'regexp-quote (split-string text) "[ \t\n\f]+")
1039 "[ \t\n\f]*\n"))
1040 (forw (and (re-search-forward re nil t)
1041 (cons (match-beginning 0) (match-end 0))))
1042 (back (and (goto-char (+ orig (length text)))
1043 (re-search-backward re nil t)
1044 (cons (match-beginning 0) (match-end 0)))))
1045 ;; Choose the closest match.
7530b6da 1046 (if (and forw back)
1eabc5e6 1047 (if (> (- (car forw) orig) (- orig (car back))) back forw)
7530b6da
MB
1048 (or back forw))))
1049
370d860c
SM
1050(defsubst diff-xor (a b) (if a (not b) b))
1051
d868b3bd 1052(defun diff-find-source-location (&optional other-file reverse)
1eabc5e6
SM
1053 "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED).
1054BUF is the buffer corresponding to the source file.
1055LINE-OFFSET is the offset between the expected and actual positions
1056 of the text of the hunk or nil if the text was not found.
1057POS is a pair (BEG . END) indicating the position of the text in the buffer.
1058SRC and DST are the two variants of text as returned by `diff-hunk-text'.
1059 SRC is the variant that was found in the buffer.
1060SWITCHED is non-nil if the patch is already applied."
7b91e0f2 1061 (save-excursion
e8a1ed31 1062 (let* ((other (diff-xor other-file diff-jump-to-old-file))
370d860c
SM
1063 (char-offset (- (point) (progn (diff-beginning-of-hunk) (point))))
1064 (hunk (buffer-substring (point)
1065 (save-excursion (diff-end-of-hunk) (point))))
1066 (old (diff-hunk-text hunk reverse char-offset))
1067 (new (diff-hunk-text hunk (not reverse) char-offset))
7b91e0f2 1068 ;; Find the location specification.
d868b3bd 1069 (line (if (not (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?"))
370d860c
SM
1070 (error "Can't find the hunk header")
1071 (if other (match-string 1)
1072 (if (match-end 3) (match-string 3)
1073 (unless (re-search-forward "^--- \\([0-9,]+\\)" nil t)
1074 (error "Can't find the hunk separator"))
1075 (match-string 1)))))
1076 (file (or (diff-find-file-name other) (error "Can't find the file")))
1077 (buf (find-file-noselect file)))
7b91e0f2
SM
1078 ;; Update the user preference if he so wished.
1079 (when (> (prefix-numeric-value other-file) 8)
e8a1ed31 1080 (setq diff-jump-to-old-file other))
d868b3bd
SM
1081 (with-current-buffer buf
1082 (goto-line (string-to-number line))
1083 (let* ((orig-pos (point))
1eabc5e6
SM
1084 (switched nil)
1085 (pos (or (diff-find-text (car old))
1086 (progn (setq switched t) (diff-find-text (car new)))
1087 (progn (setq switched nil)
1088 (diff-find-approx-text (car old)))
1089 (progn (setq switched t)
1090 (diff-find-approx-text (car new)))
1091 (progn (setq switched nil) nil))))
370d860c
SM
1092 (nconc
1093 (list buf)
1eabc5e6
SM
1094 (if pos
1095 (list (count-lines orig-pos (car pos)) pos)
1096 (list nil (cons orig-pos (+ orig-pos (length (car old))))))
370d860c
SM
1097 (if switched (list new old t) (list old new))))))))
1098
7b91e0f2 1099
370d860c
SM
1100(defun diff-hunk-status-msg (line-offset reversed dry-run)
1101 (let ((msg (if dry-run
1102 (if reversed "already applied" "not yet applied")
1103 (if reversed "undone" "applied"))))
1104 (message (cond ((null line-offset) "Hunk text not found")
1105 ((= line-offset 0) "Hunk %s")
1106 ((= line-offset 1) "Hunk %s at offset %d line")
1107 (t "Hunk %s at offset %d lines"))
1108 msg line-offset)))
1109
1110
1111(defun diff-apply-hunk (&optional reverse)
6e4e8a3b 1112 "Apply the current hunk to the source file and go to the next.
7530b6da 1113By default, the new source file is patched, but if the variable
e8a1ed31 1114`diff-jump-to-old-file' is non-nil, then the old source file is
7530b6da
MB
1115patched instead (some commands, such as `diff-goto-source' can change
1116the value of this variable when given an appropriate prefix argument).
1117
4eaa6852 1118With a prefix argument, REVERSE the hunk."
370d860c 1119 (interactive "P")
281096ed 1120 (destructuring-bind (buf line-offset pos old new &optional switched)
370d860c
SM
1121 (diff-find-source-location nil reverse)
1122 (cond
4eaa6852
MB
1123 ((null line-offset)
1124 (error "Can't find the text to patch"))
370d860c 1125 ((and switched
cdbb79c1 1126 ;; A reversed patch was detected, perhaps apply it in reverse.
370d860c
SM
1127 (not (save-window-excursion
1128 (pop-to-buffer buf)
1eabc5e6 1129 (goto-char (+ (car pos) (cdr old)))
370d860c
SM
1130 (y-or-n-p
1131 (if reverse
1132 "Hunk hasn't been applied yet; apply it now? "
1133 "Hunk has already been applied; undo it? ")))))
4eaa6852 1134 (message "(Nothing done)"))
370d860c 1135 (t
4eaa6852
MB
1136 ;; Apply the hunk
1137 (with-current-buffer buf
1eabc5e6
SM
1138 (goto-char (car pos))
1139 (delete-region (car pos) (cdr pos))
4eaa6852
MB
1140 (insert (car new)))
1141 ;; Display BUF in a window
1eabc5e6 1142 (set-window-point (display-buffer buf) (+ (car pos) (cdr new)))
4eaa6852
MB
1143 (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
1144 (when diff-advance-after-apply-hunk
1145 (diff-hunk-next))))))
370d860c 1146
7530b6da 1147
7530b6da
MB
1148(defun diff-test-hunk (&optional reverse)
1149 "See whether it's possible to apply the current hunk.
4eaa6852 1150With a prefix argument, try to REVERSE the hunk."
7530b6da 1151 (interactive "P")
370d860c
SM
1152 (destructuring-bind (buf line-offset pos src dst &optional switched)
1153 (diff-find-source-location nil reverse)
1eabc5e6 1154 (set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
4eaa6852 1155 (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
370d860c 1156
7530b6da
MB
1157
1158(defun diff-goto-source (&optional other-file)
1159 "Jump to the corresponding source line.
e8a1ed31 1160`diff-jump-to-old-file' (or its opposite if the OTHER-FILE prefix arg
281096ed 1161is given) determines whether to jump to the old or the new file.
7530b6da 1162If the prefix arg is bigger than 8 (for example with \\[universal-argument] \\[universal-argument])
e8a1ed31 1163 then `diff-jump-to-old-file' is also set, for the next invocations."
7530b6da 1164 (interactive "P")
a6373340
SM
1165 ;; When pointing at a removal line, we probably want to jump to
1166 ;; the old location, and else to the new (i.e. as if reverting).
1167 ;; This is a convenient detail when using smerge-diff.
1168 (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
1169 (destructuring-bind (buf line-offset pos src dst &optional switched)
1170 (diff-find-source-location other-file rev)
1171 (pop-to-buffer buf)
1eabc5e6 1172 (goto-char (+ (car pos) (cdr src)))
55d5d717 1173 (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
370d860c 1174
7530b6da 1175
281096ed 1176(defun diff-current-defun ()
370d860c
SM
1177 "Find the name of function at point.
1178For use in `add-log-current-defun-function'."
281096ed
SM
1179 (destructuring-bind (buf line-offset pos src dst &optional switched)
1180 (diff-find-source-location)
1181 (save-excursion
1182 (beginning-of-line)
1183 (or (when (memq (char-after) '(?< ?-))
370d860c
SM
1184 ;; Cursor is pointing at removed text. This could be a removed
1185 ;; function, in which case, going to the source buffer will
1186 ;; not help since the function is now removed. Instead,
1187 ;; try to figure out the function name just from the code-fragment.
281096ed
SM
1188 (let ((old (if switched dst src)))
1189 (with-temp-buffer
1190 (insert (car old))
1191 (goto-char (cdr old))
1192 (funcall (with-current-buffer buf major-mode))
1193 (add-log-current-defun))))
1194 (with-current-buffer buf
1eabc5e6 1195 (goto-char (+ (car pos) (cdr src)))
281096ed 1196 (add-log-current-defun))))))
027ac3f8 1197
610a6418
SM
1198;; provide the package
1199(provide 'diff-mode)
1200
027ac3f8 1201;;; Old Change Log from when diff-mode wasn't part of Emacs:
610a6418
SM
1202;; Revision 1.11 1999/10/09 23:38:29 monnier
1203;; (diff-mode-load-hook): dropped.
1204;; (auto-mode-alist): also catch *.diffs.
1205;; (diff-find-file-name, diff-mode): add smarts to find the right file
1206;; for *.rej files (that lack any file name indication).
1207;;
1208;; Revision 1.10 1999/09/30 15:32:11 monnier
1209;; added support for "\ No newline at end of file".
1210;;
1211;; Revision 1.9 1999/09/15 00:01:13 monnier
1212;; - added basic `compile' support.
1213;; - have diff-kill-hunk call diff-kill-file if it's the only hunk.
1214;; - diff-kill-file now tries to kill the leading garbage as well.
1215;;
1216;; Revision 1.8 1999/09/13 21:10:09 monnier
1217;; - don't use CL in the autoloaded code
1218;; - accept diffs using -T
1219;;
1220;; Revision 1.7 1999/09/05 20:53:03 monnier
1221;; interface to ediff-patch
1222;;
1223;; Revision 1.6 1999/09/01 20:55:13 monnier
1224;; (ediff=patch-file): add bindings to call ediff-patch.
1225;; (diff-find-file-name): taken out of diff-goto-source.
1226;; (diff-unified->context, diff-context->unified, diff-reverse-direction,
1227;; diff-fixup-modifs): only use the region if a prefix arg is given.
1228;;
1229;; Revision 1.5 1999/08/31 19:18:52 monnier
1230;; (diff-beginning-of-file, diff-prev-file): fixed wrong parenthesis.
1231;;
1232;; Revision 1.4 1999/08/31 13:01:44 monnier
1233;; use `combine-after-change-calls' to minimize the slowdown of font-lock.
1234;;
1235
1236;;; diff-mode.el ends here