;;; diff-mode.el --- A mode for viewing/editing context diffs
-;; Copyright (C) 1998, 1999, 2000 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.13 2000/09/12 11:24:28 miles 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.
;; 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.
;; (i.e. new or old) file.
;; - 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.
;; From compilation-minor-mode.
("\C-c\C-c" . diff-goto-source)
;; Misc operations.
- ("\C-cda" . diff-apply-hunk)
- ("\C-cdt" . diff-test-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,]+\\) @@\\(.*\\)$" ;unified
+ '(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified
(1 diff-hunk-header-face)
- (2 font-lock-comment-face))
- ("^--- \\(.+\\) ----$" ;context
- (1 diff-hunk-header-face))
- ("\\(\\*\\{15\\}\\)\\(.*\\)\n" ;context
+ (2 diff-function-face))
+ ("^--- .+ ----$" . diff-hunk-header-face) ;context
+ ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context
(1 diff-hunk-header-face)
- (2 font-lock-comment-face))
- ("^\\*\\*\\* \\(.+\\) \\*\\*\\*" ;context
- (1 diff-hunk-header-face))
- ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)" (2 diff-file-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: \\(.+\\)$" (1 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.
- '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)\t" 1) ; unidiffs
+ ;; 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
;;;;
("--- \\([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-mouse-goto-source (event)
"Run `diff-goto-source' for the diff at a mouse click."
(mouse-set-point event)
(diff-goto-source)))
+
(defun diff-ediff-patch ()
"Call `ediff-patch-file' on the current buffer."
(interactive)
;;;###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)
;; (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 line-offset)
- "Returns the literal source text from HUNK, if DESTP is nil, otherwise the
-destination text. If LINE-OFFSET is non-nil, it should be a line-offset in
-HUNK, and instead of a string, a cons cell is returned who's car is the
-appropriate text, and who's cdr is the corresponding line-offset."
+(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
- (erase-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 line-offset '("" . 0) "")
-
- (when line-offset
- (goto-char (point-min))
- (forward-line line-offset))
-
- ;; Get rid of anything except the desired text.
- (save-excursion
- ;; Delete unused text region
- (let ((keep (if destp dst-pos src-pos))
- (kill (or divider-pos (if destp src-pos dst-pos))))
- (when (and kill (> kill keep))
- (delete-region kill (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 line-offset
- (cons text (count-lines (point-min) (point)))
- text))))))
-
-(defun diff-find-text (text line)
- "Return the buffer position of the nearest occurance of TEXT to line LINE.
+ (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."
- (goto-line line)
(let* ((orig (point))
(forw (and (search-forward text nil t)
(match-beginning 0)))
(if (> (- forw orig) (- orig back)) back forw)
(or back forw))))
-(defun diff-apply-hunk (&optional reverse other-file dry-run popup noerror)
- "Apply the current hunk to the source file.
+(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-apply-hunk (&optional reverse)
+ "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-flag' is non-nil, then the old source file is
+`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.
-If OTHER-FILE is non-nil, patch the old file by default, and reverse the
- sense of `diff-jump-to-old-file-flag'.
-If DRY-RUN is non-nil, don't actually modify anything, just see whether
- it's possible to do so.
-If POPUP is non-nil, pop up the patched file in another window; if POPUP
- is `select' then select the new window too.
-If NOERROR is non-nil, then no error is signaled in the case where the hunk
- cannot be found in the source file (other errors may still be signaled).
-
-Return values are `t' if the hunk was sucessfully applied (or could be
-applied, in the case where DRY-RUN was non-nil), `reversed' if the hunk
-was applied backwards, or nil if the hunk couldn't be found and NOERROR
-was non-nil."
- (interactive (list current-prefix-arg nil nil t))
-
- (when other-file
- ;; OTHER-FILE inverts the sense of the hunk
- (setq reverse (not reverse)))
- (when diff-jump-to-old-file-flag
- ;; The global variable `diff-jump-to-old-file-flag' inverts the
- ;; sense of OTHER-FILE (in `diff-find-source-location')
- (setq reverse (not reverse)))
-
- (let* ((loc (diff-find-source-location other-file))
- (buf (find-file-noselect (car loc)))
- (patch-line (cadr loc))
- hunk-line-offset
- (hunk
- (let ((orig-point (point)))
- (save-excursion
- (diff-beginning-of-hunk)
- (setq hunk-line-offset (count-lines (point) orig-point))
- (unless (looking-at diff-hunk-header-re)
- (error "Malformed hunk"))
- (buffer-substring (point) (progn (diff-end-of-hunk) (point))))))
- (old (diff-hunk-text hunk reverse hunk-line-offset))
- (new (diff-hunk-text hunk (not reverse) hunk-line-offset))
- (pos
- (with-current-buffer buf (diff-find-text (car old) patch-line)))
- (reversed-pos
- (and (null pos)
- (with-current-buffer buf
- (diff-find-text (car new) patch-line)))))
-
- (when (and reversed-pos popup)
- ;; A reversed patch was detected, perhaps apply it in reverse
- ;; (this is only done in `interactive' mode, when POPUP is non-nil).
- (if (or dry-run
- (save-window-excursion
- (pop-to-buffer buf)
- (goto-char reversed-pos)
- (forward-line (cdr new))
- (if reverse
- (y-or-n-p
- "Hunk hasn't been applied yet, so can't reverse it; apply it now? ")
- (y-or-n-p "Hunk has already been applied; undo it? "))))
-
- ;; Set up things to reverse the diff
- (let ((swap new))
- (setq pos reversed-pos)
- (setq old new)
- (setq new swap))
-
- ;; The user has chosen not to apply the reversed hunk, but we
- ;; don't want to given an error message, so set things up so
- ;; nothing else gets done down below
- (message "(Nothing done)")
- (setq noerror t)))
-
- (if (null pos)
- ;; POS is nil, so we couldn't find the source text.
- (unless noerror
- (error "Can't find the text to patch"))
-
- (let ((reversed (if reversed-pos (not reverse) reverse)))
- (unless dry-run
- ;; Apply the hunk
- (with-current-buffer buf
- (goto-char pos)
- (delete-char (length (car old)))
- (insert (car new))))
+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)
+ (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))))))
+
- (when popup
- (with-current-buffer buf
- ;; Show a message describing what was done
- (let ((real-line (1+ (count-lines (point-min) pos)))
- (msg
- (if dry-run
- (if reversed "already applied" "not yet applied")
- (if reversed "undone" "applied"))))
- (cond ((= real-line patch-line)
- (message "Hunk %s" msg))
- ((= real-line (1+ patch-line))
- (message "Hunk %s at offset 1 line" msg))
- (t
- (message "Hunk %s at offset %d lines"
- msg
- (- real-line patch-line)))))
-
- ;; fixup POS to reflect the hunk line offset
- (goto-char pos)
- (forward-line (cdr new))
- (setq pos (point)))
-
- ;; Display BUF in a window, and maybe select it
- (let ((win (display-buffer buf)))
- (set-window-point win pos)
- (when (eq popup 'select)
- (select-window win))))
-
- ;; Return an appropriate indicator of success
- (if reversed 'reversed t)))))
-
-
(defun diff-test-hunk (&optional reverse)
"See whether it's possible to apply the current hunk.
-With a prefix argument, REVERSE the hunk."
+With a prefix argument, try to REVERSE the hunk."
(interactive "P")
- (diff-apply-hunk reverse nil t t))
+ (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-flag' (or its opposite if the OTHER-FILE prefix arg
-is give) determines whether to jump to the old or the new file.
+`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-flag' is also set, for the next invocations."
+ then `diff-jump-to-old-file' is also set, for the next invocations."
(interactive "P")
- (or (diff-apply-hunk nil other-file t 'select t)
- ;; couldn't actually find the hunk, just obey the hunk line number
- (let ((loc (diff-find-source-location other-file)))
- (find-file-other-window (car loc))
- (goto-line (cadr loc))
- (error "Hunk text not found"))))
-
+ ;; 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