lisp/ediff-ptch.el

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