comparison lisp/diff-mode.el @ 31538:46aca282e6b0

(diff-apply-hunk): Function basically rewritten. Now understands non-unified diffs. Some functionality moved into `diff-hunk-text' and `diff-find-text'. Add OTHER-FILE, DRY-RUN, POPUP, and NOERROR arguments. If DRY-RUN is true, don't actually modify anything. Only reposition point in the patched file if the patch succeeds. Only pop up another window if POPUP is true. Emit a message describing what happened if successful, and at what line-offset. Automatically detect reversed hunks and do something appropriate. (diff-hunk-text, diff-find-text): New functions. (diff-filter-lines): Function removed. (diff-test-hunk): New function. (diff-goto-source): Rewritten in terms of diff-apply-hunk.

31537:6f330e666e31

;; Copyright (C) 1998, 1999, 2000  Free Software Foundation, Inc.

;; Author: Stefan Monnier <[e-mail]>
;; Keywords: patch diff
;; Revision: $Id: diff-mode.el,v 1.9 2000/08/16 19:56:10 monnier Exp $

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; 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.

      ;; 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")
  (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))))))

(defun diff-mouse-goto-source (event)
  "Run `diff-goto-source' for the diff at a mouse click."
  (interactive "e")
  (save-excursion

  (while
      (and (re-search-forward "^@@ [-0-9]+,\\([0-9]+\\) [+0-9]+,\\([0-9]+\\) @@"
			      nil t)
	   (equal (match-string 1) (match-string 2)))))


(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."
  (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))))))
      

;; provide the package
(provide 'diff-mode)

;;; Old Change Log from when diff-mode wasn't part of Emacs:

31538:46aca282e6b0

;; Copyright (C) 1998, 1999, 2000  Free Software Foundation, Inc.

;; Author: Stefan Monnier <[e-mail]>
;; Keywords: patch diff
;; Revision: $Id: diff-mode.el,v 1.11 2000/09/07 20:14:27 fx Exp $

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; 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.

      ;; 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."
  (interactive "e")
  (save-excursion

  (while
      (and (re-search-forward "^@@ [-0-9]+,\\([0-9]+\\) [+0-9]+,\\([0-9]+\\) @@"
			      nil t)
	   (equal (match-string 1) (match-string 2)))))

(defun diff-hunk-text (hunk dest)
  "Returns the literal source text from HUNK, if DEST is nil, otherwise
the destination text."
  (with-current-buffer "foo"
    (erase-buffer)
    (insert hunk)
    (goto-char (point-min))
    (let ((src nil)
	  (dst nil)
	  (divider nil)
	  (num-pfx-chars 2))
      (cond ((looking-at "^@@")
	     ;; unified diff
	     (setq num-pfx-chars 1)
	     (forward-line 1)
	     (setq src (point) dst (point)))
	    ((looking-at "^\\*\\*")
	     ;; context diff
	     (forward-line 2)
	     (setq src (point))
	     (re-search-forward "^--- " nil t)
	     (forward-line 0)
	     (setq divider (point))
	     (forward-line 1)
	     (setq dst (point)))
	    ((looking-at "^[0-9]+a[0-9,]+$")
	     ;; normal diff, insert
	     (forward-line 1)
	     (setq dst (point)))
	    ((looking-at "^[0-9,]+d[0-9]+$")
	     ;; normal diff, delete
	     (forward-line 1)
	     (setq src (point)))
	    ((looking-at "^[0-9,]+c[0-9,]+$")
	     ;; normal diff, change
	     (forward-line 1)
	     (setq src (point))
	     (re-search-forward "^---$" nil t)
	     (forward-line 0)
	     (setq divider (point))
	     (forward-line 1)
	     (setq dst (point)))
	    (t
	     (error "Unknown diff hunk type")))

      (if (if dest (null dst) (null src))
	  ;; Implied empty text
	  ""

	;; Explicit text

	;; Delete unused text region
	(let ((keep (if dest dst src))
	      (kill (or divider (if dest src dst))))
	  (when (and kill (> kill keep))
	    (delete-region kill (point-max)))
	  (delete-region (point-min) keep))

	;; Remove line-prefix characters, and unneeded lines (for
	;; unified diffs).
	(let ((kill-char (if dest ?- ?+)))
  (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))))

	(buffer-substring-no-properties (point-min) (point-max))))))

(defun diff-find-text (text line)
  "Return the buffer position of the nearest occurance of TEXT to line LINE.
If TEXT isn't found, nil is returned."
  (goto-line line)
  (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))))

(defun diff-apply-hunk (&optional reverse other-file dry-run popup noerror)
  "Apply the current hunk to the source file.
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
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
	  (save-excursion
	    (diff-beginning-of-hunk)
	    (unless (looking-at diff-hunk-header-re)
	      (error "Malformed hunk"))
	    (buffer-substring (point) (progn (diff-end-of-hunk) (point)))))
	 (src (diff-hunk-text hunk reverse))
	 (dst (diff-hunk-text hunk (not reverse)))
	 (pos
	  (with-current-buffer buf (diff-find-text src patch-line)))
	 (reversed-pos
	  (and (null pos)
	       (with-current-buffer buf (diff-find-text dst 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)
		(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 dst))
	    (setq pos reversed-pos)
	    (setq src dst)
	    (setq dst 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 src))
	    (insert dst)))

	(when popup
	  ;; Show a message describing what was done
	  (let ((real-line
		 (1+ (with-current-buffer buf (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)))))

	  ;; Display BUF in a window, and maybe select it
	  (cond ((eq popup 'select)
		 (pop-to-buffer buf)
		 (goto-char pos))
		(t
		 (set-window-point (display-buffer buf) pos))))

	;; 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."
  (interactive "P")
  (diff-apply-hunk reverse nil t 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.
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")
  (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"))))


;; provide the package
(provide 'diff-mode)

;;; Old Change Log from when diff-mode wasn't part of Emacs: