lisp/ediff-diff.el

   1 ;;; ediff-diff.el --- diff-related utilities
   2
   3 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
   4 ;;   2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
   5
   6 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29
  30 ;; compiler pacifier
  31 (defvar ediff-default-variant)
  32 (defvar null-device)
  33 (defvar longlines-mode)
  34
  35 (eval-when-compile
  36   (let ((load-path (cons (expand-file-name ".") load-path)))
  37     (or (featurep 'ediff-init)
  38         (load "ediff-init.el" nil nil 'nosuffix))
  39     (or (featurep 'ediff-util)
  40         (load "ediff-util.el" nil nil 'nosuffix))
  41     ))
  42 ;; end pacifier
  43
  44 (require 'ediff-init)
  45
  46 (defgroup ediff-diff nil
  47   "Diff related utilities."
  48   :prefix "ediff-"
  49   :group 'ediff)
  50
  51 (defcustom ediff-diff-program "diff"
  52   "*Program to use for generating the differential of the two files."
  53   :type 'string
  54   :group 'ediff-diff)
  55 (defcustom ediff-diff3-program "diff3"
  56   "*Program to be used for three-way comparison.
  57 Must produce output compatible with Unix's diff3 program."
  58   :type 'string
  59   :group 'ediff-diff)
  60
  61
  62 ;; The following functions must precede all defcustom-defined variables.
  63
  64 (fset 'ediff-set-actual-diff-options '(lambda () nil))
  65
  66 (defcustom ediff-shell
  67   (cond ((eq system-type 'emx) "cmd") ; OS/2
  68         ((memq system-type '(ms-dos windows-nt windows-95))
  69          shell-file-name) ; no standard name on MS-DOS
  70         ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS
  71         (t  "sh")) ; UNIX
  72   "*The shell used to run diff and patch.
  73 If user's .profile or .cshrc files are set up correctly, any shell
  74 will do.  However, some people set $prompt or other things
  75 incorrectly, which leads to undesirable output messages.  These may
  76 cause Ediff to fail.  In such a case, set `ediff-shell' to a shell that
  77 you are not using or, better, fix your shell's startup file."
  78   :type 'string
  79   :group 'ediff-diff)
  80
  81 (defcustom ediff-cmp-program "cmp"
  82   "*Utility to use to determine if two files are identical.
  83 It must return code 0, if its arguments are identical files."
  84   :type 'string
  85   :group 'ediff-diff)
  86
  87 (defcustom ediff-cmp-options nil
  88   "*Options to pass to `ediff-cmp-program'.
  89 If GNU diff is used as `ediff-cmp-program', then the most useful options
  90 are `-I REGEXP', to ignore changes whose lines match the REGEXP."
  91   :type '(repeat string)
  92   :group 'ediff-diff)
  93
  94 (defun ediff-set-diff-options (symbol value)
  95   (set symbol value)
  96   (ediff-set-actual-diff-options))
  97
  98 (defcustom ediff-diff-options
  99   (if (memq system-type '(ms-dos windows-nt windows-95)) "--binary" "")
 100   "*Options to pass to `ediff-diff-program'.
 101 If Unix diff is used as `ediff-diff-program',
 102 then a useful option is `-w', to ignore space.
 103 Options `-c', `-u', and `-i' are not allowed. Case sensitivity can be
 104 toggled interactively using \\[ediff-toggle-ignore-case].
 105
 106 Do not remove the default options. If you need to change this variable, add new
 107 options after the default ones.
 108
 109 This variable is not for customizing the look of the differences produced by
 110 the command \\[ediff-show-diff-output]. Use the variable
 111 `ediff-custom-diff-options' for that."
 112   :set 'ediff-set-diff-options
 113   :type 'string
 114   :group 'ediff-diff)
 115
 116 (ediff-defvar-local ediff-ignore-case nil
 117   "*If t, skip over difference regions that differ only in letter case.
 118 This variable can be set either in .emacs or toggled interactively.
 119 Use `setq-default' if setting it in .emacs")
 120
 121 (defcustom ediff-ignore-case-option "-i"
 122   "*Option that causes the diff program to ignore case of letters."
 123   :type 'string
 124   :group 'ediff-diff)
 125
 126 (defcustom ediff-ignore-case-option3 ""
 127   "*Option that causes the diff3 program to ignore case of letters.
 128 GNU diff3 doesn't have such an option."
 129   :type 'string
 130   :group 'ediff-diff)
 131
 132 ;; the actual options used in comparison
 133 (ediff-defvar-local ediff-actual-diff-options ediff-diff-options "")
 134
 135 (defcustom ediff-custom-diff-program ediff-diff-program
 136   "*Program to use for generating custom diff output for saving it in a file.
 137 This output is not used by Ediff internally."
 138   :type 'string
 139   :group 'ediff-diff)
 140 (defcustom ediff-custom-diff-options "-c"
 141   "*Options to pass to `ediff-custom-diff-program'."
 142   :type 'string
 143   :group 'ediff-diff)
 144
 145 ;;; Support for diff3
 146
 147 (defvar ediff-match-diff3-line "^====\\(.?\\)\C-m?$"
 148   "Pattern to match lines produced by diff3 that describe differences.")
 149 (defcustom ediff-diff3-options ""
 150   "*Options to pass to `ediff-diff3-program'."
 151   :set 'ediff-set-diff-options
 152   :type 'string
 153   :group 'ediff-diff)
 154
 155 ;; the actual options used in comparison
 156 (ediff-defvar-local ediff-actual-diff3-options ediff-diff3-options "")
 157
 158 (defcustom ediff-diff3-ok-lines-regexp
 159   "^\\([1-3]:\\|====\\|  \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)"
 160   "*Regexp that matches normal output lines from `ediff-diff3-program'.
 161 Lines that do not match are assumed to be error messages."
 162   :type 'regexp
 163   :group 'ediff-diff)
 164
 165 ;; keeps the status of the current diff in 3-way jobs.
 166 ;; the status can be =diff(A), =diff(B), or =diff(A+B)
 167 (ediff-defvar-local ediff-diff-status "" "")
 168
 169
 170 ;;; Fine differences
 171
 172 (ediff-defvar-local ediff-auto-refine (if (ediff-has-face-support-p) 'on 'nix)
 173   "If `on', Ediff auto-highlights fine diffs for the current diff region.
 174 If `off', auto-highlighting is not used. If `nix', no fine diffs are shown
 175 at all, unless the user force-refines the region by hitting `*'.
 176
 177 This variable can be set either in .emacs or toggled interactively.
 178 Use `setq-default' if setting it in .emacs")
 179
 180 (ediff-defvar-local ediff-ignore-similar-regions nil
 181   "*If t, skip over difference regions that differ only in the white space and line breaks.
 182 This variable can be set either in .emacs or toggled interactively.
 183 Use `setq-default' if setting it in .emacs")
 184
 185 (ediff-defvar-local ediff-auto-refine-limit 14000
 186   "*Auto-refine only the regions of this size \(in bytes\) or less.")
 187
 188 ;;; General
 189
 190 (defvar ediff-diff-ok-lines-regexp
 191   (concat
 192    "^\\("
 193    "[0-9,]+[acd][0-9,]+\C-m?$"
 194    "\\|[<>] "
 195    "\\|---"
 196    "\\|.*Warning *:"
 197    "\\|.*No +newline"
 198    "\\|.*missing +newline"
 199    "\\|^\C-m?$"
 200    "\\)")
 201   "Regexp that matches normal output lines from `ediff-diff-program'.
 202 This is mostly lifted from Emerge, except that Ediff also considers
 203 warnings and `Missing newline'-type messages to be normal output.
 204 Lines that do not match are assumed to be error messages.")
 205
 206 (defvar ediff-match-diff-line
 207   (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
 208     (concat "^" x "\\([acd]\\)" x "\C-m?$"))
 209   "Pattern to match lines produced by diff that describe differences.")
 210
 211 (ediff-defvar-local ediff-setup-diff-regions-function nil
 212   "value is a function symbol depending on the kind of job is to be done.
 213 For 2-way jobs and for ediff-merge, it should be `ediff-setup-diff-regions'.
 214 For jobs requiring diff3, it should be `ediff-setup-diff-regions3'.
 215
 216 The function should take three mandatory arguments, file-A, file-B, and
 217 file-C. It may ignore file C for diff2 jobs. It should also take
 218 one optional arguments, diff-number to refine.")
 219
 220
 221 ;;; Functions
 222
 223 ;; Generate the difference vector and overlays for the two files
 224 ;; With optional arg REG-TO-REFINE, refine this region.
 225 ;; File-C argument is not used here. It is there just because
 226 ;; ediff-setup-diff-regions is called via a funcall to
 227 ;; ediff-setup-diff-regions-function, which can also have the value
 228 ;; ediff-setup-diff-regions3, which takes 4 arguments.
 229 (defun ediff-setup-diff-regions (file-A file-B file-C)
 230   ;; looking for '-c', '-i', '-u', or 'c', 'i', 'u' among clustered non-long options
 231   (if (string-match "^-[ciu]\\| -[ciu]\\|\\(^\\| \\)-[^- ]+[ciu]"
 232                     ediff-diff-options)
 233       (error "Options `-c', `-u', and `-i' are not allowed in `ediff-diff-options'"))
 234
 235   ;; create, if it doesn't exist
 236   (or (ediff-buffer-live-p ediff-diff-buffer)
 237       (setq ediff-diff-buffer
 238             (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
 239   (ediff-make-diff2-buffer ediff-diff-buffer file-A file-B)
 240   (ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer)
 241   (ediff-convert-diffs-to-overlays
 242    (ediff-extract-diffs
 243     ediff-diff-buffer ediff-word-mode ediff-narrow-bounds)))
 244
 245 ;; Run the diff program on FILE1 and FILE2 and put the output in DIFF-BUFFER
 246 ;; Return the size of DIFF-BUFFER
 247 ;; The return code isn't used in the program at present.
 248 (defun ediff-make-diff2-buffer (diff-buffer file1 file2)
 249   (let ((file1-size (ediff-file-size file1))
 250         (file2-size (ediff-file-size file2)))
 251     (cond ((not (numberp file1-size))
 252            (message "Can't find file: %s"
 253                     (ediff-abbreviate-file-name file1))
 254            (sit-for 2)
 255            ;; 1 is an error exit code
 256            1)
 257           ((not (numberp file2-size))
 258            (message "Can't find file: %s"
 259                     (ediff-abbreviate-file-name file2))
 260            (sit-for 2)
 261            ;; 1 is an error exit code
 262            1)
 263           (t (message "Computing differences between %s and %s ..."
 264                       (file-name-nondirectory file1)
 265                       (file-name-nondirectory file2))
 266              ;; this erases the diff buffer automatically
 267              (ediff-exec-process ediff-diff-program
 268                                  diff-buffer
 269                                  'synchronize
 270                                  ediff-actual-diff-options file1 file2)
 271              (message "")
 272              (ediff-with-current-buffer diff-buffer
 273                (buffer-size))))))
 274
 275
 276
 277 ;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers
 278 ;; This function works for diff3 and diff2 jobs
 279 (defun ediff-setup-fine-diff-regions (file-A file-B file-C reg-num)
 280   (or (ediff-buffer-live-p ediff-fine-diff-buffer)
 281       (setq ediff-fine-diff-buffer
 282             (get-buffer-create
 283              (ediff-unique-buffer-name "*ediff-fine-diff" "*"))))
 284
 285   (let (diff3-job diff-program diff-options ok-regexp diff-list)
 286     (setq diff3-job ediff-3way-job
 287           diff-program (if diff3-job ediff-diff3-program ediff-diff-program)
 288           diff-options (if diff3-job
 289                            ediff-actual-diff3-options
 290                          ediff-actual-diff-options)
 291           ok-regexp (if diff3-job
 292                         ediff-diff3-ok-lines-regexp
 293                         ediff-diff-ok-lines-regexp))
 294
 295     (ediff-message-if-verbose "Refining difference region %d ..." (1+ reg-num))
 296     (ediff-exec-process diff-program ediff-fine-diff-buffer 'synchronize
 297                         diff-options
 298                         ;; The shuffle below is because we can compare 3-way
 299                         ;; or in several 2-way fashions, like fA fC, fA fB,
 300                         ;; or fB fC.
 301                         (if file-A file-A file-B)
 302                         (if file-B file-B file-A)
 303                         (if diff3-job
 304                             (if file-C file-C file-B))
 305                         ) ; exec process
 306
 307     (ediff-prepare-error-list ok-regexp ediff-fine-diff-buffer)
 308     (ediff-message-if-verbose
 309      "")
 310     ;; "Refining difference region %d ... done" (1+ reg-num))
 311
 312     (setq diff-list
 313           (if diff3-job
 314               (ediff-extract-diffs3
 315                ediff-fine-diff-buffer '3way-comparison 'word-mode)
 316             (ediff-extract-diffs ediff-fine-diff-buffer 'word-mode)))
 317     ;; fixup diff-list
 318     (if diff3-job
 319         (cond ((not file-A)
 320                (mapc (lambda (elt)
 321                        (aset elt 0 nil)
 322                        (aset elt 1 nil))
 323                      (cdr diff-list)))
 324               ((not file-B)
 325                (mapc (lambda (elt)
 326                        (aset elt 2 nil)
 327                        (aset elt 3 nil))
 328                      (cdr diff-list)))
 329               ((not file-C)
 330                (mapc (lambda (elt)
 331                        (aset elt 4 nil)
 332                        (aset elt 5 nil))
 333                      (cdr diff-list)))
 334           ))
 335
 336     (ediff-convert-fine-diffs-to-overlays diff-list reg-num)
 337     ))
 338
 339
 340 (defun ediff-prepare-error-list (ok-regexp diff-buff)
 341   (or (ediff-buffer-live-p ediff-error-buffer)
 342       (setq ediff-error-buffer
 343             (get-buffer-create (ediff-unique-buffer-name
 344                                 "*ediff-errors" "*"))))
 345   (ediff-with-current-buffer ediff-error-buffer
 346     (erase-buffer)
 347     (insert (ediff-with-current-buffer diff-buff (buffer-string)))
 348     (goto-char (point-min))
 349     (delete-matching-lines ok-regexp)
 350     (if (memq system-type '(vax-vms axp-vms))
 351         (delete-matching-lines "^$")))
 352   ;; If diff reports errors, show them then quit.
 353   (if (/= 0 (ediff-with-current-buffer ediff-error-buffer (buffer-size)))
 354       (let ((ctl-buf ediff-control-buffer)
 355             (error-buf ediff-error-buffer))
 356         (ediff-skip-unsuitable-frames)
 357         (switch-to-buffer error-buf)
 358         (ediff-kill-buffer-carefully ctl-buf)
 359         (error "Errors in diff output.  Diff output is in %S" diff-buff))))
 360
 361 ;; BOUNDS specifies visibility bounds to use.
 362 ;; WORD-MODE tells whether we are in the word-mode or not.
 363 ;; If WORD-MODE, also construct vector of diffs using word numbers.
 364 ;; Else, use point values.
 365 ;; This function handles diff-2 jobs including the case of
 366 ;; merging buffers and files without ancestor.
 367 (defun ediff-extract-diffs (diff-buffer word-mode &optional bounds)
 368   (let ((A-buffer ediff-buffer-A)
 369         (B-buffer ediff-buffer-B)
 370         (C-buffer ediff-buffer-C)
 371         (a-prev 1) ; this is needed to set the first diff line correctly
 372         (a-prev-pt nil)
 373         (b-prev 1)
 374         (b-prev-pt nil)
 375         (c-prev 1)
 376         (c-prev-pt nil)
 377         diff-list shift-A shift-B
 378         )
 379
 380     ;; diff list contains word numbers, unless changed later
 381     (setq diff-list (cons (if word-mode 'words 'points)
 382                           diff-list))
 383     ;; we don't use visibility bounds for buffer C when merging
 384     (if bounds
 385         (setq shift-A
 386               (ediff-overlay-start
 387                (ediff-get-value-according-to-buffer-type 'A bounds))
 388               shift-B
 389               (ediff-overlay-start
 390                (ediff-get-value-according-to-buffer-type 'B bounds))))
 391
 392     ;; reset point in buffers A/B/C
 393     (ediff-with-current-buffer A-buffer
 394       (goto-char (if shift-A shift-A (point-min))))
 395     (ediff-with-current-buffer B-buffer
 396       (goto-char (if shift-B shift-B (point-min))))
 397     (if (ediff-buffer-live-p C-buffer)
 398         (ediff-with-current-buffer C-buffer
 399           (goto-char (point-min))))
 400
 401     (ediff-with-current-buffer diff-buffer
 402       (goto-char (point-min))
 403       (while (re-search-forward ediff-match-diff-line nil t)
 404        (let* ((a-begin (string-to-number (buffer-substring (match-beginning 1)
 405                                                            (match-end 1))))
 406               (a-end  (let ((b (match-beginning 3))
 407                             (e (match-end 3)))
 408                         (if b
 409                             (string-to-number (buffer-substring b e))
 410                           a-begin)))
 411               (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
 412               (b-begin (string-to-number (buffer-substring (match-beginning 5)
 413                                                            (match-end 5))))
 414               (b-end (let ((b (match-beginning 7))
 415                            (e (match-end 7)))
 416                        (if b
 417                            (string-to-number (buffer-substring b e))
 418                          b-begin)))
 419               a-begin-pt a-end-pt b-begin-pt b-end-pt
 420               c-begin c-end c-begin-pt c-end-pt)
 421          ;; fix the beginning and end numbers, because diff is somewhat
 422          ;; strange about how it numbers lines
 423          (if (string-equal diff-type "a")
 424              (setq b-end (1+ b-end)
 425                    a-begin (1+ a-begin)
 426                    a-end a-begin)
 427            (if (string-equal diff-type "d")
 428                (setq a-end (1+ a-end)
 429                      b-begin (1+ b-begin)
 430                      b-end b-begin)
 431              ;; (string-equal diff-type "c")
 432              (setq a-end (1+ a-end)
 433                    b-end (1+ b-end))))
 434
 435          (if (eq ediff-default-variant 'default-B)
 436              (setq c-begin b-begin
 437                    c-end b-end)
 438            (setq c-begin a-begin
 439                  c-end a-end))
 440
 441          ;; compute main diff vector
 442          (if word-mode
 443              ;; make diff-list contain word numbers
 444              (setq diff-list
 445                    (nconc diff-list
 446                           (list
 447                            (if (ediff-buffer-live-p C-buffer)
 448                                (vector (- a-begin a-prev) (- a-end a-begin)
 449                                        (- b-begin b-prev) (- b-end b-begin)
 450                                        (- c-begin c-prev) (- c-end c-begin)
 451                                        nil nil ; dummy ancestor
 452                                        nil     ; state of diff
 453                                        nil     ; state of merge
 454                                        nil     ; state of ancestor
 455                                        )
 456                              (vector (- a-begin a-prev) (- a-end a-begin)
 457                                      (- b-begin b-prev) (- b-end b-begin)
 458                                      nil nil ; dummy buf C
 459                                      nil nil ; dummy ancestor
 460                                      nil     ; state of diff
 461                                      nil     ; state of merge
 462                                      nil     ; state of ancestor
 463                                      ))
 464                            ))
 465                    a-prev a-end
 466                    b-prev b-end
 467                    c-prev c-end)
 468            ;; else convert lines to points
 469            (ediff-with-current-buffer A-buffer
 470              (let ((longlines-mode-val
 471                     (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
 472                ;; we must disable and then restore longlines-mode
 473                (if (eq longlines-mode-val 1)
 474                    (longlines-mode 0))
 475                (goto-char (or a-prev-pt shift-A (point-min)))
 476                (forward-line (- a-begin a-prev))
 477                (setq a-begin-pt (point))
 478                (forward-line (- a-end a-begin))
 479                (setq a-end-pt (point)
 480                      a-prev a-end
 481                      a-prev-pt a-end-pt)
 482                (if (eq longlines-mode-val 1)
 483                    (longlines-mode longlines-mode-val))
 484                ))
 485            (ediff-with-current-buffer B-buffer
 486              (let ((longlines-mode-val
 487                     (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
 488                (if (eq longlines-mode-val 1)
 489                    (longlines-mode 0))
 490                (goto-char (or b-prev-pt shift-B (point-min)))
 491                (forward-line (- b-begin b-prev))
 492                (setq b-begin-pt (point))
 493                (forward-line (- b-end b-begin))
 494                (setq b-end-pt (point)
 495                      b-prev b-end
 496                      b-prev-pt b-end-pt)
 497                (if (eq longlines-mode-val 1)
 498                    (longlines-mode longlines-mode-val))
 499                ))
 500            (if (ediff-buffer-live-p C-buffer)
 501                (ediff-with-current-buffer C-buffer
 502                  (let ((longlines-mode-val
 503                         (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
 504                    (if (eq longlines-mode-val 1)
 505                        (longlines-mode 0))
 506                    (goto-char (or c-prev-pt (point-min)))
 507                    (forward-line (- c-begin c-prev))
 508                    (setq c-begin-pt (point))
 509                    (forward-line (- c-end c-begin))
 510                    (setq c-end-pt (point)
 511                          c-prev c-end
 512                          c-prev-pt c-end-pt)
 513                    (if (eq longlines-mode-val 1)
 514                        (longlines-mode longlines-mode-val))
 515                  )))
 516            (setq diff-list
 517                  (nconc
 518                   diff-list
 519                   (list
 520                    (if (ediff-buffer-live-p C-buffer)
 521                        (vector
 522                         a-begin-pt a-end-pt b-begin-pt b-end-pt
 523                         c-begin-pt c-end-pt
 524                         nil nil ; dummy ancestor
 525                         ;; state of diff
 526                         ;; shows which buff is different from the other two
 527                         (if (eq ediff-default-variant 'default-B) 'A 'B)
 528                         ediff-default-variant   ; state of merge
 529                         nil                     ; state of ancestor
 530                         )
 531                      (vector a-begin-pt a-end-pt
 532                              b-begin-pt b-end-pt
 533                              nil nil    ; dummy buf C
 534                              nil nil    ; dummy ancestor
 535                              nil nil    ; dummy state of diff & merge
 536                              nil        ; dummy state of ancestor
 537                              )))
 538                   )))
 539
 540          ))) ; end ediff-with-current-buffer
 541     diff-list
 542     ))
 543
 544
 545 (defun ediff-convert-diffs-to-overlays (diff-list)
 546   (ediff-set-diff-overlays-in-one-buffer 'A diff-list)
 547   (ediff-set-diff-overlays-in-one-buffer 'B diff-list)
 548   (if ediff-3way-job
 549       (ediff-set-diff-overlays-in-one-buffer 'C diff-list))
 550   (if ediff-merge-with-ancestor-job
 551       (ediff-set-diff-overlays-in-one-buffer 'Ancestor diff-list))
 552   ;; set up vector showing the status of merge regions
 553   (if ediff-merge-job
 554       (setq ediff-state-of-merge
 555             (vconcat
 556              (mapcar (lambda (elt)
 557                        (let ((state-of-merge (aref elt 9))
 558                              (state-of-ancestor (aref elt 10)))
 559                          (vector
 560                           ;; state of merge: prefers/default-A/B or combined
 561                           (if state-of-merge (format "%S" state-of-merge))
 562                           ;; whether the ancestor region is empty
 563                           state-of-ancestor)))
 564                      ;; the first elt designates type of list
 565                      (cdr diff-list))
 566              )))
 567   (message "Processing difference regions ... done"))
 568
 569
 570 (defun ediff-set-diff-overlays-in-one-buffer (buf-type diff-list)
 571   (let* ((current-diff -1)
 572          (buff (ediff-get-buffer buf-type))
 573          (ctl-buf ediff-control-buffer)
 574          ;; ediff-extract-diffs puts the type of diff-list as the first elt
 575          ;; of this list. The type is either 'points or 'words
 576          (diff-list-type (car diff-list))
 577          (shift (ediff-overlay-start
 578                  (ediff-get-value-according-to-buffer-type
 579                   buf-type ediff-narrow-bounds)))
 580          (limit (ediff-overlay-end
 581                  (ediff-get-value-according-to-buffer-type
 582                   buf-type ediff-narrow-bounds)))
 583          diff-overlay-list list-element total-diffs
 584          begin end pt-saved overlay state-of-diff)
 585
 586     (setq diff-list (cdr diff-list)) ; discard diff list type
 587     (setq total-diffs (length diff-list))
 588
 589     ;; shift, if necessary
 590     (ediff-with-current-buffer buff (setq pt-saved shift))
 591
 592     (while diff-list
 593       (setq current-diff (1+ current-diff)
 594             list-element (car diff-list)
 595             begin        (aref list-element (cond ((eq buf-type 'A) 0)
 596                                                   ((eq buf-type 'B) 2)
 597                                                   ((eq buf-type 'C) 4)
 598                                                   (t 6)))  ; Ancestor
 599             end          (aref list-element (cond ((eq buf-type 'A) 1)
 600                                                   ((eq buf-type 'B) 3)
 601                                                   ((eq buf-type 'C) 5)
 602                                                   (t 7)))  ; Ancestor
 603             state-of-diff (aref list-element 8)
 604             )
 605
 606       (cond ((and (not (eq buf-type state-of-diff))
 607                   (not (eq buf-type 'Ancestor))
 608                   (memq state-of-diff '(A B C)))
 609              (setq state-of-diff
 610                    (car (delq buf-type (delq state-of-diff (list 'A 'B 'C)))))
 611              (setq state-of-diff (format "=diff(%S)" state-of-diff))
 612              )
 613             (t (setq state-of-diff nil)))
 614
 615       ;; Put overlays at appropriate places in buffer
 616       ;; convert word numbers to points, if necessary
 617       (if (eq diff-list-type 'words)
 618           (progn
 619             (ediff-with-current-buffer buff (goto-char pt-saved))
 620             (ediff-with-current-buffer ctl-buf
 621               (setq begin (ediff-goto-word (1+ begin) buff)
 622                     end (ediff-goto-word end buff 'end)))
 623             (if (> end limit) (setq end limit))
 624             (if (> begin end) (setq begin end))
 625             (setq pt-saved (ediff-with-current-buffer buff (point)))))
 626       (setq overlay (ediff-make-bullet-proof-overlay begin end buff))
 627
 628       (ediff-overlay-put overlay 'priority ediff-shadow-overlay-priority)
 629       (ediff-overlay-put overlay 'ediff-diff-num current-diff)
 630       (if (and (ediff-has-face-support-p)
 631                ediff-use-faces ediff-highlight-all-diffs)
 632           (ediff-set-overlay-face
 633            overlay (ediff-background-face buf-type current-diff)))
 634
 635       (if (= 0 (mod current-diff 10))
 636           (message "Buffer %S: Processing difference region %d of %d"
 637                    buf-type current-diff total-diffs))
 638       ;; Record all overlays for this difference.
 639       ;; The 2-d elt, nil, is a place holder for the fine diff vector.
 640       ;; The 3-d elt, nil, is a place holder for no-fine-diffs flag.
 641       ;; The 4-th elt says which diff region is different from the other two
 642       ;; (3-way jobs only).
 643       (setq diff-overlay-list
 644             (nconc
 645              diff-overlay-list
 646              (list (vector overlay nil nil state-of-diff)))
 647             diff-list
 648             (cdr diff-list))
 649       ) ; while
 650
 651     (set (ediff-get-symbol-from-alist buf-type ediff-difference-vector-alist)
 652          (vconcat diff-overlay-list))
 653     ))
 654
 655 ;; `n' is the diff region to work on.  Default is ediff-current-difference.
 656 ;; if `flag' is 'noforce then make fine-diffs only if this region's fine
 657 ;; diffs have not been computed before.
 658 ;; if `flag' is 'skip then don't compute fine diffs for this region.
 659 (defun ediff-make-fine-diffs (&optional n flag)
 660   (or n  (setq n ediff-current-difference))
 661
 662   (if (< ediff-number-of-differences 1)
 663       (error ediff-NO-DIFFERENCES))
 664
 665   (if ediff-word-mode
 666       (setq flag 'skip
 667             ediff-auto-refine 'nix))
 668
 669   (or (< n 0)
 670       (>= n ediff-number-of-differences)
 671       ;; n is within the range
 672       (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer))
 673             (file-A ediff-temp-file-A)
 674             (file-B ediff-temp-file-B)
 675             (file-C ediff-temp-file-C)
 676             (empty-A (ediff-empty-diff-region-p n 'A))
 677             (empty-B (ediff-empty-diff-region-p n 'B))
 678             (empty-C (ediff-empty-diff-region-p n 'C))
 679             (whitespace-A (ediff-whitespace-diff-region-p n 'A))
 680             (whitespace-B (ediff-whitespace-diff-region-p n 'B))
 681             (whitespace-C (ediff-whitespace-diff-region-p n 'C))
 682             cumulative-fine-diff-length)
 683
 684         (cond ;; If one of the regions is empty (or 2 in 3way comparison)
 685               ;; then don't refine.
 686               ;; If the region happens to be entirely whitespace or empty then
 687               ;; mark as such.
 688               ((> (length (delq nil (list empty-A empty-B empty-C))) 1)
 689                (if (and (ediff-looks-like-combined-merge n)
 690                         ediff-merge-job)
 691                    (ediff-set-fine-overlays-in-one-buffer 'C nil n))
 692                (if ediff-3way-comparison-job
 693                    (ediff-message-if-verbose
 694                     "Region %d is empty in all buffers but %S"
 695                     (1+ n)
 696                     (cond ((not empty-A) 'A)
 697                           ((not empty-B) 'B)
 698                           ((not empty-C) 'C)))
 699                  (ediff-message-if-verbose
 700                   "Region %d in buffer %S is empty"
 701                   (1+ n)
 702                   (cond (empty-A 'A)
 703                         (empty-B 'B)
 704                         (empty-C 'C)))
 705                  )
 706                ;; if all regions happen to be whitespace
 707                (if (and whitespace-A whitespace-B whitespace-C)
 708                    ;; mark as space only
 709                    (ediff-mark-diff-as-space-only n t)
 710                  ;; if some regions are white and others don't, then mark as
 711                  ;; non-white-space-only
 712                  (ediff-mark-diff-as-space-only n nil)))
 713
 714               ;; don't compute fine diffs if diff vector exists
 715               ((and (eq flag 'noforce) (ediff-get-fine-diff-vector n 'A))
 716                (if (ediff-no-fine-diffs-p n)
 717                    (message
 718                     "Only white-space differences in region %d %s"
 719                     (1+ n)
 720                     (cond ((eq (ediff-no-fine-diffs-p n) 'A)
 721                            "in buffers B & C")
 722                           ((eq (ediff-no-fine-diffs-p n) 'B)
 723                            "in buffers A & C")
 724                           ((eq (ediff-no-fine-diffs-p n) 'C)
 725                            "in buffers A & B")
 726                           (t "")))))
 727               ;; don't compute fine diffs for this region
 728               ((eq flag 'skip)
 729                (or (ediff-get-fine-diff-vector n 'A)
 730                    (memq ediff-auto-refine '(off nix))
 731                    (ediff-message-if-verbose
 732                     "Region %d exceeds the auto-refinement limit. Type `%s' to refine"
 733                     (1+ n)
 734                     (substitute-command-keys
 735                      "\\[ediff-make-or-kill-fine-diffs]")
 736                     )))
 737               (t
 738                ;; recompute fine diffs
 739                (ediff-wordify
 740                 (ediff-get-diff-posn 'A 'beg n)
 741                 (ediff-get-diff-posn 'A 'end n)
 742                 ediff-buffer-A
 743                 tmp-buffer
 744                 ediff-control-buffer)
 745                (setq file-A
 746                      (ediff-make-temp-file tmp-buffer "fineDiffA" file-A))
 747
 748                (ediff-wordify
 749                 (ediff-get-diff-posn 'B 'beg n)
 750                 (ediff-get-diff-posn 'B 'end n)
 751                 ediff-buffer-B
 752                 tmp-buffer
 753                 ediff-control-buffer)
 754                (setq file-B
 755                      (ediff-make-temp-file tmp-buffer "fineDiffB" file-B))
 756
 757                (if ediff-3way-job
 758                    (progn
 759                      (ediff-wordify
 760                       (ediff-get-diff-posn 'C 'beg n)
 761                       (ediff-get-diff-posn 'C 'end n)
 762                       ediff-buffer-C
 763                       tmp-buffer
 764                       ediff-control-buffer)
 765                      (setq file-C
 766                            (ediff-make-temp-file
 767                             tmp-buffer "fineDiffC" file-C))))
 768
 769                ;; save temp file names.
 770                (setq ediff-temp-file-A file-A
 771                      ediff-temp-file-B file-B
 772                      ediff-temp-file-C file-C)
 773
 774                ;; set the new vector of fine diffs, if none exists
 775                (cond ((and ediff-3way-job whitespace-A)
 776                       (ediff-setup-fine-diff-regions nil file-B file-C n))
 777                      ((and ediff-3way-job whitespace-B)
 778                       (ediff-setup-fine-diff-regions file-A nil file-C n))
 779                      ((and ediff-3way-job
 780                            ;; In merge-jobs, whitespace-C is t, since
 781                            ;; ediff-empty-diff-region-p returns t in this case
 782                            whitespace-C)
 783                       (ediff-setup-fine-diff-regions file-A file-B nil n))
 784                      (t
 785                       (ediff-setup-fine-diff-regions file-A file-B file-C n)))
 786
 787                (setq cumulative-fine-diff-length
 788                      (+ (length (ediff-get-fine-diff-vector n 'A))
 789                         (length (ediff-get-fine-diff-vector n 'B))
 790                         ;; in merge jobs, the merge buffer is never refined
 791                         (if (and file-C (not ediff-merge-job))
 792                             (length (ediff-get-fine-diff-vector n 'C))
 793                           0)))
 794
 795                (cond ((or
 796                        ;; all regions are white space
 797                        (and whitespace-A whitespace-B whitespace-C)
 798                        ;; none is white space and no fine diffs detected
 799                        (and (not whitespace-A)
 800                             (not whitespace-B)
 801                             (not (and ediff-3way-job whitespace-C))
 802                             (eq cumulative-fine-diff-length 0)))
 803                       (ediff-mark-diff-as-space-only n t)
 804                       (ediff-message-if-verbose
 805                        "Only white-space differences in region %d" (1+ n)))
 806                      ((eq cumulative-fine-diff-length 0)
 807                       (ediff-message-if-verbose
 808                        "Only white-space differences in region %d %s"
 809                        (1+ n)
 810                        (cond (whitespace-A (ediff-mark-diff-as-space-only n 'A)
 811                                            "in buffers B & C")
 812                              (whitespace-B (ediff-mark-diff-as-space-only n 'B)
 813                                            "in buffers A & C")
 814                              (whitespace-C (ediff-mark-diff-as-space-only n 'C)
 815                                            "in buffers A & B"))))
 816                      (t
 817                       (ediff-mark-diff-as-space-only n nil)))
 818                )
 819               ) ; end cond
 820         (ediff-set-fine-diff-properties n)
 821         )))
 822
 823 ;; Interface to ediff-make-fine-diffs. Checks for auto-refine limit, etc.
 824 (defun ediff-install-fine-diff-if-necessary (n)
 825   (cond ((and (eq ediff-auto-refine 'on)
 826               ediff-use-faces
 827               (not (eq ediff-highlighting-style 'off))
 828               (not (eq ediff-highlighting-style 'ascii)))
 829          (if (and
 830               (> ediff-auto-refine-limit
 831                  (- (ediff-get-diff-posn 'A 'end n)
 832                     (ediff-get-diff-posn 'A 'beg n)))
 833               (> ediff-auto-refine-limit
 834                  (- (ediff-get-diff-posn 'B 'end n)
 835                     (ediff-get-diff-posn 'B 'beg n))))
 836              (ediff-make-fine-diffs n 'noforce)
 837            (ediff-make-fine-diffs n 'skip)))
 838
 839         ;; highlight if fine diffs already exist
 840         ((eq ediff-auto-refine 'off)
 841          (ediff-make-fine-diffs n 'skip))))
 842
 843
 844 ;; if fine diff vector is not set for diff N, then do nothing
 845 (defun ediff-set-fine-diff-properties (n &optional default)
 846   (or (not (ediff-has-face-support-p))
 847       (< n 0)
 848       (>= n ediff-number-of-differences)
 849       ;; when faces are supported, set faces and priorities of fine overlays
 850       (progn
 851         (ediff-set-fine-diff-properties-in-one-buffer 'A n default)
 852         (ediff-set-fine-diff-properties-in-one-buffer 'B n default)
 853         (if ediff-3way-job
 854             (ediff-set-fine-diff-properties-in-one-buffer 'C n default)))))
 855
 856 (defun ediff-set-fine-diff-properties-in-one-buffer (buf-type
 857                                                      n &optional default)
 858   (let ((fine-diff-vector  (ediff-get-fine-diff-vector n buf-type))
 859         (face (if default
 860                   'default
 861                 (ediff-get-symbol-from-alist
 862                  buf-type ediff-fine-diff-face-alist)
 863                 ))
 864         (priority (if default
 865                       0
 866                     (1+ (or (ediff-overlay-get
 867                              (symbol-value
 868                               (ediff-get-symbol-from-alist
 869                                buf-type
 870                                ediff-current-diff-overlay-alist))
 871                              'priority)
 872                             0)))))
 873     (mapcar (lambda (overl)
 874               (ediff-set-overlay-face overl face)
 875               (ediff-overlay-put overl 'priority priority))
 876             fine-diff-vector)))
 877
 878 ;; Set overlays over the regions that denote delimiters
 879 (defun ediff-set-fine-overlays-for-combined-merge (diff-list reg-num)
 880   (let (overlay overlay-list)
 881     (while diff-list
 882       (condition-case nil
 883           (setq overlay
 884                 (ediff-make-bullet-proof-overlay
 885                  (nth 0 diff-list) (nth 1 diff-list) ediff-buffer-C))
 886         (error ""))
 887       (setq overlay-list (cons overlay overlay-list))
 888       (if (> (length diff-list) 1)
 889           (setq diff-list (cdr (cdr diff-list)))
 890         (error "ediff-set-fine-overlays-for-combined-merge: corrupt list of
 891 delimiter regions"))
 892       )
 893     (setq overlay-list (reverse overlay-list))
 894     (ediff-set-fine-diff-vector
 895      reg-num 'C (apply 'vector overlay-list))
 896     ))
 897
 898
 899 ;; Convert diff list to overlays for a given DIFF-REGION
 900 ;; in buffer of type BUF-TYPE
 901 (defun ediff-set-fine-overlays-in-one-buffer (buf-type diff-list region-num)
 902   (let* ((current-diff -1)
 903          (reg-start (ediff-get-diff-posn buf-type 'beg region-num))
 904          (buff (ediff-get-buffer buf-type))
 905          (ctl-buf ediff-control-buffer)
 906          combined-merge-diff-list
 907          diff-overlay-list list-element
 908          begin end overlay)
 909
 910     (ediff-clear-fine-differences-in-one-buffer region-num buf-type)
 911     (setq diff-list (cdr diff-list)) ; discard list type (words or points)
 912     (ediff-with-current-buffer buff (goto-char reg-start))
 913
 914     ;; if it is a combined merge then set overlays in buff C specially
 915     (if (and ediff-merge-job (eq buf-type 'C)
 916              (setq combined-merge-diff-list
 917                    (ediff-looks-like-combined-merge region-num)))
 918         (ediff-set-fine-overlays-for-combined-merge
 919          combined-merge-diff-list region-num)
 920       ;; regular fine diff
 921       (while diff-list
 922         (setq current-diff (1+ current-diff)
 923               list-element (car diff-list)
 924               begin      (aref list-element (cond ((eq buf-type 'A) 0)
 925                                                   ((eq buf-type 'B) 2)
 926                                                   (t 4)))  ; buf C
 927               end        (aref list-element (cond ((eq buf-type 'A) 1)
 928                                                   ((eq buf-type 'B) 3)
 929                                                   (t 5)))) ; buf C
 930         (if (not (or begin end))
 931             () ; skip this diff
 932           ;; Put overlays at appropriate places in buffers
 933           ;; convert lines to points, if necessary
 934           (ediff-with-current-buffer ctl-buf
 935             (setq begin (ediff-goto-word (1+ begin) buff)
 936                   end (ediff-goto-word end buff 'end)))
 937           (setq overlay (ediff-make-bullet-proof-overlay begin end buff))
 938           ;; record all overlays for this difference region
 939           (setq diff-overlay-list (nconc diff-overlay-list (list overlay))))
 940
 941         (setq diff-list (cdr diff-list))
 942         ) ; while
 943       ;; convert the list of difference information into a vector
 944       ;; for fast access
 945       (ediff-set-fine-diff-vector
 946        region-num buf-type (vconcat diff-overlay-list))
 947       )))
 948
 949
 950 (defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num)
 951   (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num)
 952   (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num)
 953   (if ediff-3way-job
 954       (ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num)
 955     ))
 956
 957
 958 ;; Stolen from emerge.el
 959 (defun ediff-get-diff3-group (file)
 960   ;; This save-excursion allows ediff-get-diff3-group to be called for the
 961   ;; various groups of lines (1, 2, 3) in any order, and for the lines to
 962   ;; appear in any order.  The reason this is necessary is that Gnu diff3
 963   ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2.
 964   (save-excursion
 965     (re-search-forward
 966      (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)\C-m?$"))
 967     (beginning-of-line 2)
 968     ;; treatment depends on whether it is an "a" group or a "c" group
 969     (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c")
 970         ;; it is a "c" group
 971         (if (match-beginning 2)
 972             ;; it has two numbers
 973             (list (string-to-number
 974                    (buffer-substring (match-beginning 1) (match-end 1)))
 975                   (1+ (string-to-number
 976                        (buffer-substring (match-beginning 3) (match-end 3)))))
 977           ;; it has one number
 978           (let ((x (string-to-number
 979                     (buffer-substring (match-beginning 1) (match-end 1)))))
 980             (list x (1+ x))))
 981       ;; it is an "a" group
 982       (let ((x (1+ (string-to-number
 983                     (buffer-substring (match-beginning 1) (match-end 1))))))
 984         (list x x)))))
 985
 986
 987 ;; If WORD-MODE, construct vector of diffs using word numbers.
 988 ;; Else, use point values.
 989 ;; WORD-MODE also tells if we are in the word-mode or not.
 990 ;; If THREE-WAY-COMP, then it is a 3-way comparison. Else, it is merging
 991 ;; with ancestor, in which case buffer-C contents is identical to buffer-A/B,
 992 ;; contents (unless buffer-A is narrowed) depending on ediff-default-variant's
 993 ;; value.
 994 ;; BOUNDS specifies visibility bounds to use.
 995 (defun ediff-extract-diffs3 (diff-buffer word-mode three-way-comp
 996                                           &optional bounds)
 997   (let ((A-buffer ediff-buffer-A)
 998         (B-buffer ediff-buffer-B)
 999         (C-buffer ediff-buffer-C)
1000         (anc-buffer ediff-ancestor-buffer)
1001         (a-prev 1) ; needed to set the first diff line correctly
1002         (a-prev-pt nil)
1003         (b-prev 1)
1004         (b-prev-pt nil)
1005         (c-prev 1)
1006         (c-prev-pt nil)
1007         (anc-prev 1)
1008         diff-list shift-A shift-B shift-C
1009         )
1010
1011     ;; diff list contains word numbers or points, depending on word-mode
1012     (setq diff-list (cons (if word-mode 'words 'points)
1013                           diff-list))
1014     (if bounds
1015         (setq shift-A
1016               (ediff-overlay-start
1017                (ediff-get-value-according-to-buffer-type 'A bounds))
1018               shift-B
1019               (ediff-overlay-start
1020                (ediff-get-value-according-to-buffer-type 'B bounds))
1021               shift-C
1022               (if three-way-comp
1023                   (ediff-overlay-start
1024                    (ediff-get-value-according-to-buffer-type 'C bounds)))))
1025
1026     ;; reset point in buffers A, B, C
1027     (ediff-with-current-buffer A-buffer
1028       (goto-char (if shift-A shift-A (point-min))))
1029     (ediff-with-current-buffer B-buffer
1030       (goto-char (if shift-B shift-B (point-min))))
1031     (if three-way-comp
1032         (ediff-with-current-buffer C-buffer
1033           (goto-char (if shift-C shift-C (point-min)))))
1034     (if (ediff-buffer-live-p anc-buffer)
1035         (ediff-with-current-buffer anc-buffer
1036           (goto-char (point-min))))
1037
1038     (ediff-with-current-buffer diff-buffer
1039       (goto-char (point-min))
1040       (while (re-search-forward ediff-match-diff3-line nil t)
1041         ;; leave point after matched line
1042        (beginning-of-line 2)
1043        (let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
1044          ;; if the files A and B are the same and not 3way-comparison,
1045          ;; ignore the difference
1046          (if (or three-way-comp (not (string-equal agreement "3")))
1047              (let* ((a-begin (car (ediff-get-diff3-group "1")))
1048                     (a-end  (nth 1 (ediff-get-diff3-group "1")))
1049                     (b-begin (car (ediff-get-diff3-group "2")))
1050                     (b-end (nth 1 (ediff-get-diff3-group "2")))
1051                     (c-or-anc-begin (car (ediff-get-diff3-group "3")))
1052                     (c-or-anc-end (nth 1 (ediff-get-diff3-group "3")))
1053                     (state-of-merge
1054                      (cond ((string-equal agreement "1") 'prefer-A)
1055                            ((string-equal agreement "2") 'prefer-B)
1056                            (t ediff-default-variant)))
1057                     (state-of-diff-merge
1058                      (if (memq state-of-merge '(default-A prefer-A)) 'B 'A))
1059                     (state-of-diff-comparison
1060                      (cond ((string-equal agreement "1") 'A)
1061                            ((string-equal agreement "2") 'B)
1062                            ((string-equal agreement "3") 'C)))
1063                     state-of-ancestor
1064                     c-begin c-end
1065                     a-begin-pt a-end-pt
1066                     b-begin-pt b-end-pt
1067                     c-begin-pt c-end-pt
1068                     anc-begin-pt anc-end-pt)
1069
1070                (setq state-of-ancestor
1071                      (= c-or-anc-begin c-or-anc-end))
1072
1073                (cond (three-way-comp
1074                       (setq c-begin c-or-anc-begin
1075                             c-end c-or-anc-end))
1076                      ((eq ediff-default-variant 'default-B)
1077                       (setq c-begin b-begin
1078                             c-end b-end))
1079                      (t
1080                       (setq c-begin a-begin
1081                             c-end a-end)))
1082
1083                ;; compute main diff vector
1084                (if word-mode
1085                    ;; make diff-list contain word numbers
1086                    (setq diff-list
1087                          (nconc diff-list
1088                                 (list (vector
1089                                        (- a-begin a-prev) (- a-end a-begin)
1090                                        (- b-begin b-prev) (- b-end b-begin)
1091                                        (- c-begin c-prev) (- c-end c-begin)
1092                                        nil nil ; dummy ancestor
1093                                        nil     ; state of diff
1094                                        nil     ; state of merge
1095                                        nil     ; state of ancestor
1096                                        )))
1097                          a-prev a-end
1098                          b-prev b-end
1099                          c-prev c-end)
1100                  ;; else convert lines to points
1101                  (ediff-with-current-buffer A-buffer
1102                    (let ((longlines-mode-val
1103                           (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
1104                      ;; we must disable and then restore longlines-mode
1105                      (if (eq longlines-mode-val 1)
1106                          (longlines-mode 0))
1107                      (goto-char (or a-prev-pt shift-A (point-min)))
1108                      (forward-line (- a-begin a-prev))
1109                      (setq a-begin-pt (point))
1110                      (forward-line (- a-end a-begin))
1111                      (setq a-end-pt (point)
1112                            a-prev a-end
1113                            a-prev-pt a-end-pt)
1114                      (if (eq longlines-mode-val 1)
1115                          (longlines-mode longlines-mode-val))
1116                      ))
1117                  (ediff-with-current-buffer B-buffer
1118                    (let ((longlines-mode-val
1119                           (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
1120                      (if (eq longlines-mode-val 1)
1121                          (longlines-mode 0))
1122                      (goto-char (or b-prev-pt shift-B (point-min)))
1123                      (forward-line (- b-begin b-prev))
1124                      (setq b-begin-pt (point))
1125                      (forward-line (- b-end b-begin))
1126                      (setq b-end-pt (point)
1127                            b-prev b-end
1128                            b-prev-pt b-end-pt)
1129                      (if (eq longlines-mode-val 1)
1130                          (longlines-mode longlines-mode-val))
1131                      ))
1132                  (ediff-with-current-buffer C-buffer
1133                    (let ((longlines-mode-val
1134                           (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
1135                      (if (eq longlines-mode-val 1)
1136                          (longlines-mode 0))
1137                      (goto-char (or c-prev-pt shift-C (point-min)))
1138                      (forward-line (- c-begin c-prev))
1139                      (setq c-begin-pt (point))
1140                      (forward-line (- c-end c-begin))
1141                      (setq c-end-pt (point)
1142                            c-prev c-end
1143                            c-prev-pt c-end-pt)
1144                      (if (eq longlines-mode-val 1)
1145                          (longlines-mode longlines-mode-val))
1146                      ))
1147                  (if (ediff-buffer-live-p anc-buffer)
1148                      (ediff-with-current-buffer anc-buffer
1149                        (let ((longlines-mode-val
1150                               (if (and (boundp 'longlines-mode) longlines-mode) 1 0)))
1151                          (if (eq longlines-mode-val 1)
1152                              (longlines-mode 0))
1153                          (forward-line (- c-or-anc-begin anc-prev))
1154                          (setq anc-begin-pt (point))
1155                          (forward-line (- c-or-anc-end c-or-anc-begin))
1156                          (setq anc-end-pt (point)
1157                                anc-prev c-or-anc-end)
1158                          (if (eq longlines-mode-val 1)
1159                              (longlines-mode longlines-mode-val))
1160                          )))
1161                  (setq diff-list
1162                        (nconc
1163                         diff-list
1164                         ;; if comparing with ancestor, then there also is a
1165                         ;; state-of-difference marker
1166                         (if three-way-comp
1167                             (list (vector
1168                                    a-begin-pt a-end-pt
1169                                    b-begin-pt b-end-pt
1170                                    c-begin-pt c-end-pt
1171                                    nil nil ; ancestor begin/end
1172                                    state-of-diff-comparison
1173                                    nil  ; state of merge
1174                                    nil  ; state of ancestor
1175                                    ))
1176                           (list (vector a-begin-pt a-end-pt
1177                                         b-begin-pt b-end-pt
1178                                         c-begin-pt c-end-pt
1179                                         anc-begin-pt anc-end-pt
1180                                         state-of-diff-merge
1181                                         state-of-merge
1182                                         state-of-ancestor
1183                                         )))
1184                         )))
1185                ))
1186
1187          ))) ; end ediff-with-current-buffer
1188     diff-list
1189     ))
1190
1191 ;; Generate the difference vector and overlays for three files
1192 ;; File-C is either the third file to compare (in case of 3-way comparison)
1193 ;; or it is the ancestor file.
1194 (defun ediff-setup-diff-regions3 (file-A file-B file-C)
1195   ;; looking for '-i' or a 'i' among clustered non-long options
1196   (if (string-match "^-i\\| -i\\|\\(^\\| \\)-[^- ]+i" ediff-diff-options)
1197       (error "Option `-i' is not allowed in `ediff-diff3-options'"))
1198
1199   (or (ediff-buffer-live-p ediff-diff-buffer)
1200       (setq ediff-diff-buffer
1201             (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
1202
1203   (message "Computing differences ...")
1204   (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize
1205                       ediff-actual-diff3-options file-A file-B file-C)
1206
1207   (ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer)
1208   ;;(message "Computing differences ... done")
1209   (ediff-convert-diffs-to-overlays
1210    (ediff-extract-diffs3
1211     ediff-diff-buffer
1212     ediff-word-mode ediff-3way-comparison-job ediff-narrow-bounds)
1213    ))
1214
1215
1216 ;; Execute PROGRAM asynchronously, unless OS/2, Windows-*, or DOS, or unless
1217 ;; SYNCH is non-nil.  BUFFER must be a buffer object, and must be alive.  The
1218 ;; OPTIONS arg is a list of options to pass to PROGRAM. It may be a blank
1219 ;; string.  All elements in FILES must be strings.  We also delete nil from
1220 ;; args.
1221 (defun ediff-exec-process (program buffer synch options &rest files)
1222   (let ((data (match-data))
1223         (coding-system-for-read ediff-coding-system-for-read)
1224         args)
1225     (setq args (append (split-string options) files))
1226     (setq args (delete "" (delq nil args))) ; delete nil and "" from arguments
1227     ;; the --binary option, if present, should be used only for buffer jobs
1228     ;; or for refining the differences
1229     (or (string-match "buffer" (symbol-name ediff-job-name))
1230         (eq buffer ediff-fine-diff-buffer)
1231         (setq args (delete "--binary" args)))
1232     (unwind-protect
1233         (let ((directory default-directory)
1234               proc)
1235           (save-excursion
1236             (set-buffer buffer)
1237             (erase-buffer)
1238             (setq default-directory directory)
1239             (if (or (memq system-type '(emx ms-dos windows-nt windows-95))
1240                     synch)
1241                 ;; In OS/2 (emx) do it synchronously, since OS/2 doesn't let us
1242                 ;; delete files used by other processes. Thus, in ediff-buffers
1243                 ;; and similar functions, we can't delete temp files because
1244                 ;; they might be used by the asynch process that computes
1245                 ;; custom diffs. So, we have to wait till custom diff
1246                 ;; subprocess is done.
1247                 ;; Similarly for Windows-*
1248                 ;; In DOS, must synchronize because DOS doesn't have
1249                 ;; asynchronous processes.
1250                 (apply 'call-process program nil buffer nil args)
1251               ;; On other systems, do it asynchronously.
1252               (setq proc (get-buffer-process buffer))
1253               (if proc (kill-process proc))
1254               (setq proc
1255                     (apply 'start-process "Custom Diff" buffer program args))
1256               (setq mode-line-process '(":%s"))
1257               (set-process-sentinel proc 'ediff-process-sentinel)
1258               (set-process-filter proc 'ediff-process-filter)
1259               )))
1260       (store-match-data data))))
1261
1262 ;; This is shell-command-filter from simple.el in Emacs.
1263 ;; Copied here because XEmacs doesn't have it.
1264 (defun ediff-process-filter (proc string)
1265   ;; Do save-excursion by hand so that we can leave point numerically unchanged
1266   ;; despite an insertion immediately after it.
1267   (let* ((obuf (current-buffer))
1268          (buffer (process-buffer proc))
1269          opoint
1270          (window (get-buffer-window buffer))
1271          (pos (window-start window)))
1272     (unwind-protect
1273         (progn
1274           (set-buffer buffer)
1275           (or (= (point) (point-max))
1276               (setq opoint (point)))
1277           (goto-char (point-max))
1278           (insert-before-markers string))
1279       ;; insert-before-markers moved this marker: set it back.
1280       (set-window-start window pos)
1281       ;; Finish our save-excursion.
1282       (if opoint
1283           (goto-char opoint))
1284       (set-buffer obuf))))
1285
1286 ;; like shell-command-sentinel but doesn't print an exit status message
1287 ;; we do this because diff always exits with status 1, if diffs are found
1288 ;; so shell-command-sentinel displays a confusing message to the user
1289 (defun ediff-process-sentinel (process signal)
1290   (if (and (memq (process-status process) '(exit signal))
1291            (buffer-name (process-buffer process)))
1292       (progn
1293         (save-excursion
1294           (set-buffer (process-buffer process))
1295           (setq mode-line-process nil))
1296         (delete-process process))))
1297
1298
1299 ;;; Word functions used to refine the current diff
1300
1301 (defvar ediff-forward-word-function 'ediff-forward-word
1302   "*Function to call to move to the next word.
1303 Used for splitting difference regions into individual words.")
1304 (make-variable-buffer-local 'ediff-forward-word-function)
1305
1306 ;; \240 is unicode symbol for nonbreakable whitespace
1307 (defvar ediff-whitespace " \n\t\f\r\240"
1308   "*Characters constituting white space.
1309 These characters are ignored when differing regions are split into words.")
1310 (make-variable-buffer-local 'ediff-whitespace)
1311
1312 (defvar ediff-word-1
1313   (ediff-cond-compile-for-xemacs-or-emacs "a-zA-Z---_" "-[:word:]_")
1314   "*Characters that constitute words of type 1.
1315 More precisely, [ediff-word-1] is a regexp that matches type 1 words.
1316 See `ediff-forward-word' for more details.")
1317 (make-variable-buffer-local 'ediff-word-1)
1318
1319 (defvar ediff-word-2 "0-9.,"
1320   "*Characters that constitute words of type 2.
1321 More precisely, [ediff-word-2] is a regexp that matches type 2 words.
1322 See `ediff-forward-word' for more details.")
1323 (make-variable-buffer-local 'ediff-word-2)
1324
1325 (defvar ediff-word-3 "`'?!:;\"{}[]()"
1326   "*Characters that constitute words of type 3.
1327 More precisely, [ediff-word-3] is a regexp that matches type 3 words.
1328 See `ediff-forward-word' for more details.")
1329 (make-variable-buffer-local 'ediff-word-3)
1330
1331 (defvar ediff-word-4
1332   (concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace)
1333   "*Characters that constitute words of type 4.
1334 More precisely, [ediff-word-4] is a regexp that matches type 4 words.
1335 See `ediff-forward-word' for more details.")
1336 (make-variable-buffer-local 'ediff-word-4)
1337
1338 ;; Split region along word boundaries. Each word will be on its own line.
1339 ;; Output to buffer out-buffer.
1340 (defun ediff-forward-word ()
1341   "Move point one word forward.
1342 There are four types of words, each of which consists entirely of
1343 characters in `ediff-word-1', `ediff-word-2', `ediff-word-3', or
1344 `ediff-word-4'.  Words are recognized by passing these one after another as
1345 arguments to `skip-chars-forward'."
1346   (or (> (+ (skip-chars-forward ediff-word-1)
1347             (skip-syntax-forward "w"))
1348          0)
1349       (> (skip-chars-forward ediff-word-2) 0)
1350       (> (skip-chars-forward ediff-word-3) 0)
1351       (> (skip-chars-forward ediff-word-4) 0)
1352       ))
1353
1354
1355 (defun ediff-wordify (beg end in-buffer out-buffer &optional control-buf)
1356   (let ((forward-word-function
1357          ;; eval in control buf to let user create local versions for
1358          ;; different invocations
1359          (if control-buf
1360              (ediff-with-current-buffer control-buf
1361                ediff-forward-word-function)
1362            ediff-forward-word-function))
1363         inbuf-syntax-tbl sv-point diff-string)
1364     (save-excursion
1365      (set-buffer in-buffer)
1366      (setq inbuf-syntax-tbl
1367            (if control-buf
1368                (ediff-with-current-buffer control-buf
1369                  ediff-syntax-table)
1370              (syntax-table)))
1371      (setq diff-string (buffer-substring-no-properties beg end))
1372
1373      (set-buffer out-buffer)
1374      ;; Make sure that temp buff syntax table is the same as the original buf
1375      ;; syntax tbl, because we use ediff-forward-word in both and
1376      ;; ediff-forward-word depends on the syntax classes of characters.
1377      (set-syntax-table inbuf-syntax-tbl)
1378      (erase-buffer)
1379      (insert diff-string)
1380      (goto-char (point-min))
1381      (skip-chars-forward ediff-whitespace)
1382      (delete-region (point-min) (point))
1383
1384      (while (not (eobp))
1385        (funcall forward-word-function)
1386        (setq sv-point (point))
1387        (skip-chars-forward ediff-whitespace)
1388        (delete-region sv-point (point))
1389        (insert "\n")))))
1390
1391 ;; copy string specified as BEG END from IN-BUF to OUT-BUF
1392 (defun ediff-copy-to-buffer (beg end in-buffer out-buffer)
1393   (with-current-buffer out-buffer
1394     (erase-buffer)
1395     (insert-buffer-substring in-buffer beg end)
1396     (goto-char (point-min))))
1397
1398
1399 ;; goto word #n starting at current position in buffer `buf'
1400 ;; For ediff, a word is determined by ediff-forward-word-function
1401 ;; If `flag' is non-nil, goto the end of the n-th word.
1402 (defun ediff-goto-word (n buf &optional flag)
1403   ;; remember val ediff-forward-word-function has in ctl buf
1404   (let ((fwd-word-fun ediff-forward-word-function)
1405         (syntax-tbl ediff-syntax-table))
1406     (ediff-with-current-buffer buf
1407       (skip-chars-forward ediff-whitespace)
1408       (ediff-with-syntax-table syntax-tbl
1409         (while (> n 1)
1410           (funcall fwd-word-fun)
1411           (skip-chars-forward ediff-whitespace)
1412           (setq n (1- n)))
1413         (if (and flag (> n 0))
1414             (funcall fwd-word-fun)))
1415       (point))))
1416
1417 (defun ediff-same-file-contents (f1 f2)
1418   "Return t if files F1 and F2 have identical contents."
1419   (if (and (not (file-directory-p f1))
1420            (not (file-directory-p f2)))
1421       (let ((res
1422              (apply 'call-process ediff-cmp-program nil nil nil
1423                     (append ediff-cmp-options (list (expand-file-name f1)
1424                                                     (expand-file-name f2))))
1425              ))
1426         (and (numberp res) (eq res 0)))
1427     ))
1428
1429
1430 (defun ediff-same-contents (d1 d2 &optional filter-re)
1431   "Return t if D1 and D2 have the same content.
1432 D1 and D2 can either be both directories or both regular files.
1433 Symlinks and the likes are not handled.
1434 If FILTER-RE is non-nil, recursive checking in directories
1435 affects only files whose names match the expression."
1436   ;; Normalize empty filter RE to nil.
1437   (unless (> (length filter-re) 0) (setq filter-re nil))
1438   ;; Indicate progress
1439   (message "Comparing '%s' and '%s' modulo '%s'" d1 d2 filter-re)
1440   (cond
1441    ;; D1 & D2 directories => recurse
1442    ((and (file-directory-p d1)
1443          (file-directory-p d2))
1444     (if (null ediff-recurse-to-subdirectories)
1445         (if (y-or-n-p "Compare subdirectories recursively? ")
1446             (setq ediff-recurse-to-subdirectories 'yes)
1447           (setq ediff-recurse-to-subdirectories 'no)))
1448     (if (eq ediff-recurse-to-subdirectories 'yes)
1449         (let* ((all-entries-1 (directory-files d1 t filter-re))
1450                (all-entries-2 (directory-files d2 t filter-re))
1451                (entries-1 (ediff-delete-all-matches "^\\.\\.?$" all-entries-1))
1452                (entries-2 (ediff-delete-all-matches "^\\.\\.?$" all-entries-2))
1453                )
1454
1455           (ediff-same-file-contents-lists entries-1 entries-2 filter-re)
1456           ))
1457     ) ; end of the directories case
1458    ;; D1 & D2 are both files => compare directly
1459    ((and (file-regular-p d1)
1460          (file-regular-p d2))
1461     (ediff-same-file-contents d1 d2))
1462    ;; Otherwise => false: unequal contents
1463    )
1464   )
1465
1466 ;; If lists have the same length and names of files are pairwise equal
1467 ;; (removing the directories) then compare contents pairwise.
1468 ;; True if all contents are the same; false otherwise
1469 (defun ediff-same-file-contents-lists (entries-1 entries-2 filter-re)
1470   ;; First, check only the names (works quickly and ensures a
1471   ;; precondition for subsequent code)
1472   (if (and (= (length entries-1) (length entries-2))
1473            (equal (mapcar 'file-name-nondirectory entries-1)
1474                   (mapcar 'file-name-nondirectory entries-2)))
1475       ;; With name equality established, compare the entries
1476       ;; through recursion.
1477       (let ((continue t))
1478         (while (and entries-1 continue)
1479           (if (ediff-same-contents
1480                (car entries-1) (car entries-2) filter-re)
1481               (setq entries-1 (cdr entries-1)
1482                     entries-2 (cdr entries-2))
1483             (setq continue nil))
1484           )
1485         ;; if reached the end then lists are equal
1486         (null entries-1))
1487     )
1488   )
1489
1490
1491 ;; ARG1 is a regexp, ARG2 is a list of full-filenames
1492 ;; Delete all entries that match the regexp
1493 (defun ediff-delete-all-matches (regex file-list-list)
1494   (let (result elt)
1495     (while file-list-list
1496       (setq elt (car file-list-list))
1497       (or (string-match regex (file-name-nondirectory elt))
1498           (setq result (cons elt result)))
1499       (setq file-list-list (cdr file-list-list)))
1500     (reverse result)))
1501
1502
1503 (defun ediff-set-actual-diff-options ()
1504   (if ediff-ignore-case
1505       (setq ediff-actual-diff-options
1506             (concat ediff-diff-options " " ediff-ignore-case-option)
1507             ediff-actual-diff3-options
1508             (concat ediff-diff3-options " " ediff-ignore-case-option3))
1509     (setq ediff-actual-diff-options ediff-diff-options
1510           ediff-actual-diff3-options ediff-diff3-options)
1511     )
1512   (setq-default ediff-actual-diff-options ediff-actual-diff-options
1513                 ediff-actual-diff3-options ediff-actual-diff3-options)
1514   )
1515
1516
1517 ;; Ignore case handling - some ideas from drew.adams@@oracle.com
1518 (defun ediff-toggle-ignore-case ()
1519   (interactive)
1520   (ediff-barf-if-not-control-buffer)
1521   (setq ediff-ignore-case (not ediff-ignore-case))
1522   (ediff-set-actual-diff-options)
1523   (if ediff-ignore-case
1524       (message "Ignoring regions that differ only in case")
1525     (message "Ignoring case differences turned OFF"))
1526   (cond (ediff-merge-job
1527          (message "Ignoring letter case is too dangerous in merge jobs"))
1528         ((and ediff-diff3-job (string= ediff-ignore-case-option3 ""))
1529          (message "Ignoring letter case is not supported by this diff3 program"))
1530         ((and (not ediff-3way-job) (string= ediff-ignore-case-option ""))
1531          (message "Ignoring letter case is not supported by this diff program"))
1532         (t
1533          (sit-for 1)
1534          (ediff-update-diffs)))
1535   )
1536
1537
1538 (provide 'ediff-diff)
1539
1540
1541 ;;; Local Variables:
1542 ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
1543 ;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
1544 ;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
1545 ;;; End:
1546
1547 ;;; arch-tag: a86d448e-58d7-4572-a1d9-fdedfa22f648
1548 ;;; ediff-diff.el ends here