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