X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/027ac3f8db2a1837cb53d84130d07d0a7ea4574b..ae95a95a9c144a8ceefb9b2c9c09497705209ab1:/lisp/diff-mode.el diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 1775a0165b..2c86b1fbeb 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -1,10 +1,9 @@ ;;; 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 ;; 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. @@ -25,7 +24,7 @@ ;;; 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. @@ -41,42 +40,47 @@ ;; 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 @@ -86,15 +90,21 @@ when editing big diffs)." :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. @@ -108,6 +118,7 @@ when editing big diffs)." ("}" . 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 @@ -133,14 +144,17 @@ when editing big diffs)." ;; 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] @@ -148,78 +162,134 @@ when editing big diffs)." ;;["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 ;;;; @@ -232,9 +302,9 @@ when editing big 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))) @@ -342,6 +412,34 @@ If the prefix ARG is given, restrict the view to the current file instead." (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 ;;;; @@ -385,9 +483,9 @@ Non-nil OLD means that we want the old file." (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 @@ -426,51 +524,13 @@ Non-nil OLD means that we want the old file." (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 () @@ -807,33 +867,51 @@ See `after-change-functions' for the meaning of BEG, END and LEN." ;;;###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 @@ -842,13 +920,11 @@ This mode runs `diff-mode-hook'. 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))) ;;; @@ -865,57 +941,237 @@ Only works for unified diffs." 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)