;;; diff-mode.el --- A mode for viewing/editing context diffs
-;; Copyright (C) 1998-1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: patch diff
-;; Revision: $Id: diff-mode.el,v 1.8 2000/06/05 07:30:09 monnier Exp $
;; This file is part of GNU Emacs.
;;; Commentary:
-;; Provides support for font-lock patterns, outline-regexps, navigation
+;; Provides support for font-lock, outline, navigation
;; commands, editing and various conversions as well as jumping
;; to the corresponding source file.
;; Bugs:
;; - Reverse doesn't work with normal diffs.
-;; - (nitpick) The mark is not always quite right in diff-goto-source.
-;; - diff-apply-hunk only works on unified diffs.
;; Todo:
-;; - Add change-log support.
-;; - Spice up the minor-mode with font-lock support.
;; - Improve narrowed-view support.
-;; - Improve the `compile' support (?).
-;; - Recognize pcl-cvs' special string for `cvs-execute-single'.
+;; - re-enable (conditionally) the `compile' support after improving it to use
+;; the same code as diff-goto-source.
;; - Support for # comments in context->unified.
;; - Do a fuzzy search in diff-goto-source.
;; - 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.
-;; - imenu support.
;; - 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))
(defgroup diff-mode ()
- "Major-mode for viewing/editing diffs"
+ "Major mode for viewing/editing diffs"
+ :version "21.1"
:group 'tools
:group 'diff)
-(defcustom diff-jump-to-old-file-flag nil
+(defcustom diff-default-read-only t
+ "If non-nil, `diff-mode' buffers default to being read-only."
+ :type 'boolean
+ :group 'diff-mode)
+
+(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."
:group 'diff-mode
:type '(boolean))
-(defcustom diff-update-on-the-fly-flag t
+(defcustom diff-update-on-the-fly t
"*Non-nil means hunk headers are kept up-to-date on-the-fly.
When editing a diff file, the line numbers in the hunk headers
need to be kept consistent with the actual diff. This can
:group 'diff-mode
:type '(boolean))
+(defcustom diff-advance-after-apply-hunk t
+ "*Non-nil means `diff-apply-hunk' will move to the next hunk after applying."
+ :group 'diff-mode
+ :type 'boolean)
+
+
(defvar diff-mode-hook nil
"Run after setting up the `diff-mode' major mode.")
(defvar diff-outline-regexp
"\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
-;;;;
+;;;;
;;;; keymap, menu, ...
-;;;;
+;;;;
(easy-mmode-defmap diff-mode-shared-map
'(;; From Pavel Machek's patch-mode.
("}" . diff-file-next)
("{" . diff-file-prev)
("\C-m" . diff-goto-source)
+ ([mouse-2] . diff-mouse-goto-source)
;; From XEmacs' diff-mode.
("W" . widen)
;;("." . diff-goto-source) ;display-buffer
;; From compilation-minor-mode.
("\C-c\C-c" . diff-goto-source)
;; Misc operations.
- ("\C-cda" . diff-apply-hunk))
+ ("\C-c\C-s" . diff-split-hunk)
+ ("\C-c\C-a" . diff-apply-hunk)
+ ("\C-c\C-t" . diff-test-hunk))
"Keymap for `diff-mode'. See also `diff-mode-shared-map'.")
(easy-menu-define diff-mode-menu diff-mode-map
"Menu for `diff-mode'."
'("Diff"
["Jump to Source" diff-goto-source t]
- ["Apply with Ediff" diff-ediff-patch t]
+ ["Apply hunk" diff-apply-hunk t]
+ ["Apply diff with Ediff" diff-ediff-patch t]
["-----" nil nil]
["Reverse direction" diff-reverse-direction t]
["Context -> Unified" diff-context->unified t]
;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)]
))
-(defcustom diff-minor-mode-prefix "\C-cd"
+(defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands."
:group 'diff-mode
- :type '(choice (string "\e") (string "C-cd") string))
+ :type '(choice (string "\e") (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'.")
-;;;;
+;;;;
;;;; font-lock support
-;;;;
+;;;;
+
+(defface diff-header-face
+ '((((type tty pc) (class color) (background light))
+ (:foreground "blue1" :bold t))
+ (((type tty pc) (class color) (background dark))
+ (:foreground "green" :bold t))
+ (((class color) (background light))
+ (:background "grey85"))
+ (((class color) (background dark))
+ (:background "grey45"))
+ (t (:bold t)))
+ "`diff-mode' face inherited by hunk and index header faces."
+ :group 'diff-mode)
+(defvar diff-header-face 'diff-header-face)
(defface diff-file-header-face
- '((((class color) (background light))
+ '((((type tty pc) (class color) (background light))
+ (:foreground "yellow" :bold t))
+ (((type tty pc) (class color) (background dark))
+ (:foreground "cyan" :bold t))
+ (((class color) (background light))
(:background "grey70" :bold t))
- (t (:bold t)))
- "diff-mode face used to highlight file header lines."
+ (((class color) (background dark))
+ (:background "grey60" :bold t))
+ (t (:bold t))) ; :height 1.3
+ "`diff-mode' face used to highlight file header lines."
:group 'diff-mode)
(defvar diff-file-header-face 'diff-file-header-face)
(defface diff-index-face
- '((((class color) (background light))
- (:background "grey70" :bold t))
- (t (:bold t)))
- "diff-mode face used to highlight index header lines."
+ '((t (:inherit diff-file-header-face)))
+ "`diff-mode' face used to highlight index header lines."
:group 'diff-mode)
(defvar diff-index-face 'diff-index-face)
(defface diff-hunk-header-face
- '((((class color) (background light))
- (:background "grey85"))
- (t (:bold t)))
- "diff-mode face used to highlight hunk header lines."
+ '((t (:inherit diff-header-face)))
+ "`diff-mode' face used to highlight hunk header lines."
:group 'diff-mode)
(defvar diff-hunk-header-face 'diff-hunk-header-face)
(defface diff-removed-face
- '((t ()))
- "diff-mode face used to highlight removed lines."
+ '((t (:inherit diff-changed-face)))
+ "`diff-mode' face used to highlight removed lines."
:group 'diff-mode)
(defvar diff-removed-face 'diff-removed-face)
(defface diff-added-face
- '((t ()))
- "diff-mode face used to highlight added lines."
+ '((t (:inherit diff-changed-face)))
+ "`diff-mode' face used to highlight added lines."
:group 'diff-mode)
(defvar diff-added-face 'diff-added-face)
(defface diff-changed-face
- '((t ()))
- "diff-mode face used to highlight changed lines."
+ '((((type tty pc) (class color) (background light))
+ (:foreground "magenta" :bold t :italic t))
+ (((type tty pc) (class color) (background dark))
+ (:foreground "yellow" :bold t :italic t))
+ (t ()))
+ "`diff-mode' face used to highlight changed lines."
:group 'diff-mode)
(defvar diff-changed-face 'diff-changed-face)
+(defface diff-function-face
+ '((t (:inherit diff-context-face)))
+ "`diff-mode' face used to highlight function names produced by \"diff -p\"."
+ :group 'diff-mode)
+(defvar diff-function-face 'diff-function-face)
+
+(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."
+ :group 'diff-mode)
+(defvar diff-context-face 'diff-context-face)
+
+(defface diff-nonexistent-face
+ '((t (:inherit diff-file-header-face)))
+ "`diff-mode' face used to highlight nonexistent files in recursive diffs."
+ :group 'diff-mode)
+(defvar diff-nonexistent-face 'diff-nonexistent-face)
+
(defvar diff-font-lock-keywords
- '(("^@@ -[0-9,]+ \\+[0-9,]+ @@.*$" . diff-hunk-header-face) ;unified
+ '(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified
+ (1 diff-hunk-header-face)
+ (2 diff-function-face))
("^--- .+ ----$" . diff-hunk-header-face) ;context
- ("^\\*\\*\\*\\(.+\\*\\*\\*\\|\\*\\{12\\}.*\\)\n" . diff-hunk-header-face) ;context
- ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) .*\n" . diff-file-header-face)
+ ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context
+ (1 diff-hunk-header-face)
+ (2 diff-function-face))
+ ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header-face) ;context
+ ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\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" . diff-index-face)
+ ("^Index: \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend))
+ ("^Only in .*\n" . diff-nonexistent-face)
("^#.*" . font-lock-string-face)
- ("^[^-=+*!<>].*\n" . font-lock-comment-face)))
+ ("^[^-=+*!<>].*\n" . diff-context-face)))
(defconst diff-font-lock-defaults
'(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil)))
+(defvar diff-imenu-generic-expression
+ ;; Prefer second name as first is most likely to be a backup or
+ ;; version-control name. The [\t\n] at the end of the unidiff pattern
+ ;; catches Debian source diff files (which lack the trailing date).
+ '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
+ (nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
+
;;;;
;;;; Compile support
;;;;
("--- \\([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)))
(match-beginning 3))
(beginning-of-line)))))
+(defun diff-count-matches (re start end)
+ (save-excursion
+ (let ((n 0))
+ (goto-char start)
+ (while (re-search-forward re end t) (incf n))
+ n)))
+
+(defun diff-split-hunk ()
+ "Split the current (unified diff) hunk at point into two hunks."
+ (interactive)
+ (beginning-of-line)
+ (let ((pos (point))
+ (start (progn (diff-beginning-of-hunk) (point))))
+ (unless (looking-at "@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@")
+ (error "diff-split-hunk only works on unified context diffs"))
+ (forward-line 1)
+ (let* ((start1 (string-to-number (match-string 1)))
+ (start2 (string-to-number (match-string 2)))
+ (newstart1 (+ start1 (diff-count-matches "^[- \t]" (point) pos)))
+ (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos))))
+ (goto-char pos)
+ ;; Hopefully the after-change-function will not screw us over.
+ (insert "@@ -" (number-to-string newstart1) ",1 +"
+ (number-to-string newstart2) ",1 @@\n")
+ ;; Fix the original hunk-header.
+ (diff-fixup-modifs start pos))))
+
+
;;;;
;;;; jump to other buffers
;;;;
(progn (diff-hunk-prev) (point))
(error (point-min)))))
(header-files
- (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\s-.*\n[-+][-+][-+] \\(\\S-+\\)\\s-.*$")
- (list (if old (match-string 1) (match-string 2))
- (if old (match-string 2) (match-string 1)))
+ (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
(cons (cons fs file) diff-remembered-files-alist))
file)))))
-(defun diff-find-source-location (&optional other-file)
- "Find out (FILE LINE SPAN)."
- (save-excursion
- (diff-beginning-of-hunk)
- (let* ((old (if (not other-file) diff-jump-to-old-file-flag
- (not diff-jump-to-old-file-flag)))
- ;; Find the location specification.
- (loc (if (not (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?"))
- (error "Can't find the hunk header")
- (if old (match-string 1)
- (if (match-end 3) (match-string 3)
- (unless (re-search-forward "^--- \\([0-9,]+\\)" nil t)
- (error "Can't find the hunk separator"))
- (match-string 1)))))
- ;; Extract the actual line number.
- (lines (if (string-match "^\\([0-9]*\\),\\([0-9]*\\)" loc)
- (cons (string-to-number (match-string 1 loc))
- (string-to-number (match-string 2 loc)))
- (cons (string-to-number loc) nil)))
- (file (diff-find-file-name old))
- (line (car lines))
- (span (if (or (null (cdr lines)) (< (cdr lines) 0)) 0
- ;; Bad hack.
- (if (< (cdr lines) line) (cdr lines)
- (- (cdr lines) line)))))
- ;; Update the user preference if he so wished.
- (when (> (prefix-numeric-value other-file) 8)
- (setq diff-jump-to-old-file-flag old))
- (if (null file) (error "Can't find the file")
- (list file line span)))))
-(defun diff-goto-source (&optional other-file)
- "Jump to the corresponding source line.
-`diff-jump-to-old-file-flag' (or its opposite if the OTHER-FILE prefix arg
-is give) 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-flag' is also set, for the next invocations."
- (interactive "P")
+(defun diff-mouse-goto-source (event)
+ "Run `diff-goto-source' for the diff at a mouse click."
+ (interactive "e")
(save-excursion
- (let ((loc (diff-find-source-location other-file)))
- (pop-to-buffer (find-file-noselect (car loc)))
- (ignore-errors
- (goto-line (+ (cadr loc) (caddr loc)))
- (push-mark (point) t t)
- (goto-line (cadr loc))))))
+ (mouse-set-point event)
+ (diff-goto-source)))
(defun diff-ediff-patch ()
;;;###autoload
(define-derived-mode diff-mode fundamental-mode "Diff"
"Major mode for viewing/editing context diffs.
-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.
-This mode runs `diff-mode-hook'.
-\\{diff-mode-map}"
+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."
(set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
(set (make-local-variable 'outline-regexp) diff-outline-regexp)
+ (set (make-local-variable 'imenu-generic-expression)
+ diff-imenu-generic-expression)
+ ;; These are not perfect. They would be better done separately for
+ ;; context diffs and unidiffs.
+ ;; (set (make-local-variable 'paragraph-start)
+ ;; (concat "@@ " ; unidiff hunk
+ ;; "\\|\\*\\*\\* " ; context diff hunk or file start
+ ;; "\\|--- [^\t]+\t")) ; context or unidiff file
+ ;; ; start (first or second line)
+ ;; (set (make-local-variable 'paragraph-separate) paragraph-start)
+ ;; (set (make-local-variable 'page-delimiter) "--- [^\t]+\t")
;; compile 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))))
- (compilation-shell-minor-mode 1)
+
+ ;;;; compile support is not good enough yet. Also it can be annoying
+ ;; and should thus only be enabled conditionally.
+ ;; (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))))
+ ;; (compilation-shell-minor-mode 1)
+
+ (when (and (> (point-max) (point-min)) diff-default-read-only)
+ (toggle-read-only t))
;; setup change hooks
- (toggle-read-only t)
- (if (not diff-update-on-the-fly-flag)
+ (if (not diff-update-on-the-fly)
(add-hook 'write-contents-hooks 'diff-write-contents-hooks)
(make-local-variable 'diff-unhandled-changes)
- (add-hook (make-local-hook 'after-change-functions)
- 'diff-after-change-function nil t)
- (add-hook (make-local-hook 'post-command-hook)
- 'diff-post-command-hook nil t))
+ (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 (make-local-variable 'minor-mode-overriding-map-alist)
- (cons 'buffer-read-only diff-mode-shared-map)))
+ (cons 'buffer-read-only diff-mode-shared-map))
+ ;; add-log support
+ (set (make-local-variable 'add-log-current-defun-function)
+ 'diff-current-defun)
+ (set (make-local-variable 'add-log-buffer-file-name-function)
+ 'diff-find-file-name))
;;;###autoload
(define-minor-mode diff-minor-mode
nil " Diff" nil
;; FIXME: setup font-lock
;; setup change hooks
- (if (not diff-update-on-the-fly-flag)
+ (if (not diff-update-on-the-fly)
(add-hook 'write-contents-hooks 'diff-write-contents-hooks)
(make-local-variable 'diff-unhandled-changes)
- (add-hook (make-local-hook 'after-change-functions)
- 'diff-after-change-function nil t)
- (add-hook (make-local-hook 'post-command-hook)
- 'diff-post-command-hook nil t)))
+ (add-hook 'after-change-functions 'diff-after-change-function nil t)
+ (add-hook 'post-command-hook 'diff-post-command-hook nil t)))
;;;
nil t)
(equal (match-string 1) (match-string 2)))))
+(defun diff-hunk-text (hunk destp &optional char-offset)
+ "Return the literal source text from HUNK.
+if DESTP is nil return the source, otherwise the destination text.
+If CHAR-OFFSET is non-nil, it should be a char-offset in
+HUNK, and instead of a string, a cons cell is returned whose car is the
+appropriate text, and whose cdr is the corresponding char-offset in that text."
+ (with-temp-buffer
+ (insert hunk)
+ (goto-char (point-min))
+ (let ((src-pos nil)
+ (dst-pos nil)
+ (divider-pos nil)
+ (num-pfx-chars 2))
+ ;; Set the following variables:
+ ;; SRC-POS buffer pos of the source part of the hunk or nil if none
+ ;; DST-POS buffer pos of the destination part of the hunk or nil
+ ;; DIVIDER-POS buffer pos of any divider line separating the src & dst
+ ;; NUM-PFX-CHARS number of line-prefix characters used by this format"
+ (cond ((looking-at "^@@")
+ ;; unified diff
+ (setq num-pfx-chars 1)
+ (forward-line 1)
+ (setq src-pos (point) dst-pos (point)))
+ ((looking-at "^\\*\\*")
+ ;; context diff
+ (forward-line 2)
+ (setq src-pos (point))
+ (re-search-forward "^--- " nil t)
+ (forward-line 0)
+ (setq divider-pos (point))
+ (forward-line 1)
+ (setq dst-pos (point)))
+ ((looking-at "^[0-9]+a[0-9,]+$")
+ ;; normal diff, insert
+ (forward-line 1)
+ (setq dst-pos (point)))
+ ((looking-at "^[0-9,]+d[0-9]+$")
+ ;; normal diff, delete
+ (forward-line 1)
+ (setq src-pos (point)))
+ ((looking-at "^[0-9,]+c[0-9,]+$")
+ ;; normal diff, change
+ (forward-line 1)
+ (setq src-pos (point))
+ (re-search-forward "^---$" nil t)
+ (forward-line 0)
+ (setq divider-pos (point))
+ (forward-line 1)
+ (setq dst-pos (point)))
+ (t
+ (error "Unknown diff hunk type")))
+
+ (if (if destp (null dst-pos) (null src-pos))
+ ;; Implied empty text
+ (if char-offset '("" . 0) "")
+
+ ;; For context diffs, either side can be empty, (if there's only
+ ;; added or only removed text). We should then use the other side.
+ (cond ((equal src-pos divider-pos) (setq src-pos dst-pos))
+ ((equal dst-pos (point-max)) (setq dst-pos src-pos)))
+
+ (when char-offset (goto-char (+ (point-min) char-offset)))
+
+ ;; Get rid of anything except the desired text.
+ (save-excursion
+ ;; Delete unused text region
+ (let ((keep (if destp dst-pos src-pos)))
+ (when (and divider-pos (> divider-pos keep))
+ (delete-region divider-pos (point-max)))
+ (delete-region (point-min) keep))
+ ;; Remove line-prefix characters, and unneeded lines (unified diffs).
+ (let ((kill-char (if destp ?- ?+)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (eq (char-after) kill-char)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (delete-char num-pfx-chars)
+ (forward-line 1)))))
+
+ (let ((text (buffer-substring-no-properties (point-min) (point-max))))
+ (if char-offset (cons text (- (point) (point-min))) text))))))
+
+
+(defun diff-find-text (text)
+ "Return the buffer position of the nearest occurrence of TEXT.
+If TEXT isn't found, nil is returned."
+ (let* ((orig (point))
+ (forw (and (search-forward text nil t)
+ (match-beginning 0)))
+ (back (and (goto-char (+ orig (length text)))
+ (search-backward text nil t)
+ (match-beginning 0))))
+ ;; Choose the closest match.
+ (if (and forw back)
+ (if (> (- forw orig) (- orig back)) back forw)
+ (or back forw))))
+
+(defsubst diff-xor (a b) (if a (not b) b))
+
+(defun diff-find-source-location (&optional other-file reverse)
+ "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED)."
+ (save-excursion
+ (let* ((other (diff-xor other-file diff-jump-to-old-file))
+ (char-offset (- (point) (progn (diff-beginning-of-hunk) (point))))
+ (hunk (buffer-substring (point)
+ (save-excursion (diff-end-of-hunk) (point))))
+ (old (diff-hunk-text hunk reverse char-offset))
+ (new (diff-hunk-text hunk (not reverse) char-offset))
+ ;; Find the location specification.
+ (line (if (not (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?"))
+ (error "Can't find the hunk header")
+ (if other (match-string 1)
+ (if (match-end 3) (match-string 3)
+ (unless (re-search-forward "^--- \\([0-9,]+\\)" nil t)
+ (error "Can't find the hunk separator"))
+ (match-string 1)))))
+ (file (or (diff-find-file-name other) (error "Can't find the file")))
+ (buf (find-file-noselect file)))
+ ;; Update the user preference if he so wished.
+ (when (> (prefix-numeric-value other-file) 8)
+ (setq diff-jump-to-old-file other))
+ (with-current-buffer buf
+ (goto-line (string-to-number line))
+ (let* ((orig-pos (point))
+ (pos (diff-find-text (car old)))
+ (switched nil))
+ (when (null pos)
+ (setq pos (diff-find-text (car new)) switched t))
+ (nconc
+ (list buf)
+ (if pos (list (count-lines orig-pos pos) pos) (list nil orig-pos))
+ (if switched (list new old t) (list old new))))))))
+
+
+(defun diff-hunk-status-msg (line-offset reversed dry-run)
+ (let ((msg (if dry-run
+ (if reversed "already applied" "not yet applied")
+ (if reversed "undone" "applied"))))
+ (message (cond ((null line-offset) "Hunk text not found")
+ ((= line-offset 0) "Hunk %s")
+ ((= line-offset 1) "Hunk %s at offset %d line")
+ (t "Hunk %s at offset %d lines"))
+ msg line-offset)))
-(defun diff-filter-lines (char)
- (goto-char (point-min))
- (while (not (eobp))
- (if (eq (char-after) char)
- (delete-region (point) (progn (forward-line 1) (point)))
- (delete-char 1)
- (forward-line 1))))
(defun diff-apply-hunk (&optional reverse)
- "Apply the current hunk.
-With a prefix argument, REVERSE the hunk.
-FIXME: Only works for unified diffs."
+ "Apply the current hunk to the source file and go to the next.
+By default, the new source file is patched, but if the variable
+`diff-jump-to-old-file' is non-nil, then the old source file is
+patched instead (some commands, such as `diff-goto-source' can change
+the value of this variable when given an appropriate prefix argument).
+
+With a prefix argument, REVERSE the hunk."
(interactive "P")
- (save-excursion
- (let ((loc (diff-find-source-location nil)))
- (diff-beginning-of-hunk)
- (unless (looking-at diff-hunk-header-re) (error "Help! Mom!"))
- (goto-char (1+ (match-end 0)))
- ;; Extract the SRC and DEST strings.
- (let ((text (buffer-substring (point) (progn (diff-end-of-hunk) (point))))
- src dest)
- (with-temp-buffer
- (insert text)
- (diff-filter-lines ?+)
- (setq src (buffer-string))
- (erase-buffer)
- (insert text)
- (diff-filter-lines ?-)
- (setq dest (buffer-string)))
- ;; Exchange the two strings if we're reversing the patch.
- (if reverse (let ((tmp src)) (setq src dest) (setq dest tmp)))
- ;; Look for SRC in the file.
- (pop-to-buffer (find-file-noselect (car loc)))
- (goto-line (cadr loc))
- (let* ((pos (point))
- (forw (and (search-forward src nil t)
- (match-beginning 0)))
- (back (and (goto-char (+ pos (length src)))
- (search-backward src nil t)
- (match-beginning 0))))
- ;; Choose the closest match.
- (setq pos (if (and forw back)
- (if (> (- forw pos) (- pos back)) back forw)
- (or back forw)))
- (unless pos (error "Can't find the text to patch"))
- ;; Do it!
- (goto-char pos)
- (delete-char (length src))
- (insert dest))))))
-
+ (destructuring-bind (buf line-offset pos old new &optional switched)
+ (diff-find-source-location nil reverse)
+ (cond
+ ((null line-offset)
+ (error "Can't find the text to patch"))
+ ((and switched
+ ;; A reversed patch was detected, perhaps apply it in reverse.
+ (not (save-window-excursion
+ (pop-to-buffer buf)
+ (goto-char (+ pos (cdr old)))
+ (y-or-n-p
+ (if reverse
+ "Hunk hasn't been applied yet; apply it now? "
+ "Hunk has already been applied; undo it? ")))))
+ (message "(Nothing done)"))
+ (t
+ ;; Apply the hunk
+ (with-current-buffer buf
+ (goto-char pos)
+ (delete-char (length (car old)))
+ (insert (car new)))
+ ;; Display BUF in a window
+ (set-window-point (display-buffer buf) (+ pos (cdr new)))
+ (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
+ (when diff-advance-after-apply-hunk
+ (diff-hunk-next))))))
+
+
+(defun diff-test-hunk (&optional reverse)
+ "See whether it's possible to apply the current hunk.
+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)
+ (set-window-point (display-buffer buf) (+ pos (cdr src)))
+ (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
+
+
+(defun diff-goto-source (&optional other-file)
+ "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")
+ ;; 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.
+ (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)
+ (pop-to-buffer buf)
+ (goto-char (+ pos (cdr src)))
+ (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
+
+
+(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
+ (beginning-of-line)
+ (or (when (memq (char-after) '(?< ?-))
+ ;; Cursor is pointing at removed text. This could be a removed
+ ;; function, in which case, going to the source buffer will
+ ;; not help since the function is now removed. Instead,
+ ;; try to figure out the function name just from the code-fragment.
+ (let ((old (if switched dst src)))
+ (with-temp-buffer
+ (insert (car old))
+ (goto-char (cdr old))
+ (funcall (with-current-buffer buf major-mode))
+ (add-log-current-defun))))
+ (with-current-buffer buf
+ (goto-char (+ pos (cdr src)))
+ (add-log-current-defun))))))
;; provide the package
(provide 'diff-mode)
HCoop / bpt / emacs.git / blobdiff