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