lisp/ediff-ptch.el

   1 ;;; ediff-ptch.el --- Ediff's  patch support
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002,
   4 ;;   2003, 2004, 2005, 2006, 2007, 2008 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 (provide 'ediff-ptch)
  31
  32 (defgroup ediff-ptch nil
  33   "Ediff patch support."
  34   :tag "Patch"
  35   :prefix "ediff-"
  36   :group 'ediff)
  37
  38 ;; compiler pacifier
  39 (defvar ediff-window-A)
  40 (defvar ediff-window-B)
  41 (defvar ediff-window-C)
  42 (defvar ediff-use-last-dir)
  43 (defvar ediff-shell)
  44
  45 (eval-when-compile
  46   (require 'ediff-init)
  47   (if (not (featurep 'ediff-mult))
  48       (require 'ediff-mult))
  49   (require 'ediff)
  50   )
  51 ;; end pacifier
  52
  53 (require 'ediff-init)
  54
  55 (defcustom ediff-patch-program  "patch"
  56   "*Name of the program that applies patches.
  57 It is recommended to use GNU-compatible versions."
  58   :type 'string
  59   :group 'ediff-ptch)
  60 (defcustom ediff-patch-options "-f"
  61   "*Options to pass to ediff-patch-program.
  62
  63 Note: the `-b' option should be specified in `ediff-backup-specs'.
  64
  65 It is recommended to pass the `-f' option to the patch program, so it won't ask
  66 questions.  However, some implementations don't accept this option, in which
  67 case the default value for this variable should be changed."
  68   :type 'string
  69   :group 'ediff-ptch)
  70
  71 (defvar ediff-last-dir-patch nil
  72   "Last directory used by an Ediff command for file to patch.")
  73
  74 ;; the default backup extension
  75 (defconst ediff-default-backup-extension
  76   (if (memq system-type '(vax-vms axp-vms emx ms-dos))
  77       "_orig" ".orig"))
  78
  79
  80 (defcustom ediff-backup-extension ediff-default-backup-extension
  81   "Backup extension used by the patch program.
  82 See also `ediff-backup-specs'."
  83   :type 'string
  84   :group 'ediff-ptch)
  85
  86 (defun ediff-test-patch-utility ()
  87   (condition-case nil
  88       (cond ((eq 0 (call-process ediff-patch-program nil nil nil "-z." "-b"))
  89              ;; GNU `patch' v. >= 2.2
  90              'gnu)
  91             ((eq 0 (call-process ediff-patch-program nil nil nil "-b"))
  92              'posix)
  93             (t 'traditional))
  94     (file-error nil)))
  95
  96 (defcustom ediff-backup-specs
  97   (let ((type (ediff-test-patch-utility)))
  98     (cond ((eq type 'gnu)
  99            ;; GNU `patch' v. >= 2.2
 100            (format "-z%s -b" ediff-backup-extension))
 101           ((eq type 'posix)
 102            ;; POSIX `patch' -- ediff-backup-extension must be ".orig"
 103            (setq ediff-backup-extension ediff-default-backup-extension)
 104            "-b")
 105           (t
 106            ;; traditional `patch'
 107            (format "-b %s" ediff-backup-extension))))
 108   "*Backup directives to pass to the patch program.
 109 Ediff requires that the old version of the file \(before applying the patch\)
 110 be saved in a file named `the-patch-file.extension'.  Usually `extension' is
 111 `.orig', but this can be changed by the user and may depend on the system.
 112 Therefore, Ediff needs to know the backup extension used by the patch program.
 113
 114 Some versions of the patch program let you specify `-b backup-extension'.
 115 Other versions only permit `-b', which assumes the extension `.orig'
 116 \(in which case ediff-backup-extension MUST be also `.orig'\).  The latest
 117 versions of GNU patch require `-b -z backup-extension'.
 118
 119 Note that both `ediff-backup-extension' and `ediff-backup-specs'
 120 must be set properly.  If your patch program takes the option `-b',
 121 but not `-b extension', the variable `ediff-backup-extension' must
 122 still be set so Ediff will know which extension to use.
 123
 124 Ediff tries to guess the appropriate value for this variables.  It is believed
 125 to be working for `traditional' patch, all versions of GNU patch, and for POSIX
 126 patch.  So, don't change these variables, unless the default doesn't work."
 127   :type 'string
 128   :group 'ediff-ptch)
 129
 130
 131 (defcustom ediff-patch-default-directory nil
 132   "*Default directory to look for patches."
 133   :type '(choice (const nil) string)
 134   :group 'ediff-ptch)
 135
 136 ;; This context diff does not recognize spaces inside files, but removing ' '
 137 ;; from [^ \t] breaks normal patches for some reason
 138 (defcustom ediff-context-diff-label-regexp
 139   (concat "\\("         ; context diff 2-liner
 140           "^\\*\\*\\* +\\([^ \t]+\\)[^*]+[\t ]*\n--- +\\([^ \t]+\\)"
 141           "\\|"         ; GNU unified format diff 2-liner
 142           "^--- +\\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ +\\([^ \t]+\\)"
 143           "\\)")
 144   "*Regexp matching filename 2-liners at the start of each context diff.
 145 You probably don't want to change that, unless you are using an obscure patch
 146 program."
 147   :type 'regexp
 148   :group 'ediff-ptch)
 149
 150 ;; The buffer of the patch file.  Local to control buffer.
 151 (ediff-defvar-local ediff-patchbufer nil "")
 152
 153 ;; The buffer where patch displays its diagnostics.
 154 (ediff-defvar-local ediff-patch-diagnostics nil "")
 155
 156 ;; Map of patch buffer.  Has the form:
 157 ;;    ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
 158 ;; where filenames are files to which patch would have applied the patch;
 159 ;; marker1 delimits the beginning of the corresponding patch and marker2 does
 160 ;; it for the end.
 161 (ediff-defvar-local ediff-patch-map nil "")
 162
 163 ;; strip prefix from filename
 164 ;; returns /dev/null, if can't strip prefix
 165 (defsubst ediff-file-name-sans-prefix (filename prefix)
 166   (if prefix
 167       (save-match-data
 168         (if (string-match (concat "^" (if (stringp prefix)
 169                                           (regexp-quote prefix)
 170                                         ""))
 171                           filename)
 172             (substring filename (match-end 0))
 173           (concat "/null/" filename)))
 174     filename)
 175   )
 176
 177
 178
 179 ;; no longer used
 180 ;; return the number of matches of regexp in buf starting from the beginning
 181 (defun ediff-count-matches (regexp buf)
 182   (ediff-with-current-buffer buf
 183     (let ((count 0) opoint)
 184       (save-excursion
 185         (goto-char (point-min))
 186         (while (and (not (eobp))
 187                     (progn (setq opoint (point))
 188                            (re-search-forward regexp nil t)))
 189           (if (= opoint (point))
 190               (forward-char 1)
 191             (setq count (1+ count)))))
 192       count)))
 193
 194 ;; Scan BUF (which is supposed to contain a patch) and make a list of the form
 195 ;;    ((nil nil filename-spec1 marker1 marker2)
 196 ;;          (nil nil filename-spec2 marker1 marker2) ...)
 197 ;; where filename-spec[12] are files to which the `patch' program would
 198 ;; have applied the patch.
 199 ;; nin, nil are placeholders. See ediff-make-new-meta-list-element in
 200 ;;    ediff-meta.el for the explanations.
 201 ;; In the beginning we don't know exactly which files need to be patched.
 202 ;; We usually come up with two candidates and ediff-file-name-sans-prefix
 203 ;;    resolves this later.
 204 ;;
 205 ;; The marker `marker1' delimits the beginning of the corresponding patch and
 206 ;;    `marker2' does it for the end.
 207 ;; The result of ediff-map-patch-buffer is a list, which is then assigned
 208 ;; to ediff-patch-map.
 209 ;; The function returns the number of elements in the list ediff-patch-map
 210 (defun ediff-map-patch-buffer (buf)
 211   (ediff-with-current-buffer buf
 212     (let ((count 0)
 213           (mark1 (move-marker (make-marker) (point-min)))
 214           (mark1-end (point-min))
 215           (possible-file-names '("/dev/null" . "/dev/null"))
 216           mark2-end mark2 filenames
 217           beg1 beg2 end1 end2
 218           patch-map opoint)
 219       (save-excursion
 220         (goto-char (point-min))
 221         (setq opoint (point))
 222         (while (and (not (eobp))
 223                     (re-search-forward ediff-context-diff-label-regexp nil t))
 224           (if (= opoint (point))
 225               (forward-char 1) ; ensure progress towards the end
 226             (setq mark2 (move-marker (make-marker) (match-beginning 0))
 227                   mark2-end (match-end 0)
 228                   beg1 (or (match-beginning 2) (match-beginning 4))
 229                   end1 (or (match-end 2) (match-end 4))
 230                   beg2 (or (match-beginning 3) (match-beginning 5))
 231                   end2 (or (match-end 3) (match-end 5)))
 232             ;; possible-file-names is holding the new file names until we
 233             ;; insert the old file name in the patch map
 234             ;; It is a pair
 235             ;;     (filename-from-1st-header-line . filename-from-2nd-line)
 236             (setq possible-file-names
 237                   (cons (if (and beg1 end1)
 238                             (buffer-substring beg1 end1)
 239                           "/dev/null")
 240                         (if (and beg2 end2)
 241                             (buffer-substring beg2 end2)
 242                           "/dev/null")))
 243             ;; check for any `Index:' or `Prereq:' lines, but don't use them
 244             (if (re-search-backward "^Index:" mark1-end 'noerror)
 245                 (move-marker mark2 (match-beginning 0)))
 246             (if (re-search-backward "^Prereq:" mark1-end 'noerror)
 247                 (move-marker mark2 (match-beginning 0)))
 248
 249             (goto-char mark2-end)
 250
 251             (if filenames
 252                 (setq patch-map
 253                       (cons (ediff-make-new-meta-list-element
 254                              filenames mark1 mark2)
 255                             patch-map)))
 256             (setq mark1 mark2
 257                   mark1-end mark2-end
 258                   filenames possible-file-names))
 259           (setq opoint (point)
 260                 count (1+ count))))
 261       (setq mark2 (point-max-marker)
 262             patch-map (cons (ediff-make-new-meta-list-element
 263                              possible-file-names mark1 mark2)
 264                             patch-map))
 265       (setq ediff-patch-map (nreverse patch-map))
 266       count)))
 267
 268 ;; Fix up the file names in the list using the argument FILENAME
 269 ;; Algorithm: find the files' directories in the patch and, if a directory is
 270 ;; absolute, cut it out from the corresponding file name in the patch.
 271 ;; Relative directories are not cut out.
 272 ;; Prepend the directory of FILENAME to each resulting file (which came
 273 ;; originally from the patch).
 274 ;; In addition, the first file in the patch document is replaced by FILENAME.
 275 ;; Each file is actually a pair of files found in the context diff header
 276 ;; In the end, for each pair, we ask the user which file to patch.
 277 ;; Note: Ediff doesn't recognize multi-file patches that are separated
 278 ;; with the `Index:' line.  It treats them as a single-file patch.
 279 ;;
 280 ;; Executes inside the patch buffer
 281 (defun ediff-fixup-patch-map (filename)
 282   (setq filename (expand-file-name filename))
 283   (let ((actual-dir (if (file-directory-p filename)
 284                         ;; directory part of filename
 285                         (file-name-as-directory filename)
 286                       (file-name-directory filename)))
 287         ;; In case 2 files are possible patch targets, the user will be offered
 288         ;; to choose file1 or file2.  In a multifile patch, if the user chooses
 289         ;; 1 or 2, this choice is preserved to decide future alternatives.
 290         chosen-alternative
 291         )
 292
 293     ;; chop off base-dirs
 294     (mapc (lambda (session-info)
 295             (let* ((proposed-file-names
 296                     ;; Filename-spec is objA; it is represented as
 297                     ;; (file1 . file2). Get it using ediff-get-session-objA.
 298                     (ediff-get-session-objA-name session-info))
 299                    ;; base-dir1 is  the dir part of the 1st file in the patch
 300                    (base-dir1
 301                     (or (file-name-directory (car proposed-file-names))
 302                         ""))
 303                    ;; directory part of the 2nd file in the patch
 304                    (base-dir2
 305                     (or (file-name-directory (cdr proposed-file-names))
 306                         ""))
 307                    )
 308               ;; If both base-dir1 and base-dir2 are relative and exist,
 309               ;; assume that
 310               ;; these dirs lead to the actual files starting at the present
 311               ;; directory. So, we don't strip these relative dirs from the
 312               ;; file names. This is a heuristic intended to improve guessing
 313               (let ((default-directory (file-name-directory filename)))
 314                 (unless (or (file-name-absolute-p base-dir1)
 315                             (file-name-absolute-p base-dir2)
 316                             (not (file-exists-p base-dir1))
 317                             (not (file-exists-p base-dir2)))
 318                   (setq base-dir1 ""
 319                         base-dir2 "")))
 320               (or (string= (car proposed-file-names) "/dev/null")
 321                   (setcar proposed-file-names
 322                           (ediff-file-name-sans-prefix
 323                            (car proposed-file-names) base-dir1)))
 324               (or (string=
 325                    (cdr proposed-file-names) "/dev/null")
 326                   (setcdr proposed-file-names
 327                           (ediff-file-name-sans-prefix
 328                            (cdr proposed-file-names) base-dir2)))
 329               ))
 330           ediff-patch-map)
 331
 332     ;; take the given file name into account
 333     (or (file-directory-p filename)
 334         (string= "/dev/null" filename)
 335         (setcar (ediff-get-session-objA (car ediff-patch-map))
 336                 (cons (file-name-nondirectory filename)
 337                       (file-name-nondirectory filename))))
 338
 339     ;; prepend actual-dir
 340     (mapc (lambda (session-info)
 341             (let ((proposed-file-names
 342                    (ediff-get-session-objA-name session-info)))
 343               (if (and (string-match "^/null/" (car proposed-file-names))
 344                        (string-match "^/null/" (cdr proposed-file-names)))
 345                   ;; couldn't intuit the file name to patch, so
 346                   ;; something is amiss
 347                   (progn
 348                     (with-output-to-temp-buffer ediff-msg-buffer
 349                       (ediff-with-current-buffer standard-output
 350                         (fundamental-mode))
 351                       (princ
 352                        (format "
 353 The patch file contains a context diff for
 354         %s
 355         %s
 356 However, Ediff cannot infer the name of the actual file
 357 to be patched on your system.  If you know the correct file name,
 358 please enter it now.
 359
 360 If you don't know and still would like to apply patches to
 361 other files, enter /dev/null
 362 "
 363                                (substring (car proposed-file-names) 6)
 364                                (substring (cdr proposed-file-names) 6))))
 365                     (let ((directory t)
 366                           user-file)
 367                       (while directory
 368                         (setq user-file
 369                               (read-file-name
 370                                "Please enter file name: "
 371                                actual-dir actual-dir t))
 372                         (if (not (file-directory-p user-file))
 373                             (setq directory nil)
 374                           (setq directory t)
 375                           (beep)
 376                           (message "%s is a directory" user-file)
 377                           (sit-for 2)))
 378                       (setcar (ediff-get-session-objA session-info)
 379                               (cons user-file user-file))))
 380                 (setcar proposed-file-names
 381                         (expand-file-name
 382                          (concat actual-dir (car proposed-file-names))))
 383                 (setcdr proposed-file-names
 384                         (expand-file-name
 385                          (concat actual-dir (cdr proposed-file-names)))))
 386               ))
 387           ediff-patch-map)
 388     ;; Check for the existing files in each pair and discard the nonexisting
 389     ;; ones. If both exist, ask the user.
 390     (mapcar (lambda (session-info)
 391               (let* ((file1 (car (ediff-get-session-objA-name session-info)))
 392                      (file2 (cdr (ediff-get-session-objA-name session-info)))
 393                      (session-file-object
 394                       (ediff-get-session-objA session-info))
 395                      (f1-exists (file-exists-p file1))
 396                      (f2-exists (file-exists-p file2)))
 397                 (cond
 398                  ((and
 399                    ;; The patch program prefers the shortest file as the patch
 400                    ;; target. However, this is a questionable heuristic. In an
 401                    ;; interactive program, like ediff, we can offer the user a
 402                    ;; choice.
 403                    ;; (< (length file2) (length file1))
 404                    (not f1-exists)
 405                    f2-exists)
 406                   ;; replace file-pair with the winning file2
 407                   (setcar session-file-object file2))
 408                  ((and
 409                    ;; (< (length file1) (length file2))
 410                    (not f2-exists)
 411                    f1-exists)
 412                   ;; replace file-pair with the winning file1
 413                   (setcar session-file-object file1))
 414                  ((and f1-exists f2-exists
 415                        (string= file1 file2))
 416                   (setcar session-file-object file1))
 417                  ((and f1-exists f2-exists (eq chosen-alternative 1))
 418                   (setcar session-file-object file1))
 419                  ((and f1-exists f2-exists (eq chosen-alternative 2))
 420                   (setcar session-file-object file2))
 421                  ((and f1-exists f2-exists)
 422                   (with-output-to-temp-buffer ediff-msg-buffer
 423                     (ediff-with-current-buffer standard-output
 424                       (fundamental-mode))
 425                     (princ (format "
 426 Ediff has inferred that
 427         %s
 428         %s
 429 are two possible targets for applying the patch.
 430 Both files seem to be plausible alternatives.
 431
 432 Please advice:
 433     Type `y' to use %s as the target;
 434     Type `n' to use %s as the target.
 435 "
 436                                    file1 file2 file1 file2)))
 437                   (setcar session-file-object
 438                           (if (y-or-n-p (format "Use %s ? " file1))
 439                               (progn
 440                                 (setq chosen-alternative 1)
 441                                 file1)
 442                             (setq chosen-alternative 2)
 443                             file2))
 444                   )
 445                  (f2-exists (setcar session-file-object file2))
 446                  (f1-exists (setcar session-file-object file1))
 447                  (t
 448                   (with-output-to-temp-buffer ediff-msg-buffer
 449                     (ediff-with-current-buffer standard-output
 450                       (fundamental-mode))
 451                     (princ "\nEdiff has inferred that")
 452                     (if (string= file1 file2)
 453                         (princ (format "
 454         %s
 455 is assumed to be the target for this patch.  However, this file does not exist."
 456                                        file1))
 457                       (princ (format "
 458         %s
 459         %s
 460 are two possible targets for this patch.  However, these files do not exist."
 461                                      file1 file2)))
 462                     (princ "
 463 \nPlease enter an alternative patch target ...\n"))
 464                   (let ((directory t)
 465                         target)
 466                     (while directory
 467                       (setq target (read-file-name
 468                                     "Please enter a patch target: "
 469                                     actual-dir actual-dir t))
 470                       (if (not (file-directory-p target))
 471                           (setq directory nil)
 472                         (beep)
 473                         (message "%s is a directory" target)
 474                         (sit-for 2)))
 475                     (setcar session-file-object target))))))
 476             ediff-patch-map)
 477     ))
 478
 479 (defun ediff-show-patch-diagnostics ()
 480   (interactive)
 481   (cond ((window-live-p ediff-window-A)
 482          (set-window-buffer ediff-window-A ediff-patch-diagnostics))
 483         ((window-live-p ediff-window-B)
 484          (set-window-buffer ediff-window-B ediff-patch-diagnostics))
 485         (t (display-buffer ediff-patch-diagnostics 'not-this-window))))
 486
 487 ;; prompt for file, get the buffer
 488 (defun ediff-prompt-for-patch-file ()
 489   (let ((dir (cond (ediff-use-last-dir ediff-last-dir-patch)
 490                    (ediff-patch-default-directory) ; try patch default dir
 491                    (t default-directory)))
 492         (coding-system-for-read ediff-coding-system-for-read)
 493         patch-file-name)
 494     (setq patch-file-name
 495           (read-file-name
 496            (format "Patch is in file%s: "
 497                    (cond ((and buffer-file-name
 498                                (equal (expand-file-name dir)
 499                                       (file-name-directory buffer-file-name)))
 500                           (concat
 501                            " (default "
 502                            (file-name-nondirectory buffer-file-name)
 503                            ")"))
 504                          (t "")))
 505            dir buffer-file-name 'must-match))
 506     (if (file-directory-p patch-file-name)
 507         (error "Patch file cannot be a directory: %s" patch-file-name)
 508       (find-file-noselect patch-file-name))
 509     ))
 510
 511
 512 ;; Try current buffer, then the other window's buffer. Else, give up.
 513 (defun ediff-prompt-for-patch-buffer ()
 514   (get-buffer
 515    (read-buffer
 516     "Buffer that holds the patch: "
 517     (cond ((save-excursion
 518              (goto-char (point-min))
 519              (re-search-forward ediff-context-diff-label-regexp nil t))
 520            (current-buffer))
 521           ((save-window-excursion
 522              (other-window 1)
 523              (save-excursion
 524                (goto-char (point-min))
 525                (and (re-search-forward ediff-context-diff-label-regexp nil t)
 526                     (current-buffer)))))
 527           ((save-window-excursion
 528              (other-window -1)
 529              (save-excursion
 530                (goto-char (point-min))
 531                (and (re-search-forward ediff-context-diff-label-regexp nil t)
 532                     (current-buffer)))))
 533           (t (ediff-other-buffer (current-buffer))))
 534     'must-match)))
 535
 536
 537 (defun ediff-get-patch-buffer (&optional arg patch-buf)
 538   "Obtain patch buffer.  If patch is already in a buffer---use it.
 539 Else, read patch file into a new buffer. If patch buffer is passed as an
 540 optional argument, then use it."
 541   (let ((last-nonmenu-event t) ; Emacs: don't use dialog box
 542         last-command-event)    ; XEmacs: don't use dialog box
 543
 544     (cond ((ediff-buffer-live-p patch-buf))
 545           ;; even prefix arg: patch in buffer
 546           ((and (integerp arg) (eq 0 (mod arg 2)))
 547            (setq patch-buf (ediff-prompt-for-patch-buffer)))
 548           ;; odd prefix arg: get patch from a file
 549           ((and (integerp arg) (eq 1 (mod arg 2)))
 550            (setq patch-buf (ediff-prompt-for-patch-file)))
 551           (t (setq patch-buf
 552                    (if (y-or-n-p "Is the patch already in a buffer? ")
 553                        (ediff-prompt-for-patch-buffer)
 554                      (ediff-prompt-for-patch-file)))))
 555
 556     (ediff-with-current-buffer patch-buf
 557       (goto-char (point-min))
 558       (or (ediff-get-visible-buffer-window patch-buf)
 559           (progn
 560             (pop-to-buffer patch-buf 'other-window)
 561             (select-window (previous-window)))))
 562     (ediff-map-patch-buffer patch-buf)
 563     patch-buf))
 564
 565 ;; Dispatch the right patch file function: regular or meta-level,
 566 ;; depending on how many patches are in the patch file.
 567 ;; At present, there is no support for meta-level patches.
 568 ;; Should return either the ctl buffer or the meta-buffer
 569 (defun ediff-dispatch-file-patching-job (patch-buf filename
 570                                                    &optional startup-hooks)
 571   (ediff-with-current-buffer patch-buf
 572     ;; relativize names in the patch with respect to source-file
 573     (ediff-fixup-patch-map filename)
 574     (if (< (length ediff-patch-map) 2)
 575         (ediff-patch-file-internal
 576          patch-buf
 577          (if (and ediff-patch-map
 578                   (not (string-match
 579                         "^/dev/null"
 580                         ;; this is the file to patch
 581                         (ediff-get-session-objA-name (car ediff-patch-map))))
 582                   (> (length
 583                       (ediff-get-session-objA-name (car ediff-patch-map)))
 584                      1))
 585              (ediff-get-session-objA-name (car ediff-patch-map))
 586            filename)
 587          startup-hooks)
 588       (ediff-multi-patch-internal patch-buf startup-hooks))
 589     ))
 590
 591
 592 ;; When patching a buffer, never change the orig file.  Instead, create a new
 593 ;; buffer, ***_patched, even if the buff visits a file.
 594 ;; Users who want to actually patch the buffer should use
 595 ;; ediff-patch-file, not ediff-patch-buffer.
 596 (defun ediff-patch-buffer-internal (patch-buf
 597                                     buf-to-patch-name
 598                                     &optional startup-hooks)
 599   (let* ((buf-to-patch (get-buffer buf-to-patch-name))
 600          (visited-file (if buf-to-patch (buffer-file-name  buf-to-patch)))
 601          (buf-mod-status (buffer-modified-p buf-to-patch))
 602          (multifile-patch-p (> (length (ediff-with-current-buffer patch-buf
 603                                          ediff-patch-map)) 1))
 604          default-dir file-name ctl-buf)
 605     (if multifile-patch-p
 606         (error
 607          "To apply multi-file patches, please use `ediff-patch-file'"))
 608
 609     ;; create a temp file to patch
 610     (ediff-with-current-buffer buf-to-patch
 611       (setq default-dir default-directory)
 612       (setq file-name (ediff-make-temp-file buf-to-patch))
 613       ;; temporarily switch visited file name, if any
 614       (set-visited-file-name file-name)
 615       ;; don't create auto-save file, if buff was visiting a file
 616       (or visited-file
 617           (setq buffer-auto-save-file-name nil))
 618       ;; don't confuse the user with a new bufname
 619       (rename-buffer buf-to-patch-name)
 620       (set-buffer-modified-p nil)
 621       (set-visited-file-modtime) ; sync buffer and temp file
 622       (setq default-directory default-dir)
 623       )
 624
 625     ;; dispatch a patch function
 626     (setq ctl-buf (ediff-dispatch-file-patching-job
 627                    patch-buf file-name startup-hooks))
 628
 629     (ediff-with-current-buffer ctl-buf
 630       (delete-file (buffer-file-name ediff-buffer-A))
 631       (delete-file (buffer-file-name ediff-buffer-B))
 632       (ediff-with-current-buffer ediff-buffer-A
 633         (if default-dir (setq default-directory default-dir))
 634         (set-visited-file-name visited-file) ; visited-file might be nil
 635         (rename-buffer buf-to-patch-name)
 636         (set-buffer-modified-p buf-mod-status))
 637       (ediff-with-current-buffer ediff-buffer-B
 638         (setq buffer-auto-save-file-name nil) ; don't create auto-save file
 639         (if default-dir (setq default-directory default-dir))
 640         (set-visited-file-name nil)
 641         (rename-buffer (ediff-unique-buffer-name
 642                         (concat buf-to-patch-name "_patched") ""))
 643         (set-buffer-modified-p t)))
 644     ))
 645
 646
 647 ;; Traditional patch has weird return codes.
 648 ;; GNU and Posix return 1 if some hanks failed and 2 in case of trouble.
 649 ;; 0 is a good code in all cases.
 650 ;; We'll do the concervative thing.
 651 (defun ediff-patch-return-code-ok (code)
 652   (eq code 0))
 653 ;;;  (if (eq (ediff-test-patch-utility) 'traditional)
 654 ;;;      (eq code 0)
 655 ;;;    (not (eq code 2))))
 656
 657 (defun ediff-patch-file-internal (patch-buf source-filename
 658                                             &optional startup-hooks)
 659   (setq source-filename (expand-file-name source-filename))
 660
 661   (let* ((shell-file-name ediff-shell)
 662          (patch-diagnostics (get-buffer-create "*ediff patch diagnostics*"))
 663          ;; ediff-find-file may use a temp file to do the patch
 664          ;; so, we save source-filename and true-source-filename as a var
 665          ;; that initially is source-filename but may be changed to a temp
 666          ;; file for the purpose of patching.
 667          (true-source-filename source-filename)
 668          (target-filename source-filename)
 669          ;; this ensures that the patch process gets patch buffer in the
 670          ;; encoding that Emacs thinks is right for that type of text
 671          (coding-system-for-write
 672           (if (boundp 'buffer-file-coding-system) buffer-file-coding-system))
 673          target-buf buf-to-patch file-name-magic-p
 674          patch-return-code ctl-buf backup-style aux-wind)
 675
 676     (if (string-match "V" ediff-patch-options)
 677         (error
 678          "Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
 679
 680     ;; Make a temp file, if source-filename has a magic file handler (or if
 681     ;; it is handled via auto-mode-alist and similar magic).
 682     ;; Check if there is a buffer visiting source-filename and if they are in
 683     ;; sync; arrange for the deletion of temp file.
 684     (ediff-find-file 'true-source-filename 'buf-to-patch
 685                      'ediff-last-dir-patch 'startup-hooks)
 686
 687     ;; Check if source file name has triggered black magic, such as file name
 688     ;; handlers or auto mode alist, and make a note of it.
 689     ;; true-source-filename should be either the original name or a
 690     ;; temporary file where we put the after-product of the file handler.
 691     (setq file-name-magic-p (not (equal (file-truename true-source-filename)
 692                                         (file-truename source-filename))))
 693
 694     ;; Checkout orig file, if necessary, so that the patched file
 695     ;; could be checked back in.
 696     (ediff-maybe-checkout buf-to-patch)
 697
 698     (ediff-with-current-buffer patch-diagnostics
 699       (insert-buffer-substring patch-buf)
 700       (message "Applying patch ... ")
 701       ;; fix environment for gnu patch, so it won't make numbered extensions
 702       (setq backup-style (getenv "VERSION_CONTROL"))
 703       (setenv "VERSION_CONTROL" nil)
 704       (setq patch-return-code
 705             (call-process-region
 706              (point-min) (point-max)
 707              shell-file-name
 708              t   ; delete region (which contains the patch
 709              t   ; insert output (patch diagnostics) in current buffer
 710              nil ; don't redisplay
 711              shell-command-switch   ; usually -c
 712              (format "%s %s %s %s"
 713                      ediff-patch-program
 714                      ediff-patch-options
 715                      ediff-backup-specs
 716                      (expand-file-name true-source-filename))
 717              ))
 718
 719       ;; restore environment for gnu patch
 720       (setenv "VERSION_CONTROL" backup-style))
 721
 722     (message "Applying patch ... done")
 723     (message "")
 724
 725     (switch-to-buffer patch-diagnostics)
 726     (sit-for 0) ; synchronize - let the user see diagnostics
 727
 728     (or (and (ediff-patch-return-code-ok patch-return-code)
 729              (file-exists-p
 730               (concat true-source-filename ediff-backup-extension)))
 731         (progn
 732           (with-output-to-temp-buffer ediff-msg-buffer
 733             (ediff-with-current-buffer standard-output
 734               (fundamental-mode))
 735             (princ (format
 736                     "Patch program has failed due to a bad patch file,
 737 it couldn't apply all hunks, OR
 738 it couldn't create the backup for the file being patched.
 739
 740 The former could be caused by a corrupt patch file or because the %S
 741 program doesn't understand the format of the patch file in use.
 742
 743 The second problem might be due to an incompatibility among these settings:
 744     ediff-patch-program    = %S             ediff-patch-options    = %S
 745     ediff-backup-extension = %S             ediff-backup-specs     = %S
 746
 747 See Ediff on-line manual for more details on these variables.
 748 In particular, check the documentation for `ediff-backup-specs'.
 749
 750 In any of the above cases, Ediff doesn't compare files automatically.
 751 However, if the patch was applied partially and the backup file was created,
 752 you can still examine the changes via M-x ediff-files"
 753                     ediff-patch-program
 754                     ediff-patch-program
 755                     ediff-patch-options
 756                     ediff-backup-extension
 757                     ediff-backup-specs
 758                     )))
 759           (beep 1)
 760           (if (setq aux-wind (get-buffer-window ediff-msg-buffer))
 761               (progn
 762                 (select-window aux-wind)
 763                 (goto-char (point-max))))
 764           (switch-to-buffer-other-window patch-diagnostics)
 765           (error "Patch appears to have failed")))
 766
 767     ;; If black magic is involved, apply patch to a temp copy of the
 768     ;; file.  Otherwise, apply patch to the orig copy.  If patch is applied
 769     ;; to temp copy, we name the result old-name_patched for local files
 770     ;; and temp-copy_patched for remote files.  The orig file name isn't
 771     ;; changed, and the temp copy of the original is later deleted.
 772     ;; Without magic, the original file is renamed (usually into
 773     ;; old-name_orig) and the result of patching will have the same name as
 774     ;; the original.
 775     (if (not file-name-magic-p)
 776         (ediff-with-current-buffer buf-to-patch
 777           (set-visited-file-name
 778            (concat source-filename ediff-backup-extension))
 779           (set-buffer-modified-p nil))
 780
 781       ;; Black magic in effect.
 782       ;; If orig file was remote, put the patched file in the temp directory.
 783       ;; If orig file is local, put the patched file in the directory of
 784       ;; the orig file.
 785       (setq target-filename
 786             (concat
 787              (if (ediff-file-remote-p (file-truename source-filename))
 788                  true-source-filename
 789                source-filename)
 790              "_patched"))
 791
 792       (rename-file true-source-filename target-filename t)
 793
 794       ;; arrange that the temp copy of orig will be deleted
 795       (rename-file (concat true-source-filename ediff-backup-extension)
 796                    true-source-filename t))
 797
 798     ;; make orig buffer read-only
 799     (setq startup-hooks
 800           (cons 'ediff-set-read-only-in-buf-A startup-hooks))
 801
 802     ;; set up a buf for the patched file
 803     (setq target-buf (find-file-noselect target-filename))
 804
 805     (setq ctl-buf
 806           (ediff-buffers-internal
 807            buf-to-patch target-buf nil
 808            startup-hooks 'epatch))
 809     (ediff-with-current-buffer ctl-buf
 810       (setq ediff-patchbufer patch-buf
 811             ediff-patch-diagnostics patch-diagnostics))
 812
 813     (bury-buffer patch-diagnostics)
 814     (message "Type `P', if you need to see patch diagnostics")
 815     ctl-buf))
 816
 817 (defun ediff-multi-patch-internal (patch-buf &optional startup-hooks)
 818   (let (meta-buf)
 819     (setq startup-hooks
 820           ;; this sets various vars in the meta buffer inside
 821           ;; ediff-prepare-meta-buffer
 822           (cons `(lambda ()
 823                    ;; tell what to do if the user clicks on a session record
 824                    (setq ediff-session-action-function
 825                          'ediff-patch-file-form-meta
 826                          ediff-meta-patchbufer patch-buf) )
 827                 startup-hooks))
 828     (setq meta-buf (ediff-prepare-meta-buffer
 829                     'ediff-filegroup-action
 830                     (ediff-with-current-buffer patch-buf
 831                       (cons (ediff-make-new-meta-list-header
 832                              nil                     ; regexp
 833                              (format "%S" patch-buf) ; obj A
 834                              nil nil                 ; objects B,C
 835                              nil                     ; merge-auto-store-dir
 836                              nil                     ; comparison-func
 837                              )
 838                             ediff-patch-map))
 839                     "*Ediff Session Group Panel"
 840                     'ediff-redraw-directory-group-buffer
 841                     'ediff-multifile-patch
 842                     startup-hooks))
 843     (ediff-show-meta-buffer meta-buf)
 844     ))
 845
 846
 847
 848
 849 ;;; Local Variables:
 850 ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
 851 ;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
 852 ;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
 853 ;;; End:
 854
 855 ;; arch-tag: 2fe2161e-e116-469b-90fa-5cbb44c1bd1b
 856 ;;; ediff-ptch.el ends here