X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2b612b1f55d36c88bee571f2b536153b7cb520a2..ae95a95a9c144a8ceefb9b2c9c09497705209ab1:/lisp/diff-mode.el diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index cc91877251..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, 2000 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.13 2000/09/12 11:24:28 miles 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,15 +40,12 @@ ;; 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. @@ -58,24 +54,33 @@ ;; (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 @@ -85,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. @@ -133,15 +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-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] @@ -149,89 +162,132 @@ 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,]+\\) @@\\(.*\\)$" ;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 ;;;; @@ -246,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))) @@ -356,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 ;;;; @@ -399,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 @@ -440,36 +524,6 @@ 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-mouse-goto-source (event) "Run `diff-goto-source' for the diff at a mouse click." @@ -478,6 +532,7 @@ Non-nil OLD means that we want the old file." (mouse-set-point event) (diff-goto-source))) + (defun diff-ediff-patch () "Call `ediff-patch-file' on the current buffer." (interactive) @@ -812,10 +867,9 @@ 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) @@ -830,26 +884,34 @@ This mode runs `diff-mode-hook'. ;; (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 @@ -858,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))) ;;; @@ -881,91 +941,92 @@ Only works for unified diffs." 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))) @@ -977,148 +1038,140 @@ If TEXT isn't found, nil is returned." (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)