/[emacs]/emacs/lisp/diff-mode.el
ViewVC logotype

Diff of /emacs/lisp/diff-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.42 by monnier, Sat Sep 22 19:11:09 2001 UTC revision 1.43 by monnier, Mon Nov 26 00:20:41 2001 UTC
# Line 47  Line 47 
47  ;; - re-enable (conditionally) the `compile' support after improving it to use  ;; - re-enable (conditionally) the `compile' support after improving it to use
48  ;;   the same code as diff-goto-source.  ;;   the same code as diff-goto-source.
49  ;; - Support for # comments in context->unified.  ;; - Support for # comments in context->unified.
 ;; - Do a fuzzy search in diff-goto-source.  
50  ;; - Allow diff.el to use diff-mode.  ;; - Allow diff.el to use diff-mode.
51  ;;   This mostly means ability to jump from half-hunk to half-hunk  ;;   This mostly means ability to jump from half-hunk to half-hunk
52  ;;   in context (and normal) diffs and to jump to the corresponding  ;;   in context (and normal) diffs and to jump to the corresponding
# Line 77  Line 76 
76  (defcustom diff-jump-to-old-file nil  (defcustom diff-jump-to-old-file nil
77    "*Non-nil means `diff-goto-source' jumps to the old file.    "*Non-nil means `diff-goto-source' jumps to the old file.
78  Else, it jumps to the new file."  Else, it jumps to the new file."
   :group 'diff-mode  
79    :type '(boolean))    :type '(boolean))
80    
81  (defcustom diff-update-on-the-fly t  (defcustom diff-update-on-the-fly t
# Line 87  need to be kept consistent with the actu Line 85  need to be kept consistent with the actu
85  either be done on the fly (but this sometimes interacts poorly with the  either be done on the fly (but this sometimes interacts poorly with the
86  undo mechanism) or whenever the file is written (can be slow  undo mechanism) or whenever the file is written (can be slow
87  when editing big diffs)."  when editing big diffs)."
   :group 'diff-mode  
88    :type '(boolean))    :type '(boolean))
89    
90  (defcustom diff-advance-after-apply-hunk t  (defcustom diff-advance-after-apply-hunk t
91    "*Non-nil means `diff-apply-hunk' will move to the next hunk after applying."    "*Non-nil means `diff-apply-hunk' will move to the next hunk after applying."
   :group 'diff-mode  
92    :type 'boolean)    :type 'boolean)
93    
94    
# Line 164  when editing big diffs)." Line 160  when editing big diffs)."
160    
161  (defcustom diff-minor-mode-prefix "\C-c="  (defcustom diff-minor-mode-prefix "\C-c="
162    "Prefix key for `diff-minor-mode' commands."    "Prefix key for `diff-minor-mode' commands."
   :group 'diff-mode  
163    :type '(choice (string "\e") (string "C-c=") string))    :type '(choice (string "\e") (string "C-c=") string))
164    
165  (easy-mmode-defmap diff-minor-mode-map  (easy-mmode-defmap diff-minor-mode-map
# Line 186  when editing big diffs)." Line 181  when editing big diffs)."
181      (((class color) (background dark))      (((class color) (background dark))
182       (:background "grey45"))       (:background "grey45"))
183      (t (:bold t)))      (t (:bold t)))
184    "`diff-mode' face inherited by hunk and index header faces."    "`diff-mode' face inherited by hunk and index header faces.")
   :group 'diff-mode)  
185  (defvar diff-header-face 'diff-header-face)  (defvar diff-header-face 'diff-header-face)
186    
187  (defface diff-file-header-face  (defface diff-file-header-face
# Line 200  when editing big diffs)." Line 194  when editing big diffs)."
194      (((class color) (background dark))      (((class color) (background dark))
195       (:background "grey60" :bold t))       (:background "grey60" :bold t))
196      (t (:bold t)))                      ; :height 1.3      (t (:bold t)))                      ; :height 1.3
197    "`diff-mode' face used to highlight file header lines."    "`diff-mode' face used to highlight file header lines.")
   :group 'diff-mode)  
198  (defvar diff-file-header-face 'diff-file-header-face)  (defvar diff-file-header-face 'diff-file-header-face)
199    
200  (defface diff-index-face  (defface diff-index-face
201    '((t (:inherit diff-file-header-face)))    '((t (:inherit diff-file-header-face)))
202    "`diff-mode' face used to highlight index header lines."    "`diff-mode' face used to highlight index header lines.")
   :group 'diff-mode)  
203  (defvar diff-index-face 'diff-index-face)  (defvar diff-index-face 'diff-index-face)
204    
205  (defface diff-hunk-header-face  (defface diff-hunk-header-face
206    '((t (:inherit diff-header-face)))    '((t (:inherit diff-header-face)))
207    "`diff-mode' face used to highlight hunk header lines."    "`diff-mode' face used to highlight hunk header lines.")
   :group 'diff-mode)  
208  (defvar diff-hunk-header-face 'diff-hunk-header-face)  (defvar diff-hunk-header-face 'diff-hunk-header-face)
209    
210  (defface diff-removed-face  (defface diff-removed-face
211    '((t (:inherit diff-changed-face)))    '((t (:inherit diff-changed-face)))
212    "`diff-mode' face used to highlight removed lines."    "`diff-mode' face used to highlight removed lines.")
   :group 'diff-mode)  
213  (defvar diff-removed-face 'diff-removed-face)  (defvar diff-removed-face 'diff-removed-face)
214    
215  (defface diff-added-face  (defface diff-added-face
216    '((t (:inherit diff-changed-face)))    '((t (:inherit diff-changed-face)))
217    "`diff-mode' face used to highlight added lines."    "`diff-mode' face used to highlight added lines.")
   :group 'diff-mode)  
218  (defvar diff-added-face 'diff-added-face)  (defvar diff-added-face 'diff-added-face)
219    
220  (defface diff-changed-face  (defface diff-changed-face
# Line 234  when editing big diffs)." Line 223  when editing big diffs)."
223      (((type tty pc) (class color) (background dark))      (((type tty pc) (class color) (background dark))
224       (:foreground "yellow" :bold t :italic t))       (:foreground "yellow" :bold t :italic t))
225      (t ()))      (t ()))
226    "`diff-mode' face used to highlight changed lines."    "`diff-mode' face used to highlight changed lines.")
   :group 'diff-mode)  
227  (defvar diff-changed-face 'diff-changed-face)  (defvar diff-changed-face 'diff-changed-face)
228    
229  (defface diff-function-face  (defface diff-function-face
230    '((t (:inherit diff-context-face)))    '((t (:inherit diff-context-face)))
231    "`diff-mode' face used to highlight function names produced by \"diff -p\"."    "`diff-mode' face used to highlight function names produced by \"diff -p\".")
   :group 'diff-mode)  
232  (defvar diff-function-face 'diff-function-face)  (defvar diff-function-face 'diff-function-face)
233    
234  (defface diff-context-face  (defface diff-context-face
# Line 250  when editing big diffs)." Line 237  when editing big diffs)."
237      (((class color) (background dark))      (((class color) (background dark))
238       (:foreground "grey70"))       (:foreground "grey70"))
239      (t ))      (t ))
240    "`diff-mode' face used to highlight context and other side-information."    "`diff-mode' face used to highlight context and other side-information.")
   :group 'diff-mode)  
241  (defvar diff-context-face 'diff-context-face)  (defvar diff-context-face 'diff-context-face)
242    
243  (defface diff-nonexistent-face  (defface diff-nonexistent-face
244    '((t (:inherit diff-file-header-face)))    '((t (:inherit diff-file-header-face)))
245    "`diff-mode' face used to highlight nonexistent files in recursive diffs."    "`diff-mode' face used to highlight nonexistent files in recursive diffs.")
   :group 'diff-mode)  
246  (defvar diff-nonexistent-face 'diff-nonexistent-face)  (defvar diff-nonexistent-face 'diff-nonexistent-face)
247    
248  (defvar diff-font-lock-keywords  (defvar diff-font-lock-keywords
# Line 313  when editing big diffs)." Line 298  when editing big diffs)."
298  (defun diff-end-of-hunk (&optional style)  (defun diff-end-of-hunk (&optional style)
299    (if (looking-at diff-hunk-header-re) (goto-char (match-end 0)))    (if (looking-at diff-hunk-header-re) (goto-char (match-end 0)))
300    (let ((end (and (re-search-forward (case style    (let ((end (and (re-search-forward (case style
301                                         (unified "^[^-+# \\]")                                         ;; A `unified' header is ambiguous.
302                                           (unified (concat "^[^-+# \\]\\|"
303                                                            diff-file-header-re))
304                                         (context "^[^-+#! \\]")                                         (context "^[^-+#! \\]")
305                                         (normal "^[^<>#\\]")                                         (normal "^[^<>#\\]")
306                                         (t "^[^-+#!<> \\]"))                                         (t "^[^-+#!<> \\]"))
# Line 365  If the prefix ARG is given, restrict the Line 352  If the prefix ARG is given, restrict the
352    "Kill current hunk."    "Kill current hunk."
353    (interactive)    (interactive)
354    (diff-beginning-of-hunk)    (diff-beginning-of-hunk)
355    (let ((start (point))    (let* ((start (point))
356          (firsthunk (save-excursion           (nexthunk (ignore-errors (diff-hunk-next) (point)))
357                       (ignore-errors           (firsthunk (ignore-errors
358                         (diff-beginning-of-file) (diff-hunk-next) (point))))                        (goto-char start)
359          (nexthunk  (save-excursion                        (diff-beginning-of-file) (diff-hunk-next) (point)))
360                       (ignore-errors           (nextfile (ignore-errors (diff-file-next) (point))))
361                         (diff-hunk-next) (point))))      (goto-char start)
         (nextfile (save-excursion  
                     (ignore-errors  
                       (diff-file-next) (point)))))  
362      (if (and firsthunk (= firsthunk start)      (if (and firsthunk (= firsthunk start)
363               (or (null nexthunk)               (or (null nexthunk)
364                   (and nextfile (> nexthunk nextfile))))                   (and nextfile (> nexthunk nextfile))))
365          ;; we're the only hunk for this file, so kill the file          ;; It's the only hunk for this file, so kill the file.
366          (diff-file-kill)          (diff-file-kill)
367        (diff-end-of-hunk)        (diff-end-of-hunk)
368        (kill-region start (point)))))        (kill-region start (point)))))
# Line 849  See `after-change-functions' for the mea Line 833  See `after-change-functions' for the mea
833      (ignore-errors      (ignore-errors
834        (save-excursion        (save-excursion
835          (goto-char (car diff-unhandled-changes))          (goto-char (car diff-unhandled-changes))
836          (unless (ignore-errors          ;; We used to fixup modifs on all the changes, but it turns out
837                    (diff-beginning-of-hunk)          ;; that it's safer not to do it on big changes, for example
838                    (save-excursion          ;; when yanking a big diff, since we might then screw up perfectly
839                      (diff-end-of-hunk)          ;; correct values.  -stef
840                      (> (point) (car diff-unhandled-changes))))          ;; (unless (ignore-errors
841            (goto-char (car diff-unhandled-changes))          ;;        (diff-beginning-of-hunk)
842            (re-search-forward diff-hunk-header-re (cdr diff-unhandled-changes))          ;;        (save-excursion
843            (diff-beginning-of-hunk))          ;;          (diff-end-of-hunk)
844          (diff-fixup-modifs (point) (cdr diff-unhandled-changes))))          ;;          (> (point) (car diff-unhandled-changes))))
845            ;;   (goto-char (car diff-unhandled-changes))
846            ;; (re-search-forward diff-hunk-header-re (cdr diff-unhandled-changes))
847            ;;   (diff-beginning-of-hunk))
848            ;; (diff-fixup-modifs (point) (cdr diff-unhandled-changes))
849            (diff-beginning-of-hunk)
850            (when (save-excursion
851                    (diff-end-of-hunk)
852                    (> (point) (cdr diff-unhandled-changes)))
853              (diff-fixup-modifs (point) (cdr diff-unhandled-changes)))))
854      (setq diff-unhandled-changes nil)))      (setq diff-unhandled-changes nil)))
855    
856  ;;;;  ;;;;
# Line 941  Only works for unified diffs." Line 934  Only works for unified diffs."
934                                nil t)                                nil t)
935             (equal (match-string 1) (match-string 2)))))             (equal (match-string 1) (match-string 2)))))
936    
937  (defun diff-hunk-text (hunk destp &optional char-offset)  (defun diff-hunk-text (hunk destp char-offset)
938    "Return the literal source text from HUNK.    "Return the literal source text from HUNK as (TEXT . OFFSET).
939  if DESTP is nil return the source, otherwise the destination text.  if DESTP is nil TEXT is the source, otherwise the destination text.
940  If CHAR-OFFSET is non-nil, it should be a char-offset in  CHAR-OFFSET is a char-offset in HUNK, and OFFSET is the corresponding
941  HUNK, and instead of a string, a cons cell is returned whose car is the  char-offset in TEXT."
 appropriate text, and whose cdr is the corresponding char-offset in that text."  
942    (with-temp-buffer    (with-temp-buffer
943      (insert hunk)      (insert hunk)
944      (goto-char (point-min))      (goto-char (point-min))
# Line 1025  appropriate text, and whose cdr is the c Line 1017  appropriate text, and whose cdr is the c
1017    
1018    
1019  (defun diff-find-text (text)  (defun diff-find-text (text)
1020    "Return the buffer position of the nearest occurrence of TEXT.    "Return the buffer position (BEG . END) of the nearest occurrence of TEXT.
1021  If TEXT isn't found, nil is returned."  If TEXT isn't found, nil is returned."
1022    (let* ((orig (point))    (let* ((orig (point))
1023           (forw (and (search-forward text nil t)           (forw (and (search-forward text nil t)
1024                            (match-beginning 0)))                      (cons (match-beginning 0) (match-end 0))))
1025           (back (and (goto-char (+ orig (length text)))           (back (and (goto-char (+ orig (length text)))
1026                      (search-backward text nil t)                      (search-backward text nil t)
1027                            (match-beginning 0))))                      (cons (match-beginning 0) (match-end 0)))))
1028            ;; Choose the closest match.      ;; Choose the closest match.
1029        (if (and forw back)
1030            (if (> (- (car forw) orig) (- orig (car back))) back forw)
1031          (or back forw))))
1032    
1033    (defun diff-find-approx-text (text)
1034      "Return the buffer position (BEG . END) of the nearest occurrence of TEXT.
1035    Whitespace differences are ignored."
1036      (let* ((orig (point))
1037             (re (concat "^[ \t\n ]*"
1038                         (mapconcat 'regexp-quote (split-string text) "[ \t\n ]+")
1039                         "[ \t\n ]*\n"))
1040             (forw (and (re-search-forward re nil t)
1041                        (cons (match-beginning 0) (match-end 0))))
1042             (back (and (goto-char (+ orig (length text)))
1043                        (re-search-backward re nil t)
1044                        (cons (match-beginning 0) (match-end 0)))))
1045        ;; Choose the closest match.
1046      (if (and forw back)      (if (and forw back)
1047          (if (> (- forw orig) (- orig back)) back forw)          (if (> (- (car forw) orig) (- orig (car back))) back forw)
1048        (or back forw))))        (or back forw))))
1049    
1050  (defsubst diff-xor (a b) (if a (not b) b))  (defsubst diff-xor (a b) (if a (not b) b))
1051    
1052  (defun diff-find-source-location (&optional other-file reverse)  (defun diff-find-source-location (&optional other-file reverse)
1053    "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED)."    "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED).
1054    BUF is the buffer corresponding to the source file.
1055    LINE-OFFSET is the offset between the expected and actual positions
1056      of the text of the hunk or nil if the text was not found.
1057    POS is a pair (BEG . END) indicating the position of the text in the buffer.
1058    SRC and DST are the two variants of text as returned by `diff-hunk-text'.
1059      SRC is the variant that was found in the buffer.
1060    SWITCHED is non-nil if the patch is already applied."
1061    (save-excursion    (save-excursion
1062      (let* ((other (diff-xor other-file diff-jump-to-old-file))      (let* ((other (diff-xor other-file diff-jump-to-old-file))
1063             (char-offset (- (point) (progn (diff-beginning-of-hunk) (point))))             (char-offset (- (point) (progn (diff-beginning-of-hunk) (point))))
# Line 1065  If TEXT isn't found, nil is returned." Line 1081  If TEXT isn't found, nil is returned."
1081        (with-current-buffer buf        (with-current-buffer buf
1082          (goto-line (string-to-number line))          (goto-line (string-to-number line))
1083          (let* ((orig-pos (point))          (let* ((orig-pos (point))
1084                 (pos (diff-find-text (car old)))                 (switched nil)
1085                 (switched nil))                 (pos (or (diff-find-text (car old))
1086            (when (null pos)                          (progn (setq switched t) (diff-find-text (car new)))
1087              (setq pos (diff-find-text (car new)) switched t))                          (progn (setq switched nil)
1088                                   (diff-find-approx-text (car old)))
1089                            (progn (setq switched t)
1090                                   (diff-find-approx-text (car new)))
1091                            (progn (setq switched nil) nil))))
1092            (nconc            (nconc
1093             (list buf)             (list buf)
1094             (if pos (list (count-lines orig-pos pos) pos) (list nil orig-pos))             (if pos
1095                   (list (count-lines orig-pos (car pos)) pos)
1096                 (list nil (cons orig-pos (+ orig-pos (length (car old))))))
1097             (if switched (list new old t) (list old new))))))))             (if switched (list new old t) (list old new))))))))
1098    
1099    
# Line 1104  With a prefix argument, REVERSE the hunk Line 1126  With a prefix argument, REVERSE the hunk
1126             ;; A reversed patch was detected, perhaps apply it in reverse.             ;; A reversed patch was detected, perhaps apply it in reverse.
1127             (not (save-window-excursion             (not (save-window-excursion
1128                    (pop-to-buffer buf)                    (pop-to-buffer buf)
1129                    (goto-char (+ pos (cdr old)))                    (goto-char (+ (car pos) (cdr old)))
1130                    (y-or-n-p                    (y-or-n-p
1131                     (if reverse                     (if reverse
1132                         "Hunk hasn't been applied yet; apply it now? "                         "Hunk hasn't been applied yet; apply it now? "
# Line 1113  With a prefix argument, REVERSE the hunk Line 1135  With a prefix argument, REVERSE the hunk
1135       (t       (t
1136        ;; Apply the hunk        ;; Apply the hunk
1137        (with-current-buffer buf        (with-current-buffer buf
1138          (goto-char pos)          (goto-char (car pos))
1139          (delete-char (length (car old)))          (delete-region (car pos) (cdr pos))
1140          (insert (car new)))          (insert (car new)))
1141        ;; Display BUF in a window        ;; Display BUF in a window
1142        (set-window-point (display-buffer buf) (+ pos (cdr new)))        (set-window-point (display-buffer buf) (+ (car pos) (cdr new)))
1143        (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)        (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
1144        (when diff-advance-after-apply-hunk        (when diff-advance-after-apply-hunk
1145          (diff-hunk-next))))))          (diff-hunk-next))))))
# Line 1129  With a prefix argument, try to REVERSE t Line 1151  With a prefix argument, try to REVERSE t
1151    (interactive "P")    (interactive "P")
1152    (destructuring-bind (buf line-offset pos src dst &optional switched)    (destructuring-bind (buf line-offset pos src dst &optional switched)
1153        (diff-find-source-location nil reverse)        (diff-find-source-location nil reverse)
1154      (set-window-point (display-buffer buf) (+ pos (cdr src)))      (set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
1155      (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))      (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
1156    
1157    
# Line 1147  If the prefix arg is bigger than 8 (for Line 1169  If the prefix arg is bigger than 8 (for
1169      (destructuring-bind (buf line-offset pos src dst &optional switched)      (destructuring-bind (buf line-offset pos src dst &optional switched)
1170          (diff-find-source-location other-file rev)          (diff-find-source-location other-file rev)
1171        (pop-to-buffer buf)        (pop-to-buffer buf)
1172        (goto-char (+ pos (cdr src)))        (goto-char (+ (car pos) (cdr src)))
1173        (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))        (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
1174    
1175    
# Line 1170  For use in `add-log-current-defun-functi Line 1192  For use in `add-log-current-defun-functi
1192                  (funcall (with-current-buffer buf major-mode))                  (funcall (with-current-buffer buf major-mode))
1193                  (add-log-current-defun))))                  (add-log-current-defun))))
1194            (with-current-buffer buf            (with-current-buffer buf
1195              (goto-char (+ pos (cdr src)))              (goto-char (+ (car pos) (cdr src)))
1196              (add-log-current-defun))))))              (add-log-current-defun))))))
1197    
1198  ;; provide the package  ;; provide the package

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26