1;;; emerge.el --- merge diffs under Emacs control 2 3;;; The author has placed this file in the public domain. 4 5;; This file is part of GNU Emacs. 6 7;; Author: Dale R. Worley <worley@world.std.com> 8;; Version: 5fsf 9;; Keywords: unix, tools 10 11;; This software was created by Dale R. Worley and is 12;; distributed free of charge. It is placed in the public domain and 13;; permission is granted to anyone to use, duplicate, modify and redistribute 14;; it provided that this notice is attached. 15 16;; Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND 17;; with respect to this software. The entire risk as to the quality and 18;; performance of this software is with the user. IN NO EVENT WILL DALE 19;; R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE 20;; USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM 21;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL 22;; DAMAGES. 23 24;;; Commentary: 25 26;;; Code: 27 28;;;###autoload 29(defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge")) 30;;;###autoload (fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu)) 31 32;;;###autoload (define-key menu-bar-emerge-menu [emerge-merge-directories] 33;;;###autoload '("Merge Directories..." . emerge-merge-directories)) 34;;;###autoload (define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor] 35;;;###autoload '("Revisions with Ancestor..." . emerge-revisions-with-ancestor)) 36;;;###autoload (define-key menu-bar-emerge-menu [emerge-revisions] 37;;;###autoload '("Revisions..." . emerge-revisions)) 38;;;###autoload (define-key menu-bar-emerge-menu [emerge-files-with-ancestor] 39;;;###autoload '("Files with Ancestor..." . emerge-files-with-ancestor)) 40;;;###autoload (define-key menu-bar-emerge-menu [emerge-files] 41;;;###autoload '("Files..." . emerge-files)) 42;;;###autoload (define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor] 43;;;###autoload '("Buffers with Ancestor..." . emerge-buffers-with-ancestor)) 44;;;###autoload (define-key menu-bar-emerge-menu [emerge-buffers] 45;;;###autoload '("Buffers..." . emerge-buffers)) 46 47;; There aren't really global variables, just dynamic bindings 48(defvar A-begin) 49(defvar A-end) 50(defvar B-begin) 51(defvar B-end) 52(defvar diff) 53(defvar diff-vector) 54(defvar merge-begin) 55(defvar merge-end) 56(defvar template) 57(defvar valid-diff) 58 59;;; Macros 60 61(defmacro emerge-eval-in-buffer (buffer &rest forms) 62 "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. 63Differs from `save-excursion' in that it doesn't save the point and mark." 64 `(let ((StartBuffer (current-buffer))) 65 (unwind-protect 66 (progn 67 (set-buffer ,buffer) 68 ,@forms) 69 (set-buffer StartBuffer)))) 70 71(defmacro emerge-defvar-local (var value doc) 72 "Defines SYMBOL as an advertised variable. 73Performs a defvar, then executes `make-variable-buffer-local' on 74the variable. Also sets the `preserved' property, so that 75`kill-all-local-variables' (called by major-mode setting commands) 76won't destroy Emerge control variables." 77 `(progn 78 (defvar ,var ,value ,doc) 79 (make-variable-buffer-local ',var) 80 (put ',var 'preserved t))) 81 82;; Add entries to minor-mode-alist so that emerge modes show correctly 83(defvar emerge-minor-modes-list 84 '((emerge-mode " Emerge") 85 (emerge-fast-mode " F") 86 (emerge-edit-mode " E") 87 (emerge-auto-advance " A") 88 (emerge-skip-prefers " S"))) 89(if (not (assq 'emerge-mode minor-mode-alist)) 90 (setq minor-mode-alist (append emerge-minor-modes-list 91 minor-mode-alist))) 92 93;; We need to define this function so describe-mode can describe Emerge mode. 94(defun emerge-mode () 95 "Emerge mode is used by the Emerge file-merging package. 96It is entered only through one of the functions: 97 `emerge-files' 98 `emerge-files-with-ancestor' 99 `emerge-buffers' 100 `emerge-buffers-with-ancestor' 101 `emerge-files-command' 102 `emerge-files-with-ancestor-command' 103 `emerge-files-remote' 104 `emerge-files-with-ancestor-remote' 105 106Commands: 107\\{emerge-basic-keymap} 108Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode, 109but can be invoked directly in `fast' mode.") 110 111(defvar emerge-version "5fsf" 112 "The version of Emerge.") 113 114(defun emerge-version () 115 "Return string describing the version of Emerge. 116When called interactively, displays the version." 117 (interactive) 118 (if (interactive-p) 119 (message "Emerge version %s" (emerge-version)) 120 emerge-version)) 121 122;;; Emerge configuration variables 123 124(defgroup emerge nil 125 "Merge diffs under Emacs control." 126 :group 'tools) 127 128;; Commands that produce difference files 129;; All that can be configured is the name of the programs to execute 130;; (emerge-diff-program and emerge-diff3-program) and the options 131;; to be provided (emerge-diff-options). The order in which the file names 132;; are given is fixed. 133;; The file names are always expanded (see expand-file-name) before being 134;; passed to diff, thus they need not be invoked under a shell that 135;; understands `~'. 136;; The code which processes the diff/diff3 output depends on all the 137;; finicky details of their output, including the somewhat strange 138;; way they number lines of a file. 139(defcustom emerge-diff-program "diff" 140 "*Name of the program which compares two files." 141 :type 'string 142 :group 'emerge) 143(defcustom emerge-diff3-program "diff3" 144 "*Name of the program which compares three files. 145Its arguments are the ancestor file and the two variant files." 146 :type 'string 147 :group 'emerge) 148(defcustom emerge-diff-options "" 149 "*Options to pass to `emerge-diff-program' and `emerge-diff3-program'." 150 :type 'string 151 :group 'emerge) 152(defcustom emerge-match-diff-line 153 (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)")) 154 (concat "^" x "\\([acd]\\)" x "$")) 155 "*Pattern to match lines produced by diff that describe differences. 156This is as opposed to lines from the source files." 157 :type 'regexp 158 :group 'emerge) 159(defcustom emerge-diff-ok-lines-regexp 160 "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)" 161 "*Regexp that matches normal output lines from `emerge-diff-program'. 162Lines that do not match are assumed to be error messages." 163 :type 'regexp 164 :group 'emerge) 165(defcustom emerge-diff3-ok-lines-regexp 166 "^\\([1-3]:\\|====\\| \\)" 167 "*Regexp that matches normal output lines from `emerge-diff3-program'. 168Lines that do not match are assumed to be error messages." 169 :type 'regexp 170 :group 'emerge) 171 172(defcustom emerge-rcs-ci-program "ci" 173 "*Name of the program that checks in RCS revisions." 174 :type 'string 175 :group 'emerge) 176(defcustom emerge-rcs-co-program "co" 177 "*Name of the program that checks out RCS revisions." 178 :type 'string 179 :group 'emerge) 180 181(defcustom emerge-process-local-variables nil 182 "*Non-nil if Emerge should process local-variables lists in merge buffers. 183\(You can explicitly request processing the local-variables 184by executing `(hack-local-variables)'.)" 185 :type 'boolean 186 :group 'emerge) 187(defcustom emerge-execute-line-deletions nil 188 "*If non-nil: `emerge-execute-line' makes no output if an input was deleted. 189It concludes that an input version has been deleted when an ancestor entry 190is present, only one A or B entry is present, and an output entry is present. 191If nil: In such circumstances, the A or B file that is present will be 192copied to the designated output file." 193 :type 'boolean 194 :group 'emerge) 195 196(defcustom emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n" 197 "*Flag placed above the highlighted block of code. Must end with newline. 198Must be set before Emerge is loaded, or emerge-new-flags must be run 199after setting." 200 :type 'string 201 :group 'emerge) 202(defcustom emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n" 203 "*Flag placed below the highlighted block of code. Must end with newline. 204Must be set before Emerge is loaded, or emerge-new-flags must be run 205after setting." 206 :type 'string 207 :group 'emerge) 208 209;; Hook variables 210 211(defcustom emerge-startup-hook nil 212 "*Hook to run in the merge buffer after the merge has been set up." 213 :type 'hook 214 :group 'emerge) 215(defcustom emerge-select-hook nil 216 "*Hook to run after a difference has been selected. 217The variable `n' holds the (internal) number of the difference." 218 :type 'hook 219 :group 'emerge) 220(defcustom emerge-unselect-hook nil 221 "*Hook to run after a difference has been unselected. 222The variable `n' holds the (internal) number of the difference." 223 :type 'hook 224 :group 'emerge) 225 226;; Variables to control the default directories of the arguments to 227;; Emerge commands. 228 229(defcustom emerge-default-last-directories nil 230 "*If nil, default dir for filenames in emerge is `default-directory'. 231If non-nil, filenames complete in the directory of the last argument of the 232same type to an `emerge-files...' command." 233 :type 'boolean 234 :group 'emerge) 235 236(defvar emerge-last-dir-A nil 237 "Last directory for the first file of an `emerge-files...' command.") 238(defvar emerge-last-dir-B nil 239 "Last directory for the second file of an `emerge-files...' command.") 240(defvar emerge-last-dir-ancestor nil 241 "Last directory for the ancestor file of an `emerge-files...' command.") 242(defvar emerge-last-dir-output nil 243 "Last directory for the output file of an `emerge-files...' command.") 244(defvar emerge-last-revision-A nil 245 "Last RCS revision used for first file of an `emerge-revisions...' command.") 246(defvar emerge-last-revision-B nil 247 "Last RCS revision used for second file of an `emerge-revisions...' command.") 248(defvar emerge-last-revision-ancestor nil 249 "Last RCS revision used for ancestor file of an `emerge-revisions...' command.") 250 251(defvar emerge-before-flag-length) 252(defvar emerge-before-flag-lines) 253(defvar emerge-before-flag-match) 254(defvar emerge-after-flag-length) 255(defvar emerge-after-flag-lines) 256(defvar emerge-after-flag-match) 257(defvar emerge-diff-buffer) 258(defvar emerge-diff-error-buffer) 259(defvar emerge-prefix-argument) 260(defvar emerge-file-out) 261(defvar emerge-exit-func) 262(defvar emerge-globalized-difference-list) 263(defvar emerge-globalized-number-of-differences) 264 265;; The flags used to mark differences in the buffers. 266 267;; These function definitions need to be up here, because they are used 268;; during loading. 269(defun emerge-new-flags () 270 "Function to be called after `emerge-{before,after}-flag'. 271This is called after these functions are changed to compute values that 272depend on the flags." 273 (setq emerge-before-flag-length (length emerge-before-flag)) 274 (setq emerge-before-flag-lines 275 (emerge-count-matches-string emerge-before-flag "\n")) 276 (setq emerge-before-flag-match (regexp-quote emerge-before-flag)) 277 (setq emerge-after-flag-length (length emerge-after-flag)) 278 (setq emerge-after-flag-lines 279 (emerge-count-matches-string emerge-after-flag "\n")) 280 (setq emerge-after-flag-match (regexp-quote emerge-after-flag))) 281 282(defun emerge-count-matches-string (string regexp) 283 "Return the number of matches in STRING for REGEXP." 284 (let ((i 0) 285 (count 0)) 286 (while (string-match regexp string i) 287 (setq count (1+ count)) 288 (setq i (match-end 0))) 289 count)) 290 291;; Calculate dependent variables 292(emerge-new-flags) 293 294(defcustom emerge-min-visible-lines 3 295 "*Number of lines that we want to show above and below the flags when we are 296displaying a difference." 297 :type 'integer 298 :group 'emerge) 299 300(defcustom emerge-temp-file-prefix 301 (expand-file-name "emerge" temporary-file-directory) 302 "*Prefix to put on Emerge temporary file names. 303Do not start with `~/' or `~USERNAME/'." 304 :type 'string 305 :group 'emerge) 306 307(defcustom emerge-temp-file-mode 384 ; u=rw only 308 "*Mode for Emerge temporary files." 309 :type 'integer 310 :group 'emerge) 311 312(defcustom emerge-combine-versions-template 313 "#ifdef NEW\n%b#else /* not NEW */\n%a#endif /* not NEW */\n" 314 "*Template for `emerge-combine-versions' to combine the two versions. 315The template is inserted as a string, with the following interpolations: 316 %a the A version of the difference 317 %b the B version of the difference 318 %% the character `%' 319Don't forget to end the template with a newline. 320Note that this variable can be made local to a particular merge buffer by 321giving a prefix argument to `emerge-set-combine-versions-template'." 322 :type 'string 323 :group 'emerge) 324 325;; Build keymaps 326 327(defvar emerge-basic-keymap nil 328 "Keymap of Emerge commands. 329Directly available in `fast' mode; 330must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode.") 331 332(defvar emerge-fast-keymap nil 333 "Local keymap used in Emerge `fast' mode. 334Makes Emerge commands directly available.") 335 336(defvar emerge-options-menu 337 (make-sparse-keymap "Options")) 338 339(defvar emerge-merge-menu 340 (make-sparse-keymap "Merge")) 341 342(defvar emerge-move-menu 343 (make-sparse-keymap "Move")) 344 345(defcustom emerge-command-prefix "\C-c\C-c" 346 "*Command prefix for Emerge commands in `edit' mode. 347Must be set before Emerge is loaded." 348 :type 'string 349 :group 'emerge) 350 351;; This function sets up the fixed keymaps. It is executed when the first 352;; Emerge is done to allow the user maximum time to set up the global keymap. 353(defun emerge-setup-fixed-keymaps () 354 ;; Set up the basic keymap 355 (setq emerge-basic-keymap (make-keymap)) 356 (suppress-keymap emerge-basic-keymap) ; this sets 0..9 to digit-argument and 357 ; - to negative-argument 358 (define-key emerge-basic-keymap "p" 'emerge-previous-difference) 359 (define-key emerge-basic-keymap "n" 'emerge-next-difference) 360 (define-key emerge-basic-keymap "a" 'emerge-select-A) 361 (define-key emerge-basic-keymap "b" 'emerge-select-B) 362 (define-key emerge-basic-keymap "j" 'emerge-jump-to-difference) 363 (define-key emerge-basic-keymap "." 'emerge-find-difference) 364 (define-key emerge-basic-keymap "q" 'emerge-quit) 365 (define-key emerge-basic-keymap "\C-]" 'emerge-abort) 366 (define-key emerge-basic-keymap "f" 'emerge-fast-mode) 367 (define-key emerge-basic-keymap "e" 'emerge-edit-mode) 368 (define-key emerge-basic-keymap "s" nil) 369 (define-key emerge-basic-keymap "sa" 'emerge-auto-advance) 370 (define-key emerge-basic-keymap "ss" 'emerge-skip-prefers) 371 (define-key emerge-basic-keymap "l" 'emerge-recenter) 372 (define-key emerge-basic-keymap "d" nil) 373 (define-key emerge-basic-keymap "da" 'emerge-default-A) 374 (define-key emerge-basic-keymap "db" 'emerge-default-B) 375 (define-key emerge-basic-keymap "c" nil) 376 (define-key emerge-basic-keymap "ca" 'emerge-copy-as-kill-A) 377 (define-key emerge-basic-keymap "cb" 'emerge-copy-as-kill-B) 378 (define-key emerge-basic-keymap "i" nil) 379 (define-key emerge-basic-keymap "ia" 'emerge-insert-A) 380 (define-key emerge-basic-keymap "ib" 'emerge-insert-B) 381 (define-key emerge-basic-keymap "m" 'emerge-mark-difference) 382 (define-key emerge-basic-keymap "v" 'emerge-scroll-up) 383 (define-key emerge-basic-keymap "^" 'emerge-scroll-down) 384 (define-key emerge-basic-keymap "<" 'emerge-scroll-left) 385 (define-key emerge-basic-keymap ">" 'emerge-scroll-right) 386 (define-key emerge-basic-keymap "|" 'emerge-scroll-reset) 387 (define-key emerge-basic-keymap "x" nil) 388 (define-key emerge-basic-keymap "x1" 'emerge-one-line-window) 389 (define-key emerge-basic-keymap "xc" 'emerge-combine-versions) 390 (define-key emerge-basic-keymap "xC" 'emerge-combine-versions-register) 391 (define-key emerge-basic-keymap "xf" 'emerge-file-names) 392 (define-key emerge-basic-keymap "xj" 'emerge-join-differences) 393 (define-key emerge-basic-keymap "xl" 'emerge-line-numbers) 394 (define-key emerge-basic-keymap "xm" 'emerge-set-merge-mode) 395 (define-key emerge-basic-keymap "xs" 'emerge-split-difference) 396 (define-key emerge-basic-keymap "xt" 'emerge-trim-difference) 397 (define-key emerge-basic-keymap "xx" 'emerge-set-combine-versions-template) 398 ;; Allow emerge-basic-keymap to be referenced indirectly 399 (fset 'emerge-basic-keymap emerge-basic-keymap) 400 ;; Set up the fast mode keymap 401 (setq emerge-fast-keymap (copy-keymap emerge-basic-keymap)) 402 ;; Allow prefixed commands to work in fast mode 403 (define-key emerge-fast-keymap emerge-command-prefix 'emerge-basic-keymap) 404 ;; Allow emerge-fast-keymap to be referenced indirectly 405 (fset 'emerge-fast-keymap emerge-fast-keymap) 406 ;; Suppress write-file and save-buffer 407 (define-key emerge-fast-keymap [remap write-file] 'emerge-query-write-file) 408 (define-key emerge-fast-keymap [remap save-buffer] 'emerge-query-save-buffer) 409 410 (define-key emerge-basic-keymap [menu-bar] (make-sparse-keymap)) 411 412 (define-key emerge-fast-keymap [menu-bar options] 413 (cons "Options" emerge-options-menu)) 414 (define-key emerge-fast-keymap [menu-bar merge] 415 (cons "Merge" emerge-merge-menu)) 416 (define-key emerge-fast-keymap [menu-bar move] 417 (cons "Move" emerge-move-menu)) 418 419 (define-key emerge-move-menu [emerge-scroll-reset] 420 '("Scroll Reset" . emerge-scroll-reset)) 421 (define-key emerge-move-menu [emerge-scroll-right] 422 '("Scroll Right" . emerge-scroll-right)) 423 (define-key emerge-move-menu [emerge-scroll-left] 424 '("Scroll Left" . emerge-scroll-left)) 425 (define-key emerge-move-menu [emerge-scroll-down] 426 '("Scroll Down" . emerge-scroll-down)) 427 (define-key emerge-move-menu [emerge-scroll-up] 428 '("Scroll Up" . emerge-scroll-up)) 429 (define-key emerge-move-menu [emerge-recenter] 430 '("Recenter" . emerge-recenter)) 431 (define-key emerge-move-menu [emerge-mark-difference] 432 '("Mark Difference" . emerge-mark-difference)) 433 (define-key emerge-move-menu [emerge-jump-to-difference] 434 '("Jump To Difference" . emerge-jump-to-difference)) 435 (define-key emerge-move-menu [emerge-find-difference] 436 '("Find Difference" . emerge-find-difference)) 437 (define-key emerge-move-menu [emerge-previous-difference] 438 '("Previous Difference" . emerge-previous-difference)) 439 (define-key emerge-move-menu [emerge-next-difference] 440 '("Next Difference" . emerge-next-difference)) 441 442 443 (define-key emerge-options-menu [emerge-one-line-window] 444 '("One Line Window" . emerge-one-line-window)) 445 (define-key emerge-options-menu [emerge-set-merge-mode] 446 '("Set Merge Mode" . emerge-set-merge-mode)) 447 (define-key emerge-options-menu [emerge-set-combine-template] 448 '("Set Combine Template..." . emerge-set-combine-template)) 449 (define-key emerge-options-menu [emerge-default-B] 450 '("Default B" . emerge-default-B)) 451 (define-key emerge-options-menu [emerge-default-A] 452 '("Default A" . emerge-default-A)) 453 (define-key emerge-options-menu [emerge-skip-prefers] 454 '("Skip Prefers" . emerge-skip-prefers)) 455 (define-key emerge-options-menu [emerge-auto-advance] 456 '("Auto Advance" . emerge-auto-advance)) 457 (define-key emerge-options-menu [emerge-edit-mode] 458 '("Edit Mode" . emerge-edit-mode)) 459 (define-key emerge-options-menu [emerge-fast-mode] 460 '("Fast Mode" . emerge-fast-mode)) 461 462 (define-key emerge-merge-menu [emerge-abort] '("Abort" . emerge-abort)) 463 (define-key emerge-merge-menu [emerge-quit] '("Quit" . emerge-quit)) 464 (define-key emerge-merge-menu [emerge-split-difference] 465 '("Split Difference" . emerge-split-difference)) 466 (define-key emerge-merge-menu [emerge-join-differences] 467 '("Join Differences" . emerge-join-differences)) 468 (define-key emerge-merge-menu [emerge-trim-difference] 469 '("Trim Difference" . emerge-trim-difference)) 470 (define-key emerge-merge-menu [emerge-combine-versions] 471 '("Combine Versions" . emerge-combine-versions)) 472 (define-key emerge-merge-menu [emerge-copy-as-kill-B] 473 '("Copy B as Kill" . emerge-copy-as-kill-B)) 474 (define-key emerge-merge-menu [emerge-copy-as-kill-A] 475 '("Copy A as Kill" . emerge-copy-as-kill-A)) 476 (define-key emerge-merge-menu [emerge-insert-B] 477 '("Insert B" . emerge-insert-B)) 478 (define-key emerge-merge-menu [emerge-insert-A] 479 '("Insert A" . emerge-insert-A)) 480 (define-key emerge-merge-menu [emerge-select-B] 481 '("Select B" . emerge-select-B)) 482 (define-key emerge-merge-menu [emerge-select-A] 483 '("Select A" . emerge-select-A))) 484 485 486;; Variables which control each merge. They are local to the merge buffer. 487 488;; Mode variables 489(emerge-defvar-local emerge-mode nil 490 "Indicator for emerge-mode.") 491(emerge-defvar-local emerge-fast-mode nil 492 "Indicator for emerge-mode fast submode.") 493(emerge-defvar-local emerge-edit-mode nil 494 "Indicator for emerge-mode edit submode.") 495(emerge-defvar-local emerge-A-buffer nil 496 "The buffer in which the A variant is stored.") 497(emerge-defvar-local emerge-B-buffer nil 498 "The buffer in which the B variant is stored.") 499(emerge-defvar-local emerge-merge-buffer nil 500 "The buffer in which the merged file is manipulated.") 501(emerge-defvar-local emerge-ancestor-buffer nil 502 "The buffer in which the ancestor variant is stored, 503or nil if there is none.") 504 505(defconst emerge-saved-variables 506 '((buffer-modified-p set-buffer-modified-p) 507 buffer-read-only 508 buffer-auto-save-file-name) 509 "Variables and properties of a buffer which are saved, modified and restored 510during a merge.") 511(defconst emerge-merging-values '(nil t nil) 512 "Values to be assigned to emerge-saved-variables during a merge.") 513 514(emerge-defvar-local emerge-A-buffer-values nil 515 "Remembers emerge-saved-variables for emerge-A-buffer.") 516(emerge-defvar-local emerge-B-buffer-values nil 517 "Remembers emerge-saved-variables for emerge-B-buffer.") 518 519(emerge-defvar-local emerge-difference-list nil 520 "Vector of differences between the variants, and markers in the buffers to 521show where they are. Each difference is represented by a vector of seven 522elements. The first two are markers to the beginning and end of the difference 523section in the A buffer, the second two are markers for the B buffer, the third 524two are markers for the merge buffer, and the last element is the \"state\" of 525that difference in the merge buffer. 526 A section of a buffer is described by two markers, one to the beginning of 527the first line of the section, and one to the beginning of the first line 528after the section. (If the section is empty, both markers point to the same 529point.) If the section is part of the selected difference, then the markers 530are moved into the flags, so the user can edit the section without disturbing 531the markers. 532 The \"states\" are: 533 A the merge buffer currently contains the A variant 534 B the merge buffer currently contains the B variant 535 default-A the merge buffer contains the A variant by default, 536 but this difference hasn't been selected yet, so 537 change-default commands can alter it 538 default-B the merge buffer contains the B variant by default, 539 but this difference hasn't been selected yet, so 540 change-default commands can alter it 541 prefer-A in a three-file merge, the A variant is the preferred 542 choice 543 prefer-B in a three-file merge, the B variant is the preferred 544 choice") 545(emerge-defvar-local emerge-current-difference -1 546 "The difference that is currently selected.") 547(emerge-defvar-local emerge-number-of-differences nil 548 "Number of differences found.") 549(emerge-defvar-local emerge-edit-keymap nil 550 "The local keymap for the merge buffer, with the emerge commands defined in 551it. Used to save the local keymap during fast mode, when the local keymap is 552replaced by emerge-fast-keymap.") 553(emerge-defvar-local emerge-old-keymap nil 554 "The original local keymap for the merge buffer.") 555(emerge-defvar-local emerge-auto-advance nil 556 "*If non-nil, emerge-select-A and emerge-select-B automatically advance to 557the next difference.") 558(emerge-defvar-local emerge-skip-prefers nil 559 "*If non-nil, differences for which there is a preference are automatically 560skipped.") 561(emerge-defvar-local emerge-quit-hook nil 562 "Hooks to run in the merge buffer after the merge has been finished. 563`emerge-prefix-argument' will hold the prefix argument of the `emerge-quit' 564command. 565This is *not* a user option, since Emerge uses it for its own processing.") 566(emerge-defvar-local emerge-output-description nil 567 "Describes output destination of emerge, for `emerge-file-names'.") 568 569;;; Setup functions for two-file mode. 570 571(defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks 572 output-file) 573 (if (not (file-readable-p file-A)) 574 (error "File `%s' does not exist or is not readable" file-A)) 575 (if (not (file-readable-p file-B)) 576 (error "File `%s' does not exist or is not readable" file-B)) 577 (let ((buffer-A (find-file-noselect file-A)) 578 (buffer-B (find-file-noselect file-B))) 579 ;; Record the directories of the files 580 (setq emerge-last-dir-A (file-name-directory file-A)) 581 (setq emerge-last-dir-B (file-name-directory file-B)) 582 (if output-file 583 (setq emerge-last-dir-output (file-name-directory output-file))) 584 ;; Make sure the entire files are seen, and they reflect what is on disk 585 (emerge-eval-in-buffer 586 buffer-A 587 (widen) 588 (let ((temp (file-local-copy file-A))) 589 (if temp 590 (setq file-A temp 591 startup-hooks 592 (cons `(lambda () (delete-file ,file-A)) 593 startup-hooks)) 594 ;; Verify that the file matches the buffer 595 (emerge-verify-file-buffer)))) 596 (emerge-eval-in-buffer 597 buffer-B 598 (widen) 599 (let ((temp (file-local-copy file-B))) 600 (if temp 601 (setq file-B temp 602 startup-hooks 603 (cons `(lambda () (delete-file ,file-B)) 604 startup-hooks)) 605 ;; Verify that the file matches the buffer 606 (emerge-verify-file-buffer)))) 607 (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks 608 output-file))) 609 610;; Start up Emerge on two files 611(defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks 612 output-file) 613 (setq file-A (expand-file-name file-A)) 614 (setq file-B (expand-file-name file-B)) 615 (setq output-file (and output-file (expand-file-name output-file))) 616 (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) 617 ;; create the merge buffer from buffer A, so it inherits buffer A's 618 ;; default directory, etc. 619 (merge-buffer (emerge-eval-in-buffer 620 buffer-A 621 (get-buffer-create merge-buffer-name)))) 622 (emerge-eval-in-buffer 623 merge-buffer 624 (emerge-copy-modes buffer-A) 625 (setq buffer-read-only nil) 626 (auto-save-mode 1) 627 (setq emerge-mode t) 628 (setq emerge-A-buffer buffer-A) 629 (setq emerge-B-buffer buffer-B) 630 (setq emerge-ancestor-buffer nil) 631 (setq emerge-merge-buffer merge-buffer) 632 (setq emerge-output-description 633 (if output-file 634 (concat "Output to file: " output-file) 635 (concat "Output to buffer: " (buffer-name merge-buffer)))) 636 (insert-buffer emerge-A-buffer) 637 (emerge-set-keys) 638 (setq emerge-difference-list (emerge-make-diff-list file-A file-B)) 639 (setq emerge-number-of-differences (length emerge-difference-list)) 640 (setq emerge-current-difference -1) 641 (setq emerge-quit-hook quit-hooks) 642 (emerge-remember-buffer-characteristics) 643 (emerge-handle-local-variables)) 644 (emerge-setup-windows buffer-A buffer-B merge-buffer t) 645 (emerge-eval-in-buffer merge-buffer 646 (run-hooks 'startup-hooks 'emerge-startup-hook) 647 (setq buffer-read-only t)))) 648 649;; Generate the Emerge difference list between two files 650(defun emerge-make-diff-list (file-A file-B) 651 (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*")) 652 (emerge-eval-in-buffer 653 emerge-diff-buffer 654 (erase-buffer) 655 (shell-command 656 (format "%s %s %s %s" 657 emerge-diff-program emerge-diff-options 658 (emerge-protect-metachars file-A) 659 (emerge-protect-metachars file-B)) 660 t)) 661 (emerge-prepare-error-list emerge-diff-ok-lines-regexp) 662 (emerge-convert-diffs-to-markers 663 emerge-A-buffer emerge-B-buffer emerge-merge-buffer 664 (emerge-extract-diffs emerge-diff-buffer))) 665 666(defun emerge-extract-diffs (diff-buffer) 667 (let (list) 668 (emerge-eval-in-buffer 669 diff-buffer 670 (goto-char (point-min)) 671 (while (re-search-forward emerge-match-diff-line nil t) 672 (let* ((a-begin (string-to-number (buffer-substring (match-beginning 1) 673 (match-end 1)))) 674 (a-end (let ((b (match-beginning 3)) 675 (e (match-end 3))) 676 (if b 677 (string-to-number (buffer-substring b e)) 678 a-begin))) 679 (diff-type (buffer-substring (match-beginning 4) (match-end 4))) 680 (b-begin (string-to-number (buffer-substring (match-beginning 5) 681 (match-end 5)))) 682 (b-end (let ((b (match-beginning 7)) 683 (e (match-end 7))) 684 (if b 685 (string-to-number (buffer-substring b e)) 686 b-begin)))) 687 ;; fix the beginning and end numbers, because diff is somewhat 688 ;; strange about how it numbers lines 689 (if (string-equal diff-type "a") 690 (progn 691 (setq b-end (1+ b-end)) 692 (setq a-begin (1+ a-begin)) 693 (setq a-end a-begin)) 694 (if (string-equal diff-type "d") 695 (progn 696 (setq a-end (1+ a-end)) 697 (setq b-begin (1+ b-begin)) 698 (setq b-end b-begin)) 699 ;; (string-equal diff-type "c") 700 (progn 701 (setq a-end (1+ a-end)) 702 (setq b-end (1+ b-end))))) 703 (setq list (cons (vector a-begin a-end 704 b-begin b-end 705 'default-A) 706 list))))) 707 (nreverse list))) 708 709;; Set up buffer of diff/diff3 error messages. 710(defun emerge-prepare-error-list (ok-regexp) 711 (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*")) 712 (emerge-eval-in-buffer 713 emerge-diff-error-buffer 714 (erase-buffer) 715 (insert-buffer emerge-diff-buffer) 716 (delete-matching-lines ok-regexp))) 717 718;;; Top-level and setup functions for three-file mode. 719 720(defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor 721 &optional startup-hooks quit-hooks 722 output-file) 723 (if (not (file-readable-p file-A)) 724 (error "File `%s' does not exist or is not readable" file-A)) 725 (if (not (file-readable-p file-B)) 726 (error "File `%s' does not exist or is not readable" file-B)) 727 (if (not (file-readable-p file-ancestor)) 728 (error "File `%s' does not exist or is not readable" file-ancestor)) 729 (let ((buffer-A (find-file-noselect file-A)) 730 (buffer-B (find-file-noselect file-B)) 731 (buffer-ancestor (find-file-noselect file-ancestor))) 732 ;; Record the directories of the files 733 (setq emerge-last-dir-A (file-name-directory file-A)) 734 (setq emerge-last-dir-B (file-name-directory file-B)) 735 (setq emerge-last-dir-ancestor (file-name-directory file-ancestor)) 736 (if output-file 737 (setq emerge-last-dir-output (file-name-directory output-file))) 738 ;; Make sure the entire files are seen, and they reflect what is on disk 739 (emerge-eval-in-buffer 740 buffer-A 741 (widen) 742 (let ((temp (file-local-copy file-A))) 743 (if temp 744 (setq file-A temp 745 startup-hooks 746 (cons `(lambda () (delete-file ,file-A)) 747 startup-hooks)) 748 ;; Verify that the file matches the buffer 749 (emerge-verify-file-buffer)))) 750 (emerge-eval-in-buffer 751 buffer-B 752 (widen) 753 (let ((temp (file-local-copy file-B))) 754 (if temp 755 (setq file-B temp 756 startup-hooks 757 (cons `(lambda () (delete-file ,file-B)) 758 startup-hooks)) 759 ;; Verify that the file matches the buffer 760 (emerge-verify-file-buffer)))) 761 (emerge-eval-in-buffer 762 buffer-ancestor 763 (widen) 764 (let ((temp (file-local-copy file-ancestor))) 765 (if temp 766 (setq file-ancestor temp 767 startup-hooks 768 (cons `(lambda () (delete-file ,file-ancestor)) 769 startup-hooks)) 770 ;; Verify that the file matches the buffer 771 (emerge-verify-file-buffer)))) 772 (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B 773 buffer-ancestor file-ancestor 774 startup-hooks quit-hooks output-file))) 775 776;; Start up Emerge on two files with an ancestor 777(defun emerge-setup-with-ancestor (buffer-A file-A buffer-B file-B 778 buffer-ancestor file-ancestor 779 &optional startup-hooks quit-hooks 780 output-file) 781 (setq file-A (expand-file-name file-A)) 782 (setq file-B (expand-file-name file-B)) 783 (setq file-ancestor (expand-file-name file-ancestor)) 784 (setq output-file (and output-file (expand-file-name output-file))) 785 (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) 786 ;; create the merge buffer from buffer A, so it inherits buffer A's 787 ;; default directory, etc. 788 (merge-buffer (emerge-eval-in-buffer 789 buffer-A 790 (get-buffer-create merge-buffer-name)))) 791 (emerge-eval-in-buffer 792 merge-buffer 793 (emerge-copy-modes buffer-A) 794 (setq buffer-read-only nil) 795 (auto-save-mode 1) 796 (setq emerge-mode t) 797 (setq emerge-A-buffer buffer-A) 798 (setq emerge-B-buffer buffer-B) 799 (setq emerge-ancestor-buffer buffer-ancestor) 800 (setq emerge-merge-buffer merge-buffer) 801 (setq emerge-output-description 802 (if output-file 803 (concat "Output to file: " output-file) 804 (concat "Output to buffer: " (buffer-name merge-buffer)))) 805 (insert-buffer emerge-A-buffer) 806 (emerge-set-keys) 807 (setq emerge-difference-list 808 (emerge-make-diff3-list file-A file-B file-ancestor)) 809 (setq emerge-number-of-differences (length emerge-difference-list)) 810 (setq emerge-current-difference -1) 811 (setq emerge-quit-hook quit-hooks) 812 (emerge-remember-buffer-characteristics) 813 (emerge-select-prefer-Bs) 814 (emerge-handle-local-variables)) 815 (emerge-setup-windows buffer-A buffer-B merge-buffer t) 816 (emerge-eval-in-buffer merge-buffer 817 (run-hooks 'startup-hooks 'emerge-startup-hook) 818 (setq buffer-read-only t)))) 819 820;; Generate the Emerge difference list between two files with an ancestor 821(defun emerge-make-diff3-list (file-A file-B file-ancestor) 822 (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*")) 823 (emerge-eval-in-buffer 824 emerge-diff-buffer 825 (erase-buffer) 826 (shell-command 827 (format "%s %s %s %s %s" 828 emerge-diff3-program emerge-diff-options 829 (emerge-protect-metachars file-A) 830 (emerge-protect-metachars file-ancestor) 831 (emerge-protect-metachars file-B)) 832 t)) 833 (emerge-prepare-error-list emerge-diff3-ok-lines-regexp) 834 (emerge-convert-diffs-to-markers 835 emerge-A-buffer emerge-B-buffer emerge-merge-buffer 836 (emerge-extract-diffs3 emerge-diff-buffer))) 837 838(defun emerge-extract-diffs3 (diff-buffer) 839 (let (list) 840 (emerge-eval-in-buffer 841 diff-buffer 842 (while (re-search-forward "^====\\(.?\\)$" nil t) 843 ;; leave point after matched line 844 (beginning-of-line 2) 845 (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) 846 ;; if the A and B files are the same, ignore the difference 847 (if (not (string-equal agreement "2")) 848 (setq list 849 (cons 850 (let (group-1 group-3 pos) 851 (setq pos (point)) 852 (setq group-1 (emerge-get-diff3-group "1")) 853 (goto-char pos) 854 (setq group-3 (emerge-get-diff3-group "3")) 855 (vector (car group-1) (car (cdr group-1)) 856 (car group-3) (car (cdr group-3)) 857 (cond ((string-equal agreement "1") 'prefer-A) 858 ((string-equal agreement "3") 'prefer-B) 859 (t 'default-A)))) 860 list)))))) 861 (nreverse list))) 862 863(defun emerge-get-diff3-group (file) 864 ;; This save-excursion allows emerge-get-diff3-group to be called for the 865 ;; various groups of lines (1, 2, 3) in any order, and for the lines to 866 ;; appear in any order. The reason this is necessary is that Gnu diff3 867 ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2. 868 (save-excursion 869 (re-search-forward 870 (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$")) 871 (beginning-of-line 2) 872 ;; treatment depends on whether it is an "a" group or a "c" group 873 (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c") 874 ;; it is a "c" group 875 (if (match-beginning 2) 876 ;; it has two numbers 877 (list (string-to-number 878 (buffer-substring (match-beginning 1) (match-end 1))) 879 (1+ (string-to-number 880 (buffer-substring (match-beginning 3) (match-end 3))))) 881 ;; it has one number 882 (let ((x (string-to-number 883 (buffer-substring (match-beginning 1) (match-end 1))))) 884 (list x (1+ x)))) 885 ;; it is an "a" group 886 (let ((x (1+ (string-to-number 887 (buffer-substring (match-beginning 1) (match-end 1)))))) 888 (list x x))))) 889 890;;; Functions to start Emerge on files 891 892;;;###autoload 893(defun emerge-files (arg file-A file-B file-out &optional startup-hooks 894 quit-hooks) 895 "Run Emerge on two files." 896 (interactive 897 (let (f) 898 (list current-prefix-arg 899 (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A 900 nil nil t)) 901 (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t) 902 (and current-prefix-arg 903 (emerge-read-file-name "Output file" emerge-last-dir-output 904 f f nil))))) 905 (if file-out 906 (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out)))) 907 (emerge-files-internal 908 file-A file-B startup-hooks 909 quit-hooks 910 file-out)) 911 912;;;###autoload 913(defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out 914 &optional startup-hooks quit-hooks) 915 "Run Emerge on two files, giving another file as the ancestor." 916 (interactive 917 (let (f) 918 (list current-prefix-arg 919 (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A 920 nil nil t)) 921 (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t) 922 (emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor 923 nil f t) 924 (and current-prefix-arg 925 (emerge-read-file-name "Output file" emerge-last-dir-output 926 f f nil))))) 927 (if file-out 928 (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out)))) 929 (emerge-files-with-ancestor-internal 930 file-A file-B file-ancestor startup-hooks 931 quit-hooks 932 file-out)) 933 934;; Write the merge buffer out in place of the file the A buffer is visiting. 935(defun emerge-files-exit (file-out) 936 ;; if merge was successful was given, save to disk 937 (if (not emerge-prefix-argument) 938 (emerge-write-and-delete file-out))) 939 940;;; Functions to start Emerge on buffers 941 942;;;###autoload 943(defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks) 944 "Run Emerge on two buffers." 945 (interactive "bBuffer A to merge: \nbBuffer B to merge: ") 946 (let ((emerge-file-A (emerge-make-temp-file "A")) 947 (emerge-file-B (emerge-make-temp-file "B"))) 948 (emerge-eval-in-buffer 949 buffer-A 950 (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) 951 (emerge-eval-in-buffer 952 buffer-B 953 (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) 954 (emerge-setup (get-buffer buffer-A) emerge-file-A 955 (get-buffer buffer-B) emerge-file-B 956 (cons `(lambda () 957 (delete-file ,emerge-file-A) 958 (delete-file ,emerge-file-B)) 959 startup-hooks) 960 quit-hooks 961 nil))) 962 963;;;###autoload 964(defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor 965 &optional startup-hooks 966 quit-hooks) 967 "Run Emerge on two buffers, giving another buffer as the ancestor." 968 (interactive 969 "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ") 970 (let ((emerge-file-A (emerge-make-temp-file "A")) 971 (emerge-file-B (emerge-make-temp-file "B")) 972 (emerge-file-ancestor (emerge-make-temp-file "anc"))) 973 (emerge-eval-in-buffer 974 buffer-A 975 (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) 976 (emerge-eval-in-buffer 977 buffer-B 978 (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) 979 (emerge-eval-in-buffer 980 buffer-ancestor 981 (write-region (point-min) (point-max) emerge-file-ancestor nil 982 'no-message)) 983 (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A 984 (get-buffer buffer-B) emerge-file-B 985 (get-buffer buffer-ancestor) 986 emerge-file-ancestor 987 (cons `(lambda () 988 (delete-file ,emerge-file-A) 989 (delete-file ,emerge-file-B) 990 (delete-file 991 ,emerge-file-ancestor)) 992 startup-hooks) 993 quit-hooks 994 nil))) 995 996;;; Functions to start Emerge from the command line 997 998;;;###autoload 999(defun emerge-files-command () 1000 (let ((file-a (nth 0 command-line-args-left)) 1001 (file-b (nth 1 command-line-args-left)) 1002 (file-out (nth 2 command-line-args-left))) 1003 (setq command-line-args-left (nthcdr 3 command-line-args-left)) 1004 (emerge-files-internal 1005 file-a file-b nil 1006 (list `(lambda () (emerge-command-exit ,file-out)))))) 1007 1008;;;###autoload 1009(defun emerge-files-with-ancestor-command () 1010 (let (file-a file-b file-anc file-out) 1011 ;; check for a -a flag, for filemerge compatibility 1012 (if (string= (car command-line-args-left) "-a") 1013 ;; arguments are "-a ancestor file-a file-b file-out" 1014 (progn 1015 (setq file-a (nth 2 command-line-args-left)) 1016 (setq file-b (nth 3 command-line-args-left)) 1017 (setq file-anc (nth 1 command-line-args-left)) 1018 (setq file-out (nth 4 command-line-args-left)) 1019 (setq command-line-args-left (nthcdr 5 command-line-args-left))) 1020 ;; arguments are "file-a file-b ancestor file-out" 1021 (setq file-a (nth 0 command-line-args-left)) 1022 (setq file-b (nth 1 command-line-args-left)) 1023 (setq file-anc (nth 2 command-line-args-left)) 1024 (setq file-out (nth 3 command-line-args-left)) 1025 (setq command-line-args-left (nthcdr 4 command-line-args-left))) 1026 (emerge-files-with-ancestor-internal 1027 file-a file-b file-anc nil 1028 (list `(lambda () (emerge-command-exit ,file-out)))))) 1029 1030(defun emerge-command-exit (file-out) 1031 (emerge-write-and-delete file-out) 1032 (kill-emacs (if emerge-prefix-argument 1 0))) 1033 1034;;; Functions to start Emerge via remote request 1035 1036;;;###autoload 1037(defun emerge-files-remote (file-a file-b file-out) 1038 (setq emerge-file-out file-out) 1039 (emerge-files-internal 1040 file-a file-b nil 1041 (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func))) 1042 file-out) 1043 (throw 'client-wait nil)) 1044 1045;;;###autoload 1046(defun emerge-files-with-ancestor-remote (file-a file-b file-anc file-out) 1047 (setq emerge-file-out file-out) 1048 (emerge-files-with-ancestor-internal 1049 file-a file-b file-anc nil 1050 (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func))) 1051 file-out) 1052 (throw 'client-wait nil)) 1053 1054(defun emerge-remote-exit (file-out emerge-exit-func) 1055 (emerge-write-and-delete file-out) 1056 (kill-buffer emerge-merge-buffer) 1057 (funcall emerge-exit-func (if emerge-prefix-argument 1 0))) 1058 1059;;; Functions to start Emerge on RCS versions 1060 1061;;;###autoload 1062(defun emerge-revisions (arg file revision-A revision-B 1063 &optional startup-hooks quit-hooks) 1064 "Emerge two RCS revisions of a file." 1065 (interactive 1066 (list current-prefix-arg 1067 (read-file-name "File to merge: " nil nil 'confirm) 1068 (read-string "Revision A to merge: " emerge-last-revision-A) 1069 (read-string "Revision B to merge: " emerge-last-revision-B))) 1070 (setq emerge-last-revision-A revision-A 1071 emerge-last-revision-B revision-B) 1072 (emerge-revisions-internal 1073 file revision-A revision-B startup-hooks 1074 (if arg 1075 (cons `(lambda () 1076 (shell-command 1077 ,(format "%s %s" emerge-rcs-ci-program file))) 1078 quit-hooks) 1079 quit-hooks))) 1080 1081;;;###autoload 1082(defun emerge-revisions-with-ancestor (arg file revision-A 1083 revision-B ancestor 1084 &optional 1085 startup-hooks quit-hooks) 1086 "Emerge two RCS revisions of a file, with another revision as ancestor." 1087 (interactive 1088 (list current-prefix-arg 1089 (read-file-name "File to merge: " nil nil 'confirm) 1090 (read-string "Revision A to merge: " emerge-last-revision-A) 1091 (read-string "Revision B to merge: " emerge-last-revision-B) 1092 (read-string "Ancestor: " emerge-last-revision-ancestor))) 1093 (setq emerge-last-revision-A revision-A 1094 emerge-last-revision-B revision-B 1095 emerge-last-revision-ancestor ancestor) 1096 (emerge-revision-with-ancestor-internal 1097 file revision-A revision-B ancestor startup-hooks 1098 (if arg 1099 (let ((cmd )) 1100 (cons `(lambda () 1101 (shell-command 1102 ,(format "%s %s" emerge-rcs-ci-program file))) 1103 quit-hooks)) 1104 quit-hooks))) 1105 1106(defun emerge-revisions-internal (file revision-A revision-B &optional 1107 startup-hooks quit-hooks output-file) 1108 (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) 1109 (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) 1110 (emerge-file-A (emerge-make-temp-file "A")) 1111 (emerge-file-B (emerge-make-temp-file "B"))) 1112 ;; Get the revisions into buffers 1113 (emerge-eval-in-buffer 1114 buffer-A 1115 (erase-buffer) 1116 (shell-command 1117 (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file) 1118 t) 1119 (write-region (point-min) (point-max) emerge-file-A nil 'no-message) 1120 (set-buffer-modified-p nil)) 1121 (emerge-eval-in-buffer 1122 buffer-B 1123 (erase-buffer) 1124 (shell-command 1125 (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) 1126 t) 1127 (write-region (point-min) (point-max) emerge-file-B nil 'no-message) 1128 (set-buffer-modified-p nil)) 1129 ;; Do the merge 1130 (emerge-setup buffer-A emerge-file-A 1131 buffer-B emerge-file-B 1132 (cons `(lambda () 1133 (delete-file ,emerge-file-A) 1134 (delete-file ,emerge-file-B)) 1135 startup-hooks) 1136 (cons `(lambda () (emerge-files-exit ,file)) 1137 quit-hooks) 1138 nil))) 1139 1140(defun emerge-revision-with-ancestor-internal (file revision-A revision-B 1141 ancestor 1142 &optional startup-hooks 1143 quit-hooks output-file) 1144 (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) 1145 (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) 1146 (buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor))) 1147 (emerge-file-A (emerge-make-temp-file "A")) 1148 (emerge-file-B (emerge-make-temp-file "B")) 1149 (emerge-ancestor (emerge-make-temp-file "ancestor"))) 1150 ;; Get the revisions into buffers 1151 (emerge-eval-in-buffer 1152 buffer-A 1153 (erase-buffer) 1154 (shell-command 1155 (format "%s -q -p%s %s" emerge-rcs-co-program 1156 revision-A file) 1157 t) 1158 (write-region (point-min) (point-max) emerge-file-A nil 'no-message) 1159 (set-buffer-modified-p nil)) 1160 (emerge-eval-in-buffer 1161 buffer-B 1162 (erase-buffer) 1163 (shell-command 1164 (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) 1165 t) 1166 (write-region (point-min) (point-max) emerge-file-B nil 'no-message) 1167 (set-buffer-modified-p nil)) 1168 (emerge-eval-in-buffer 1169 buffer-ancestor 1170 (erase-buffer) 1171 (shell-command 1172 (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file) 1173 t) 1174 (write-region (point-min) (point-max) emerge-ancestor nil 'no-message) 1175 (set-buffer-modified-p nil)) 1176 ;; Do the merge 1177 (emerge-setup-with-ancestor 1178 buffer-A emerge-file-A buffer-B emerge-file-B 1179 buffer-ancestor emerge-ancestor 1180 (cons `(lambda () 1181 (delete-file ,emerge-file-A) 1182 (delete-file ,emerge-file-B) 1183 (delete-file ,emerge-ancestor)) 1184 startup-hooks) 1185 (cons `(lambda () (emerge-files-exit ,file)) 1186 quit-hooks) 1187 output-file))) 1188 1189;;; Function to start Emerge based on a line in a file 1190 1191(defun emerge-execute-line () 1192 "Run Emerge using files named in current text line. 1193Looks in that line for whitespace-separated entries of these forms: 1194 a=file1 1195 b=file2 1196 ancestor=file3 1197 output=file4 1198to specify the files to use in Emerge. 1199 1200In addition, if only one of `a=file' or `b=file' is present, and `output=file' 1201is present: 1202If `emerge-execute-line-deletions' is non-nil and `ancestor=file' is present, 1203it is assumed that the file in question has been deleted, and it is 1204not copied to the output file. 1205Otherwise, the A or B file present is copied to the output file." 1206 (interactive) 1207 (let (file-A file-B file-ancestor file-out 1208 (case-fold-search t)) 1209 ;; Stop if at end of buffer (even though we might be in a line, if 1210 ;; the line does not end with newline) 1211 (if (eobp) 1212 (error "At end of buffer")) 1213 ;; Go to the beginning of the line 1214 (beginning-of-line) 1215 ;; Skip any initial whitespace 1216 (if (looking-at "[ \t]*") 1217 (goto-char (match-end 0))) 1218 ;; Process the entire line 1219 (while (not (eolp)) 1220 ;; Get the next entry 1221 (if (looking-at "\\([a-z]+\\)=\\([^ \t\n]+\\)[ \t]*") 1222 ;; Break apart the tab (before =) and the filename (after =) 1223 (let ((tag (downcase 1224 (buffer-substring (match-beginning 1) (match-end 1)))) 1225 (file (buffer-substring (match-beginning 2) (match-end 2)))) 1226 ;; Move point after the entry 1227 (goto-char (match-end 0)) 1228 ;; Store the filename in the right variable 1229 (cond 1230 ((string-equal tag "a") 1231 (if file-A 1232 (error "This line has two `A' entries")) 1233 (setq file-A file)) 1234 ((string-equal tag "b") 1235 (if file-B 1236 (error "This line has two `B' entries")) 1237 (setq file-B file)) 1238 ((or (string-equal tag "anc") (string-equal tag "ancestor")) 1239 (if file-ancestor 1240 (error "This line has two `ancestor' entries")) 1241 (setq file-ancestor file)) 1242 ((or (string-equal tag "out") (string-equal tag "output")) 1243 (if file-out 1244 (error "This line has two `output' entries")) 1245 (setq file-out file)) 1246 (t 1247 (error "Unrecognized entry")))) 1248 ;; If the match on the entry pattern failed 1249 (error "Unparsable entry"))) 1250 ;; Make sure that file-A and file-B are present 1251 (if (not (or (and file-A file-B) file-out)) 1252 (error "Must have both `A' and `B' entries")) 1253 (if (not (or file-A file-B)) 1254 (error "Must have `A' or `B' entry")) 1255 ;; Go to the beginning of the next line, so next execution will use 1256 ;; next line in buffer. 1257 (beginning-of-line 2) 1258 ;; Execute the correct command 1259 (cond 1260 ;; Merge of two files with ancestor 1261 ((and file-A file-B file-ancestor) 1262 (message "Merging %s and %s..." file-A file-B) 1263 (emerge-files-with-ancestor (not (not file-out)) file-A file-B 1264 file-ancestor file-out 1265 nil 1266 ;; When done, return to this buffer. 1267 (list 1268 `(lambda () 1269 (switch-to-buffer ,(current-buffer)) 1270 (message "Merge done."))))) 1271 ;; Merge of two files without ancestor 1272 ((and file-A file-B) 1273 (message "Merging %s and %s..." file-A file-B) 1274 (emerge-files (not (not file-out)) file-A file-B file-out 1275 nil 1276 ;; When done, return to this buffer. 1277 (list 1278 `(lambda () 1279 (switch-to-buffer ,(current-buffer)) 1280 (message "Merge done."))))) 1281 ;; There is an output file (or there would have been an error above), 1282 ;; but only one input file. 1283 ;; The file appears to have been deleted in one version; do nothing. 1284 ((and file-ancestor emerge-execute-line-deletions) 1285 (message "No action.")) 1286 ;; The file should be copied from the version that contains it 1287 (t (let ((input-file (or file-A file-B))) 1288 (message "Copying...") 1289 (copy-file input-file file-out) 1290 (message "%s copied to %s." input-file file-out)))))) 1291 1292;;; Sample function for creating information for emerge-execute-line 1293 1294(defcustom emerge-merge-directories-filename-regexp "[^.]" 1295 "Regexp describing files to be processed by `emerge-merge-directories'." 1296 :type 'regexp 1297 :group 'emerge) 1298 1299;;;###autoload 1300(defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir) 1301 (interactive 1302 (list 1303 (read-file-name "A directory: " nil nil 'confirm) 1304 (read-file-name "B directory: " nil nil 'confirm) 1305 (read-file-name "Ancestor directory (null for none): " nil nil 'confirm) 1306 (read-file-name "Output directory (null for none): " nil nil 'confirm))) 1307 ;; Check that we're not on a line 1308 (if (not (and (bolp) (eolp))) 1309 (error "There is text on this line")) 1310 ;; Turn null strings into nil to indicate directories not used. 1311 (if (and ancestor-dir (string-equal ancestor-dir "")) 1312 (setq ancestor-dir nil)) 1313 (if (and output-dir (string-equal output-dir "")) 1314 (setq output-dir nil)) 1315 ;; Canonicalize the directory names 1316 (setq a-dir (expand-file-name a-dir)) 1317 (if (not (string-equal (substring a-dir -1) "/")) 1318 (setq a-dir (concat a-dir "/"))) 1319 (setq b-dir (expand-file-name b-dir)) 1320 (if (not (string-equal (substring b-dir -1) "/")) 1321 (setq b-dir (concat b-dir "/"))) 1322 (if ancestor-dir 1323 (progn 1324 (setq ancestor-dir (expand-file-name ancestor-dir)) 1325 (if (not (string-equal (substring ancestor-dir -1) "/")) 1326 (setq ancestor-dir (concat ancestor-dir "/"))))) 1327 (if output-dir 1328 (progn 1329 (setq output-dir (expand-file-name output-dir)) 1330 (if (not (string-equal (substring output-dir -1) "/")) 1331 (setq output-dir (concat output-dir "/"))))) 1332 ;; Set the mark to where we start 1333 (push-mark) 1334 ;; Find out what files are in the directories. 1335 (let* ((a-dir-files 1336 (directory-files a-dir nil emerge-merge-directories-filename-regexp)) 1337 (b-dir-files 1338 (directory-files b-dir nil emerge-merge-directories-filename-regexp)) 1339 (ancestor-dir-files 1340 (and ancestor-dir 1341 (directory-files ancestor-dir nil 1342 emerge-merge-directories-filename-regexp))) 1343 (all-files (sort (nconc (copy-sequence a-dir-files) 1344 (copy-sequence b-dir-files) 1345 (copy-sequence ancestor-dir-files)) 1346 (function string-lessp)))) 1347 ;; Remove duplicates from all-files. 1348 (let ((p all-files)) 1349 (while p 1350 (if (and (cdr p) (string-equal (car p) (car (cdr p)))) 1351 (setcdr p (cdr (cdr p))) 1352 (setq p (cdr p))))) 1353 ;; Generate the control lines for the various files. 1354 (while all-files 1355 (let ((f (car all-files))) 1356 (setq all-files (cdr all-files)) 1357 (if (and a-dir-files (string-equal (car a-dir-files) f)) 1358 (progn 1359 (insert "A=" a-dir f "\t") 1360 (setq a-dir-files (cdr a-dir-files)))) 1361 (if (and b-dir-files (string-equal (car b-dir-files) f)) 1362 (progn 1363 (insert "B=" b-dir f "\t") 1364 (setq b-dir-files (cdr b-dir-files)))) 1365 (if (and ancestor-dir-files (string-equal (car ancestor-dir-files) f)) 1366 (progn 1367 (insert "ancestor=" ancestor-dir f "\t") 1368 (setq ancestor-dir-files (cdr ancestor-dir-files)))) 1369 (if output-dir 1370 (insert "output=" output-dir f "\t")) 1371 (backward-delete-char 1) 1372 (insert "\n"))))) 1373 1374;;; Common setup routines 1375 1376;; Set up the window configuration. If POS is given, set the points to 1377;; the beginnings of the buffers. 1378(defun emerge-setup-windows (buffer-A buffer-B merge-buffer &optional pos) 1379 ;; Make sure we are not in the minibuffer window when we try to delete 1380 ;; all other windows. 1381 (if (eq (selected-window) (minibuffer-window)) 1382 (other-window 1)) 1383 (delete-other-windows) 1384 (switch-to-buffer merge-buffer) 1385 (emerge-refresh-mode-line) 1386 (split-window-vertically) 1387 (split-window-horizontally) 1388 (switch-to-buffer buffer-A) 1389 (if pos 1390 (goto-char (point-min))) 1391 (other-window 1) 1392 (switch-to-buffer buffer-B) 1393 (if pos 1394 (goto-char (point-min))) 1395 (other-window 1) 1396 (if pos 1397 (goto-char (point-min))) 1398 ;; If diff/diff3 reports errors, display them rather than the merge buffer. 1399 (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size))) 1400 (progn 1401 (ding) 1402 (message "Errors found in diff/diff3 output. Merge buffer is %s." 1403 (buffer-name emerge-merge-buffer)) 1404 (switch-to-buffer emerge-diff-error-buffer)))) 1405 1406;; Set up the keymap in the merge buffer 1407(defun emerge-set-keys () 1408 ;; Set up fixed keymaps if necessary 1409 (if (not emerge-basic-keymap) 1410 (emerge-setup-fixed-keymaps)) 1411 ;; Save the old local map 1412 (setq emerge-old-keymap (current-local-map)) 1413 ;; Construct the edit keymap 1414 (setq emerge-edit-keymap (if emerge-old-keymap 1415 (copy-keymap emerge-old-keymap) 1416 (make-sparse-keymap))) 1417 ;; Install the Emerge commands 1418 (emerge-force-define-key emerge-edit-keymap emerge-command-prefix 1419 'emerge-basic-keymap) 1420 (define-key emerge-edit-keymap [menu-bar] (make-sparse-keymap)) 1421 1422 ;; Create the additional menu bar items. 1423 (define-key emerge-edit-keymap [menu-bar options] 1424 (cons "Options" emerge-options-menu)) 1425 (define-key emerge-edit-keymap [menu-bar merge] 1426 (cons "Merge" emerge-merge-menu)) 1427 (define-key emerge-edit-keymap [menu-bar move] 1428 (cons "Move" emerge-move-menu)) 1429 1430 ;; Suppress write-file and save-buffer 1431 (substitute-key-definition 'write-file 1432 'emerge-query-write-file 1433 emerge-edit-keymap) 1434 (substitute-key-definition 'save-buffer 1435 'emerge-query-save-buffer 1436 emerge-edit-keymap) 1437 (define-key emerge-edit-keymap [remap write-file] 'emerge-query-write-file) 1438 (define-key emerge-edit-keymap [remap save-buffer] 'emerge-query-save-buffer) 1439 (use-local-map emerge-fast-keymap) 1440 (setq emerge-edit-mode nil) 1441 (setq emerge-fast-mode t)) 1442 1443(defun emerge-remember-buffer-characteristics () 1444 "Record certain properties of the buffers being merged. 1445Must be called in the merge buffer. Remembers read-only, modified, 1446auto-save, and saves them in buffer local variables. Sets the buffers 1447read-only and turns off `auto-save-mode'. 1448These characteristics are restored by `emerge-restore-buffer-characteristics'." 1449 ;; force auto-save, because we will turn off auto-saving in buffers for the 1450 ;; duration 1451 (do-auto-save) 1452 ;; remember and alter buffer characteristics 1453 (setq emerge-A-buffer-values 1454 (emerge-eval-in-buffer 1455 emerge-A-buffer 1456 (prog1 1457 (emerge-save-variables emerge-saved-variables) 1458 (emerge-restore-variables emerge-saved-variables 1459 emerge-merging-values)))) 1460 (setq emerge-B-buffer-values 1461 (emerge-eval-in-buffer 1462 emerge-B-buffer 1463 (prog1 1464 (emerge-save-variables emerge-saved-variables) 1465 (emerge-restore-variables emerge-saved-variables 1466 emerge-merging-values))))) 1467 1468(defun emerge-restore-buffer-characteristics () 1469 "Restore characteristics saved by `emerge-remember-buffer-characteristics'." 1470 (let ((A-values emerge-A-buffer-values) 1471 (B-values emerge-B-buffer-values)) 1472 (emerge-eval-in-buffer emerge-A-buffer 1473 (emerge-restore-variables emerge-saved-variables 1474 A-values)) 1475 (emerge-eval-in-buffer emerge-B-buffer 1476 (emerge-restore-variables emerge-saved-variables 1477 B-values)))) 1478 1479;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE. 1480;; Return DESIRED-LINE. 1481(defun emerge-goto-line (desired-line current-line) 1482 (forward-line (- desired-line current-line)) 1483 desired-line) 1484 1485(defun emerge-convert-diffs-to-markers (A-buffer 1486 B-buffer 1487 merge-buffer 1488 lineno-list) 1489 (let* (marker-list 1490 (A-point-min (emerge-eval-in-buffer A-buffer (point-min))) 1491 (offset (1- A-point-min)) 1492 (B-point-min (emerge-eval-in-buffer B-buffer (point-min))) 1493 ;; Record current line number in each buffer 1494 ;; so we don't have to count from the beginning. 1495 (a-line 1) 1496 (b-line 1)) 1497 (emerge-eval-in-buffer A-buffer (goto-char (point-min))) 1498 (emerge-eval-in-buffer B-buffer (goto-char (point-min))) 1499 (while lineno-list 1500 (let* ((list-element (car lineno-list)) 1501 a-begin-marker 1502 a-end-marker 1503 b-begin-marker 1504 b-end-marker 1505 merge-begin-marker 1506 merge-end-marker 1507 (a-begin (aref list-element 0)) 1508 (a-end (aref list-element 1)) 1509 (b-begin (aref list-element 2)) 1510 (b-end (aref list-element 3)) 1511 (state (aref list-element 4))) 1512 ;; place markers at the appropriate places in the buffers 1513 (emerge-eval-in-buffer 1514 A-buffer 1515 (setq a-line (emerge-goto-line a-begin a-line)) 1516 (setq a-begin-marker (point-marker)) 1517 (setq a-line (emerge-goto-line a-end a-line)) 1518 (setq a-end-marker (point-marker))) 1519 (emerge-eval-in-buffer 1520 B-buffer 1521 (setq b-line (emerge-goto-line b-begin b-line)) 1522 (setq b-begin-marker (point-marker)) 1523 (setq b-line (emerge-goto-line b-end b-line)) 1524 (setq b-end-marker (point-marker))) 1525 (setq merge-begin-marker (set-marker 1526 (make-marker) 1527 (- (marker-position a-begin-marker) 1528 offset) 1529 merge-buffer)) 1530 (setq merge-end-marker (set-marker 1531 (make-marker) 1532 (- (marker-position a-end-marker) 1533 offset) 1534 merge-buffer)) 1535 ;; record all the markers for this difference 1536 (setq marker-list (cons (vector a-begin-marker a-end-marker 1537 b-begin-marker b-end-marker 1538 merge-begin-marker merge-end-marker 1539 state) 1540 marker-list))) 1541 (setq lineno-list (cdr lineno-list))) 1542 ;; convert the list of difference information into a vector for 1543 ;; fast access 1544 (setq emerge-difference-list (apply 'vector (nreverse marker-list))))) 1545 1546;; If we have an ancestor, select all B variants that we prefer 1547(defun emerge-select-prefer-Bs () 1548 (let ((n 0)) 1549 (while (< n emerge-number-of-differences) 1550 (if (eq (aref (aref emerge-difference-list n) 6) 'prefer-B) 1551 (progn 1552 (emerge-unselect-and-select-difference n t) 1553 (emerge-select-B) 1554 (aset (aref emerge-difference-list n) 6 'prefer-B))) 1555 (setq n (1+ n)))) 1556 (emerge-unselect-and-select-difference -1)) 1557 1558;; Process the local-variables list at the end of the merged file, if 1559;; requested. 1560(defun emerge-handle-local-variables () 1561 (if emerge-process-local-variables 1562 (condition-case err 1563 (hack-local-variables) 1564 (error (message "Local-variables error in merge buffer: %s" 1565 (prin1-to-string err)))))) 1566 1567;;; Common exit routines 1568 1569(defun emerge-write-and-delete (file-out) 1570 ;; clear screen format 1571 (delete-other-windows) 1572 ;; delete A, B, and ancestor buffers, if they haven't been changed 1573 (if (not (buffer-modified-p emerge-A-buffer)) 1574 (kill-buffer emerge-A-buffer)) 1575 (if (not (buffer-modified-p emerge-B-buffer)) 1576 (kill-buffer emerge-B-buffer)) 1577 (if (and emerge-ancestor-buffer 1578 (not (buffer-modified-p emerge-ancestor-buffer))) 1579 (kill-buffer emerge-ancestor-buffer)) 1580 ;; Write merge buffer to file 1581 (and file-out 1582 (write-file file-out))) 1583 1584;;; Commands 1585 1586(defun emerge-recenter (&optional arg) 1587 "Bring the highlighted region of all three merge buffers into view. 1588This brings the buffers into view if they are in windows. 1589With an argument, reestablish the default three-window display." 1590 (interactive "P") 1591 ;; If there is an argument, rebuild the window structure 1592 (if arg 1593 (emerge-setup-windows emerge-A-buffer emerge-B-buffer 1594 emerge-merge-buffer)) 1595 ;; Redisplay whatever buffers are showing, if there is a selected difference 1596 (if (and (>= emerge-current-difference 0) 1597 (< emerge-current-difference emerge-number-of-differences)) 1598 (let* ((merge-buffer emerge-merge-buffer) 1599 (buffer-A emerge-A-buffer) 1600 (buffer-B emerge-B-buffer) 1601 (window-A (get-buffer-window buffer-A 'visible)) 1602 (window-B (get-buffer-window buffer-B 'visible)) 1603 (merge-window (get-buffer-window merge-buffer)) 1604 (diff-vector 1605 (aref emerge-difference-list emerge-current-difference))) 1606 (if window-A (progn 1607 (select-window window-A) 1608 (emerge-position-region 1609 (- (aref diff-vector 0) 1610 (1- emerge-before-flag-length)) 1611 (+ (aref diff-vector 1) 1612 (1- emerge-after-flag-length)) 1613 (1+ (aref diff-vector 0))))) 1614 (if window-B (progn 1615 (select-window window-B) 1616 (emerge-position-region 1617 (- (aref diff-vector 2) 1618 (1- emerge-before-flag-length)) 1619 (+ (aref diff-vector 3) 1620 (1- emerge-after-flag-length)) 1621 (1+ (aref diff-vector 2))))) 1622 (if merge-window (progn 1623 (select-window merge-window) 1624 (emerge-position-region 1625 (- (aref diff-vector 4) 1626 (1- emerge-before-flag-length)) 1627 (+ (aref diff-vector 5) 1628 (1- emerge-after-flag-length)) 1629 (1+ (aref diff-vector 4)))))))) 1630 1631;;; Window scrolling operations 1632;; These operations are designed to scroll all three windows the same amount, 1633;; so as to keep the text in them aligned. 1634 1635;; Perform some operation on all three windows (if they are showing). 1636;; Catches all errors on the operation in the A and B windows, but not 1637;; in the merge window. Usually, errors come from scrolling off the 1638;; beginning or end of the buffer, and this gives a nice error message: 1639;; End of buffer is reported in the merge buffer, but if the scroll was 1640;; possible in the A or B windows, it is performed there before the error 1641;; is reported. 1642(defun emerge-operate-on-windows (operation arg) 1643 (let* ((merge-buffer emerge-merge-buffer) 1644 (buffer-A emerge-A-buffer) 1645 (buffer-B emerge-B-buffer) 1646 (window-A (get-buffer-window buffer-A 'visible)) 1647 (window-B (get-buffer-window buffer-B 'visible)) 1648 (merge-window (get-buffer-window merge-buffer))) 1649 (if window-A (progn 1650 (select-window window-A) 1651 (condition-case nil 1652 (funcall operation arg) 1653 (error)))) 1654 (if window-B (progn 1655 (select-window window-B) 1656 (condition-case nil 1657 (funcall operation arg) 1658 (error)))) 1659 (if merge-window (progn 1660 (select-window merge-window) 1661 (funcall operation arg))))) 1662 1663(defun emerge-scroll-up (&optional arg) 1664 "Scroll up all three merge buffers, if they are in windows. 1665With argument N, scroll N lines; otherwise scroll by nearly 1666the height of the merge window. 1667`C-u -' alone as argument scrolls half the height of the merge window." 1668 (interactive "P") 1669 (emerge-operate-on-windows 1670 'scroll-up 1671 ;; calculate argument to scroll-up 1672 ;; if there is an explicit argument 1673 (if (and arg (not (equal arg '-))) 1674 ;; use it 1675 (prefix-numeric-value arg) 1676 ;; if not, see if we can determine a default amount (the window height) 1677 (let ((merge-window (get-buffer-window emerge-merge-buffer))) 1678 (if (null merge-window) 1679 ;; no window, use nil 1680 nil 1681 (let ((default-amount 1682 (- (window-height merge-window) 1 next-screen-context-lines))) 1683 ;; the window was found 1684 (if arg 1685 ;; C-u as argument means half of default amount 1686 (/ default-amount 2) 1687 ;; no argument means default amount 1688 default-amount))))))) 1689 1690(defun emerge-scroll-down (&optional arg) 1691 "Scroll down all three merge buffers, if they are in windows. 1692With argument N, scroll N lines; otherwise scroll by nearly 1693the height of the merge window. 1694`C-u -' alone as argument scrolls half the height of the merge window." 1695 (interactive "P") 1696 (emerge-operate-on-windows 1697 'scroll-down 1698 ;; calculate argument to scroll-down 1699 ;; if there is an explicit argument 1700 (if (and arg (not (equal arg '-))) 1701 ;; use it 1702 (prefix-numeric-value arg) 1703 ;; if not, see if we can determine a default amount (the window height) 1704 (let ((merge-window (get-buffer-window emerge-merge-buffer))) 1705 (if (null merge-window) 1706 ;; no window, use nil 1707 nil 1708 (let ((default-amount 1709 (- (window-height merge-window) 1 next-screen-context-lines))) 1710 ;; the window was found 1711 (if arg 1712 ;; C-u as argument means half of default amount 1713 (/ default-amount 2) 1714 ;; no argument means default amount 1715 default-amount))))))) 1716 1717(defun emerge-scroll-left (&optional arg) 1718 "Scroll left all three merge buffers, if they are in windows. 1719If an argument is given, that is how many columns are scrolled, else nearly 1720the width of the A and B windows. `C-u -' alone as argument scrolls half the 1721width of the A and B windows." 1722 (interactive "P") 1723 (emerge-operate-on-windows 1724 'scroll-left 1725 ;; calculate argument to scroll-left 1726 ;; if there is an explicit argument 1727 (if (and arg (not (equal arg '-))) 1728 ;; use it 1729 (prefix-numeric-value arg) 1730 ;; if not, see if we can determine a default amount 1731 ;; (half the window width) 1732 (let ((merge-window (get-buffer-window emerge-merge-buffer))) 1733 (if (null merge-window) 1734 ;; no window, use nil 1735 nil 1736 (let ((default-amount 1737 (- (/ (window-width merge-window) 2) 3))) 1738 ;; the window was found 1739 (if arg 1740 ;; C-u as argument means half of default amount 1741 (/ default-amount 2) 1742 ;; no argument means default amount 1743 default-amount))))))) 1744 1745(defun emerge-scroll-right (&optional arg) 1746 "Scroll right all three merge buffers, if they are in windows. 1747If an argument is given, that is how many columns are scrolled, else nearly 1748the width of the A and B windows. `C-u -' alone as argument scrolls half the 1749width of the A and B windows." 1750 (interactive "P") 1751 (emerge-operate-on-windows 1752 'scroll-right 1753 ;; calculate argument to scroll-right 1754 ;; if there is an explicit argument 1755 (if (and arg (not (equal arg '-))) 1756 ;; use it 1757 (prefix-numeric-value arg) 1758 ;; if not, see if we can determine a default amount 1759 ;; (half the window width) 1760 (let ((merge-window (get-buffer-window emerge-merge-buffer))) 1761 (if (null merge-window) 1762 ;; no window, use nil 1763 nil 1764 (let ((default-amount 1765 (- (/ (window-width merge-window) 2) 3))) 1766 ;; the window was found 1767 (if arg 1768 ;; C-u as argument means half of default amount 1769 (/ default-amount 2) 1770 ;; no argument means default amount 1771 default-amount))))))) 1772 1773(defun emerge-scroll-reset () 1774 "Reset horizontal scrolling in Emerge. 1775This resets the horizontal scrolling of all three merge buffers 1776to the left margin, if they are in windows." 1777 (interactive) 1778 (emerge-operate-on-windows 1779 (function (lambda (x) (set-window-hscroll (selected-window) 0))) 1780 nil)) 1781 1782;; Attempt to show the region nicely. 1783;; If there are min-lines lines above and below the region, then don't do 1784;; anything. 1785;; If not, recenter the region to make it so. 1786;; If that isn't possible, remove context lines balancedly from top and bottom 1787;; so the entire region shows. 1788;; If that isn't possible, show the top of the region. 1789;; BEG must be at the beginning of a line. 1790(defun emerge-position-region (beg end pos) 1791 ;; First test whether the entire region is visible with 1792 ;; emerge-min-visible-lines above and below it 1793 (if (not (and (<= (progn 1794 (move-to-window-line emerge-min-visible-lines) 1795 (point)) 1796 beg) 1797 (<= end (progn 1798 (move-to-window-line 1799 (- (1+ emerge-min-visible-lines))) 1800 (point))))) 1801 ;; We failed that test, see if it fits at all 1802 ;; Meanwhile positioning it correctly in case it doesn't fit 1803 (progn 1804 (set-window-start (selected-window) beg) 1805 (if (pos-visible-in-window-p end) 1806 ;; Determine the number of lines that the region occupies 1807 (let ((lines 0)) 1808 (while (> end (progn 1809 (move-to-window-line lines) 1810 (point))) 1811 (setq lines (1+ lines))) 1812 ;; And position the beginning on the right line 1813 (goto-char beg) 1814 (recenter (/ (1+ (- (1- (window-height (selected-window))) 1815 lines)) 1816 2)))))) 1817 (goto-char pos)) 1818 1819(defun emerge-next-difference () 1820 "Advance to the next difference." 1821 (interactive) 1822 (if (< emerge-current-difference emerge-number-of-differences) 1823 (let ((n (1+ emerge-current-difference))) 1824 (while (and emerge-skip-prefers 1825 (< n emerge-number-of-differences) 1826 (memq (aref (aref emerge-difference-list n) 6) 1827 '(prefer-A prefer-B))) 1828 (setq n (1+ n))) 1829 (let ((buffer-read-only nil)) 1830 (emerge-unselect-and-select-difference n))) 1831 (error "At end"))) 1832 1833(defun emerge-previous-difference () 1834 "Go to the previous difference." 1835 (interactive) 1836 (if (> emerge-current-difference -1) 1837 (let ((n (1- emerge-current-difference))) 1838 (while (and emerge-skip-prefers 1839 (> n -1) 1840 (memq (aref (aref emerge-difference-list n) 6) 1841 '(prefer-A prefer-B))) 1842 (setq n (1- n))) 1843 (let ((buffer-read-only nil)) 1844 (emerge-unselect-and-select-difference n))) 1845 (error "At beginning"))) 1846 1847(defun emerge-jump-to-difference (difference-number) 1848 "Go to the N-th difference." 1849 (interactive "p") 1850 (let ((buffer-read-only nil)) 1851 (setq difference-number (1- difference-number)) 1852 (if (and (>= difference-number -1) 1853 (< difference-number (1+ emerge-number-of-differences))) 1854 (emerge-unselect-and-select-difference difference-number) 1855 (error "Bad difference number")))) 1856 1857(defun emerge-abort () 1858 "Abort the Emerge session." 1859 (interactive) 1860 (emerge-quit t)) 1861 1862(defun emerge-quit (arg) 1863 "Finish the Emerge session and exit Emerge. 1864Prefix argument means to abort rather than successfully finish. 1865The difference depends on how the merge was started, 1866but usually means to not write over one of the original files, or to signal 1867to some process which invoked Emerge a failure code. 1868 1869Unselects the selected difference, if any, restores the read-only and modified 1870flags of the merged file buffers, restores the local keymap of the merge 1871buffer, and sets off various emerge flags. Using Emerge commands in this 1872buffer after this will cause serious problems." 1873 (interactive "P") 1874 (if (prog1 1875 (y-or-n-p 1876 (if (not arg) 1877 "Do you really want to successfully finish this merge? " 1878 "Do you really want to abort this merge? ")) 1879 (message "")) 1880 (emerge-really-quit arg))) 1881 1882;; Perform the quit operations. 1883(defun emerge-really-quit (arg) 1884 (setq buffer-read-only nil) 1885 (emerge-unselect-and-select-difference -1) 1886 (emerge-restore-buffer-characteristics) 1887 ;; null out the difference markers so they don't slow down future editing 1888 ;; operations 1889 (mapcar (function (lambda (d) 1890 (set-marker (aref d 0) nil) 1891 (set-marker (aref d 1) nil) 1892 (set-marker (aref d 2) nil) 1893 (set-marker (aref d 3) nil) 1894 (set-marker (aref d 4) nil) 1895 (set-marker (aref d 5) nil))) 1896 emerge-difference-list) 1897 ;; allow them to be garbage collected 1898 (setq emerge-difference-list nil) 1899 ;; restore the local map 1900 (use-local-map emerge-old-keymap) 1901 ;; turn off all the emerge modes 1902 (setq emerge-mode nil) 1903 (setq emerge-fast-mode nil) 1904 (setq emerge-edit-mode nil) 1905 (setq emerge-auto-advance nil) 1906 (setq emerge-skip-prefers nil) 1907 ;; restore mode line 1908 (kill-local-variable 'mode-line-buffer-identification) 1909 (let ((emerge-prefix-argument arg)) 1910 (run-hooks 'emerge-quit-hook))) 1911 1912(defun emerge-select-A (&optional force) 1913 "Select the A variant of this difference. 1914Refuses to function if this difference has been edited, i.e., if it 1915is neither the A nor the B variant. 1916A prefix argument forces the variant to be selected 1917even if the difference has been edited." 1918 (interactive "P") 1919 (let ((operate 1920 (function (lambda () 1921 (emerge-select-A-edit merge-begin merge-end A-begin A-end) 1922 (if emerge-auto-advance 1923 (emerge-next-difference))))) 1924 (operate-no-change 1925 (function (lambda () 1926 (if emerge-auto-advance 1927 (emerge-next-difference)))))) 1928 (emerge-select-version force operate-no-change operate operate))) 1929 1930;; Actually select the A variant 1931(defun emerge-select-A-edit (merge-begin merge-end A-begin A-end) 1932 (emerge-eval-in-buffer 1933 emerge-merge-buffer 1934 (delete-region merge-begin merge-end) 1935 (goto-char merge-begin) 1936 (insert-buffer-substring emerge-A-buffer A-begin A-end) 1937 (goto-char merge-begin) 1938 (aset diff-vector 6 'A) 1939 (emerge-refresh-mode-line))) 1940 1941(defun emerge-select-B (&optional force) 1942 "Select the B variant of this difference. 1943Refuses to function if this difference has been edited, i.e., if it 1944is neither the A nor the B variant. 1945A prefix argument forces the variant to be selected 1946even if the difference has been edited." 1947 (interactive "P") 1948 (let ((operate 1949 (function (lambda () 1950 (emerge-select-B-edit merge-begin merge-end B-begin B-end) 1951 (if emerge-auto-advance 1952 (emerge-next-difference))))) 1953 (operate-no-change 1954 (function (lambda () 1955 (if emerge-auto-advance 1956 (emerge-next-difference)))))) 1957 (emerge-select-version force operate operate-no-change operate))) 1958 1959;; Actually select the B variant 1960(defun emerge-select-B-edit (merge-begin merge-end B-begin B-end) 1961 (emerge-eval-in-buffer 1962 emerge-merge-buffer 1963 (delete-region merge-begin merge-end) 1964 (goto-char merge-begin) 1965 (insert-buffer-substring emerge-B-buffer B-begin B-end) 1966 (goto-char merge-begin) 1967 (aset diff-vector 6 'B) 1968 (emerge-refresh-mode-line))) 1969 1970(defun emerge-default-A () 1971 "Make the A variant the default from here down. 1972This selects the A variant for all differences from here down in the buffer 1973which are still defaulted, i.e., which the user has not selected and for 1974which there is no preference." 1975 (interactive) 1976 (let ((buffer-read-only nil)) 1977 (let ((selected-difference emerge-current-difference) 1978 (n (max emerge-current-difference 0))) 1979 (while (< n emerge-number-of-differences) 1980 (let ((diff-vector (aref emerge-difference-list n))) 1981 (if (eq (aref diff-vector 6) 'default-B) 1982 (progn 1983 (emerge-unselect-and-select-difference n t) 1984 (emerge-select-A) 1985 (aset diff-vector 6 'default-A)))) 1986 (setq n (1+ n)) 1987 (if (zerop (% n 10)) 1988 (message "Setting default to A...%d" n))) 1989 (emerge-unselect-and-select-difference selected-difference))) 1990 (message "Default choice is now A")) 1991 1992(defun emerge-default-B () 1993 "Make the B variant the default from here down. 1994This selects the B variant for all differences from here down in the buffer 1995which are still defaulted, i.e., which the user has not selected and for 1996which there is no preference." 1997 (interactive) 1998 (let ((buffer-read-only nil)) 1999 (let ((selected-difference emerge-current-difference) 2000 (n (max emerge-current-difference 0))) 2001 (while (< n emerge-number-of-differences) 2002 (let ((diff-vector (aref emerge-difference-list n))) 2003 (if (eq (aref diff-vector 6) 'default-A) 2004 (progn 2005 (emerge-unselect-and-select-difference n t) 2006 (emerge-select-B) 2007 (aset diff-vector 6 'default-B)))) 2008 (setq n (1+ n)) 2009 (if (zerop (% n 10)) 2010 (message "Setting default to B...%d" n))) 2011 (emerge-unselect-and-select-difference selected-difference))) 2012 (message "Default choice is now B")) 2013 2014(defun emerge-fast-mode () 2015 "Set fast mode, for Emerge. 2016In this mode ordinary Emacs commands are disabled, and Emerge commands 2017need not be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]." 2018 (interactive) 2019 (setq buffer-read-only t) 2020 (use-local-map emerge-fast-keymap) 2021 (setq emerge-mode t) 2022 (setq emerge-fast-mode t) 2023 (setq emerge-edit-mode nil) 2024 (message "Fast mode set") 2025 (force-mode-line-update)) 2026 2027(defun emerge-edit-mode () 2028 "Set edit mode, for Emerge. 2029In this mode ordinary Emacs commands are available, and Emerge commands 2030must be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]." 2031 (interactive) 2032 (setq buffer-read-only nil) 2033 (use-local-map emerge-edit-keymap) 2034 (setq emerge-mode t) 2035 (setq emerge-fast-mode nil) 2036 (setq emerge-edit-mode t) 2037 (message "Edit mode set") 2038 (force-mode-line-update)) 2039 2040(defun emerge-auto-advance (arg) 2041 "Toggle Auto-Advance mode, for Emerge. 2042This mode causes `emerge-select-A' and `emerge-select-B' to automatically 2043advance to the next difference. 2044With a positive argument, turn on Auto-Advance mode. 2045With a negative argument, turn off Auto-Advance mode." 2046 (interactive "P") 2047 (setq emerge-auto-advance (if (null arg) 2048 (not emerge-auto-advance) 2049 (> (prefix-numeric-value arg) 0))) 2050 (message (if emerge-auto-advance 2051 "Auto-advance set" 2052 "Auto-advance cleared")) 2053 (force-mode-line-update)) 2054 2055(defun emerge-skip-prefers (arg) 2056 "Toggle Skip-Prefers mode, for Emerge. 2057This mode causes `emerge-next-difference' and `emerge-previous-difference' 2058to automatically skip over differences for which there is a preference. 2059With a positive argument, turn on Skip-Prefers mode. 2060With a negative argument, turn off Skip-Prefers mode." 2061 (interactive "P") 2062 (setq emerge-skip-prefers (if (null arg) 2063 (not emerge-skip-prefers) 2064 (> (prefix-numeric-value arg) 0))) 2065 (message (if emerge-skip-prefers 2066 "Skip-prefers set" 2067 "Skip-prefers cleared")) 2068 (force-mode-line-update)) 2069 2070(defun emerge-copy-as-kill-A () 2071 "Put the A variant of this difference in the kill ring." 2072 (interactive) 2073 (emerge-validate-difference) 2074 (let* ((diff-vector 2075 (aref emerge-difference-list emerge-current-difference)) 2076 (A-begin (1+ (aref diff-vector 0))) 2077 (A-end (1- (aref diff-vector 1))) 2078 ;; so further kills don't append 2079 this-command) 2080 (save-excursion 2081 (set-buffer emerge-A-buffer) 2082 (copy-region-as-kill A-begin A-end)))) 2083 2084(defun emerge-copy-as-kill-B () 2085 "Put the B variant of this difference in the kill ring." 2086 (interactive) 2087 (emerge-validate-difference) 2088 (let* ((diff-vector 2089 (aref emerge-difference-list emerge-current-difference)) 2090 (B-begin (1+ (aref diff-vector 2))) 2091 (B-end (1- (aref diff-vector 3))) 2092 ;; so further kills don't append 2093 this-command) 2094 (save-excursion 2095 (set-buffer emerge-B-buffer) 2096 (copy-region-as-kill B-begin B-end)))) 2097 2098(defun emerge-insert-A (arg) 2099 "Insert the A variant of this difference at the point. 2100Leaves point after text, mark before. 2101With prefix argument, puts point before, mark after." 2102 (interactive "P") 2103 (emerge-validate-difference) 2104 (let* ((diff-vector 2105 (aref emerge-difference-list emerge-current-difference)) 2106 (A-begin (1+ (aref diff-vector 0))) 2107 (A-end (1- (aref diff-vector 1))) 2108 (opoint (point)) 2109 (buffer-read-only nil)) 2110 (insert-buffer-substring emerge-A-buffer A-begin A-end) 2111 (if (not arg) 2112 (set-mark opoint) 2113 (set-mark (point)) 2114 (goto-char opoint)))) 2115 2116(defun emerge-insert-B (arg) 2117 "Insert the B variant of this difference at the point. 2118Leaves point after text, mark before. 2119With prefix argument, puts point before, mark after." 2120 (interactive "P") 2121 (emerge-validate-difference) 2122 (let* ((diff-vector 2123 (aref emerge-difference-list emerge-current-difference)) 2124 (B-begin (1+ (aref diff-vector 2))) 2125 (B-end (1- (aref diff-vector 3))) 2126 (opoint (point)) 2127 (buffer-read-only nil)) 2128 (insert-buffer-substring emerge-B-buffer B-begin B-end) 2129 (if (not arg) 2130 (set-mark opoint) 2131 (set-mark (point)) 2132 (goto-char opoint)))) 2133 2134(defun emerge-mark-difference (arg) 2135 "Leaves the point before this difference and the mark after it. 2136With prefix argument, puts mark before, point after." 2137 (interactive "P") 2138 (emerge-validate-difference) 2139 (let* ((diff-vector 2140 (aref emerge-difference-list emerge-current-difference)) 2141 (merge-begin (1+ (aref diff-vector 4))) 2142 (merge-end (1- (aref diff-vector 5)))) 2143 (if (not arg) 2144 (progn 2145 (goto-char merge-begin) 2146 (set-mark merge-end)) 2147 (goto-char merge-end) 2148 (set-mark merge-begin)))) 2149 2150(defun emerge-file-names () 2151 "Show the names of the buffers or files being operated on by Emerge. 2152Use C-u l to reset the windows afterward." 2153 (interactive) 2154 (delete-other-windows) 2155 (let ((temp-buffer-show-function 2156 (function (lambda (buf) 2157 (split-window-vertically) 2158 (switch-to-buffer buf) 2159 (other-window 1))))) 2160 (with-output-to-temp-buffer "*Help*" 2161 (emerge-eval-in-buffer emerge-A-buffer 2162 (if buffer-file-name 2163 (progn 2164 (princ "File A is: ") 2165 (princ buffer-file-name)) 2166 (progn 2167 (princ "Buffer A is: ") 2168 (princ (buffer-name)))) 2169 (princ "\n")) 2170 (emerge-eval-in-buffer emerge-B-buffer 2171 (if buffer-file-name 2172 (progn 2173 (princ "File B is: ") 2174 (princ buffer-file-name)) 2175 (progn 2176 (princ "Buffer B is: ") 2177 (princ (buffer-name)))) 2178 (princ "\n")) 2179 (if emerge-ancestor-buffer 2180 (emerge-eval-in-buffer emerge-ancestor-buffer 2181 (if buffer-file-name 2182 (progn 2183 (princ "Ancestor file is: ") 2184 (princ buffer-file-name)) 2185 (progn 2186 (princ "Ancestor buffer is: ") 2187 (princ (buffer-name)))) 2188 (princ "\n"))) 2189 (princ emerge-output-description) 2190 (save-excursion 2191 (set-buffer standard-output) 2192 (help-mode))))) 2193 2194(defun emerge-join-differences (arg) 2195 "Join the selected difference with the following one. 2196With a prefix argument, join with the preceding one." 2197 (interactive "P") 2198 (let ((n emerge-current-difference)) 2199 ;; adjust n to be first difference to join 2200 (if arg 2201 (setq n (1- n))) 2202 ;; n and n+1 are the differences to join 2203 ;; check that they are both differences 2204 (if (or (< n 0) (>= n (1- emerge-number-of-differences))) 2205 (error "Incorrect differences to join")) 2206 ;; remove the flags 2207 (emerge-unselect-difference emerge-current-difference) 2208 ;; decrement total number of differences 2209 (setq emerge-number-of-differences (1- emerge-number-of-differences)) 2210 ;; build new differences vector 2211 (let ((i 0) 2212 (new-differences (make-vector emerge-number-of-differences nil))) 2213 (while (< i emerge-number-of-differences) 2214 (aset new-differences i 2215 (cond 2216 ((< i n) (aref emerge-difference-list i)) 2217 ((> i n) (aref emerge-difference-list (1+ i))) 2218 (t (let ((prev (aref emerge-difference-list i)) 2219 (next (aref emerge-difference-list (1+ i)))) 2220 (vector (aref prev 0) 2221 (aref next 1) 2222 (aref prev 2) 2223 (aref next 3) 2224 (aref prev 4) 2225 (aref next 5) 2226 (let ((ps (aref prev 6)) 2227 (ns (aref next 6))) 2228 (cond 2229 ((eq ps ns) 2230 ps) 2231 ((and (or (eq ps 'B) (eq ps 'prefer-B)) 2232 (or (eq ns 'B) (eq ns 'prefer-B))) 2233 'B) 2234 (t 'A)))))))) 2235 (setq i (1+ i))) 2236 (setq emerge-difference-list new-differences)) 2237 ;; set the current difference correctly 2238 (setq emerge-current-difference n) 2239 ;; fix the mode line 2240 (emerge-refresh-mode-line) 2241 ;; reinsert the flags 2242 (emerge-select-difference emerge-current-difference) 2243 (emerge-recenter))) 2244 2245(defun emerge-split-difference () 2246 "Split the current difference where the points are in the three windows." 2247 (interactive) 2248 (let ((n emerge-current-difference)) 2249 ;; check that this is a valid difference 2250 (emerge-validate-difference) 2251 ;; get the point values and old difference 2252 (let ((A-point (emerge-eval-in-buffer emerge-A-buffer 2253 (point-marker))) 2254 (B-point (emerge-eval-in-buffer emerge-B-buffer 2255 (point-marker))) 2256 (merge-point (point-marker)) 2257 (old-diff (aref emerge-difference-list n))) 2258 ;; check location of the points, give error if they aren't in the 2259 ;; differences 2260 (if (or (< A-point (aref old-diff 0)) 2261 (> A-point (aref old-diff 1))) 2262 (error "Point outside of difference in A buffer")) 2263 (if (or (< B-point (aref old-diff 2)) 2264 (> B-point (aref old-diff 3))) 2265 (error "Point outside of difference in B buffer")) 2266 (if (or (< merge-point (aref old-diff 4)) 2267 (> merge-point (aref old-diff 5))) 2268 (error "Point outside of difference in merge buffer")) 2269 ;; remove the flags 2270 (emerge-unselect-difference emerge-current-difference) 2271 ;; increment total number of differences 2272 (setq emerge-number-of-differences (1+ emerge-number-of-differences)) 2273 ;; build new differences vector 2274 (let ((i 0) 2275 (new-differences (make-vector emerge-number-of-differences nil))) 2276 (while (< i emerge-number-of-differences) 2277 (aset new-differences i 2278 (cond 2279 ((< i n) 2280 (aref emerge-difference-list i)) 2281 ((> i (1+ n)) 2282 (aref emerge-difference-list (1- i))) 2283 ((= i n) 2284 (vector (aref old-diff 0) 2285 A-point 2286 (aref old-diff 2) 2287 B-point 2288 (aref old-diff 4) 2289 merge-point 2290 (aref old-diff 6))) 2291 (t 2292 (vector (copy-marker A-point) 2293 (aref old-diff 1) 2294 (copy-marker B-point) 2295 (aref old-diff 3) 2296 (copy-marker merge-point) 2297 (aref old-diff 5) 2298 (aref old-diff 6))))) 2299 (setq i (1+ i))) 2300 (setq emerge-difference-list new-differences)) 2301 ;; set the current difference correctly 2302 (setq emerge-current-difference n) 2303 ;; fix the mode line 2304 (emerge-refresh-mode-line) 2305 ;; reinsert the flags 2306 (emerge-select-difference emerge-current-difference) 2307 (emerge-recenter)))) 2308 2309(defun emerge-trim-difference () 2310 "Trim lines off top and bottom of difference that are the same. 2311If lines are the same in both the A and the B versions, strip them off. 2312\(This can happen when the A and B versions have common lines that the 2313ancestor version does not share.)" 2314 (interactive) 2315 ;; make sure we are in a real difference 2316 (emerge-validate-difference) 2317 ;; remove the flags 2318 (emerge-unselect-difference emerge-current-difference) 2319 (let* ((diff (aref emerge-difference-list emerge-current-difference)) 2320 (top-a (marker-position (aref diff 0))) 2321 (bottom-a (marker-position (aref diff 1))) 2322 (top-b (marker-position (aref diff 2))) 2323 (bottom-b (marker-position (aref diff 3))) 2324 (top-m (marker-position (aref diff 4))) 2325 (bottom-m (marker-position (aref diff 5))) 2326 size success sa sb sm) 2327 ;; move down the tops of the difference regions as much as possible 2328 ;; Try advancing comparing 1000 chars at a time. 2329 ;; When that fails, go 500 chars at a time, and so on. 2330 (setq size 1000) 2331 (while (> size 0) 2332 (setq success t) 2333 (while success 2334 (setq size (min size (- bottom-a top-a) (- bottom-b top-b) 2335 (- bottom-m top-m))) 2336 (setq sa (emerge-eval-in-buffer emerge-A-buffer 2337 (buffer-substring top-a 2338 (+ size top-a)))) 2339 (setq sb (emerge-eval-in-buffer emerge-B-buffer 2340 (buffer-substring top-b 2341 (+ size top-b)))) 2342 (setq sm (buffer-substring top-m (+ size top-m))) 2343 (setq success (and (> size 0) (equal sa sb) (equal sb sm))) 2344 (if success 2345 (setq top-a (+ top-a size) 2346 top-b (+ top-b size) 2347 top-m (+ top-m size)))) 2348 (setq size (/ size 2))) 2349 ;; move up the bottoms of the difference regions as much as possible 2350 ;; Try advancing comparing 1000 chars at a time. 2351 ;; When that fails, go 500 chars at a time, and so on. 2352 (setq size 1000) 2353 (while (> size 0) 2354 (setq success t) 2355 (while success 2356 (setq size (min size (- bottom-a top-a) (- bottom-b top-b) 2357 (- bottom-m top-m))) 2358 (setq sa (emerge-eval-in-buffer emerge-A-buffer 2359 (buffer-substring (- bottom-a size) 2360 bottom-a))) 2361 (setq sb (emerge-eval-in-buffer emerge-B-buffer 2362 (buffer-substring (- bottom-b size) 2363 bottom-b))) 2364 (setq sm (buffer-substring (- bottom-m size) bottom-m)) 2365 (setq success (and (> size 0) (equal sa sb) (equal sb sm))) 2366 (if success 2367 (setq bottom-a (- bottom-a size) 2368 bottom-b (- bottom-b size) 2369 bottom-m (- bottom-m size)))) 2370 (setq size (/ size 2))) 2371 ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends 2372 ;; of the difference regions. Move them to the beginning of lines, as 2373 ;; appropriate. 2374 (emerge-eval-in-buffer emerge-A-buffer 2375 (goto-char top-a) 2376 (beginning-of-line) 2377 (aset diff 0 (point-marker)) 2378 (goto-char bottom-a) 2379 (beginning-of-line 2) 2380 (aset diff 1 (point-marker))) 2381 (emerge-eval-in-buffer emerge-B-buffer 2382 (goto-char top-b) 2383 (beginning-of-line) 2384 (aset diff 2 (point-marker)) 2385 (goto-char bottom-b) 2386 (beginning-of-line 2) 2387 (aset diff 3 (point-marker))) 2388 (goto-char top-m) 2389 (beginning-of-line) 2390 (aset diff 4 (point-marker)) 2391 (goto-char bottom-m) 2392 (beginning-of-line 2) 2393 (aset diff 5 (point-marker)) 2394 ;; put the flags back in, recenter the display 2395 (emerge-select-difference emerge-current-difference) 2396 (emerge-recenter))) 2397 2398(defun emerge-find-difference (arg) 2399 "Find the difference containing the current position of the point. 2400If there is no containing difference and the prefix argument is positive, 2401it finds the nearest following difference. A negative prefix argument finds 2402the nearest previous difference." 2403 (interactive "P") 2404 (cond ((eq (current-buffer) emerge-A-buffer) 2405 (emerge-find-difference-A arg)) 2406 ((eq (current-buffer) emerge-B-buffer) 2407 (emerge-find-difference-B arg)) 2408 (t (emerge-find-difference-merge arg)))) 2409 2410(defun emerge-find-difference-merge (arg) 2411 "Find the difference containing point, in the merge buffer. 2412If there is no containing difference and the prefix argument is positive, 2413it finds the nearest following difference. A negative prefix argument finds 2414the nearest previous difference." 2415 (interactive "P") 2416 ;; search for the point in the merge buffer, using the markers 2417 ;; for the beginning and end of the differences in the merge buffer 2418 (emerge-find-difference1 arg (point) 4 5)) 2419 2420(defun emerge-find-difference-A (arg) 2421 "Find the difference containing point, in the A buffer. 2422This command must be executed in the merge buffer. 2423If there is no containing difference and the prefix argument is positive, 2424it finds the nearest following difference. A negative prefix argument finds 2425the nearest previous difference." 2426 (interactive "P") 2427 ;; search for the point in the A buffer, using the markers 2428 ;; for the beginning and end of the differences in the A buffer 2429 (emerge-find-difference1 arg 2430 (emerge-eval-in-buffer emerge-A-buffer (point)) 2431 0 1)) 2432 2433(defun emerge-find-difference-B (arg) 2434 "Find the difference containing point, in the B buffer. 2435This command must be executed in the merge buffer. 2436If there is no containing difference and the prefix argument is positive, 2437it finds the nearest following difference. A negative prefix argument finds 2438the nearest previous difference." 2439 (interactive "P") 2440 ;; search for the point in the B buffer, using the markers 2441 ;; for the beginning and end of the differences in the B buffer 2442 (emerge-find-difference1 arg 2443 (emerge-eval-in-buffer emerge-B-buffer (point)) 2444 2 3)) 2445 2446(defun emerge-find-difference1 (arg location begin end) 2447 (let* ((index 2448 ;; find first difference containing or after the current position 2449 (catch 'search 2450 (let ((n 0)) 2451 (while (< n emerge-number-of-differences) 2452 (let ((diff-vector (aref emerge-difference-list n))) 2453 (if (<= location (marker-position (aref diff-vector end))) 2454 (throw 'search n))) 2455 (setq n (1+ n)))) 2456 emerge-number-of-differences)) 2457 (contains 2458 ;; whether the found difference contains the current position 2459 (and (< index emerge-number-of-differences) 2460 (<= (marker-position (aref (aref emerge-difference-list index) 2461 begin)) 2462 location))) 2463 (arg-value 2464 ;; numeric value of prefix argument 2465 (prefix-numeric-value arg))) 2466 (emerge-unselect-and-select-difference 2467 (cond 2468 ;; if the point is in a difference, select it 2469 (contains index) 2470 ;; if the arg is nil and the point is not in a difference, error 2471 ((null arg) (error "No difference contains point")) 2472 ;; if the arg is positive, select the following difference 2473 ((> arg-value 0) 2474 (if (< index emerge-number-of-differences) 2475 index 2476 (error "No difference contains or follows point"))) 2477 ;; if the arg is negative, select the preceding difference 2478 (t 2479 (if (> index 0) 2480 (1- index) 2481 (error "No difference contains or precedes point"))))))) 2482 2483(defun emerge-line-numbers () 2484 "Display the current line numbers. 2485This function displays the line numbers of the points in the A, B, and 2486merge buffers." 2487 (interactive) 2488 (let* ((valid-diff 2489 (and (>= emerge-current-difference 0) 2490 (< emerge-current-difference emerge-number-of-differences))) 2491 (diff (and valid-diff 2492 (aref emerge-difference-list emerge-current-difference))) 2493 (merge-line (emerge-line-number-in-buf 4 5)) 2494 (A-line (emerge-eval-in-buffer emerge-A-buffer 2495 (emerge-line-number-in-buf 0 1))) 2496 (B-line (emerge-eval-in-buffer emerge-B-buffer 2497 (emerge-line-number-in-buf 2 3)))) 2498 (message "At lines: merge = %d, A = %d, B = %d" 2499 merge-line A-line B-line))) 2500 2501(defun emerge-line-number-in-buf (begin-marker end-marker) 2502 (let (temp) 2503 (setq temp (save-excursion 2504 (beginning-of-line) 2505 (1+ (count-lines 1 (point))))) 2506 (if valid-diff 2507 (progn 2508 (if (> (point) (aref diff begin-marker)) 2509 (setq temp (- temp emerge-before-flag-lines))) 2510 (if (> (point) (aref diff end-marker)) 2511 (setq temp (- temp emerge-after-flag-lines))))) 2512 temp)) 2513 2514(defun emerge-set-combine-template (string &optional localize) 2515 "Set `emerge-combine-versions-template' to STRING. 2516This value controls how `emerge-combine-versions' combines the two versions. 2517With prefix argument, `emerge-combine-versions-template' is made local to this 2518merge buffer. Localization is permanent for any particular merge buffer." 2519 (interactive "s\nP") 2520 (if localize 2521 (make-local-variable 'emerge-combine-versions-template)) 2522 (setq emerge-combine-versions-template string) 2523 (message 2524 (if (assq 'emerge-combine-versions-template (buffer-local-variables)) 2525 "emerge-set-combine-versions-template set locally" 2526 "emerge-set-combine-versions-template set"))) 2527 2528(defun emerge-set-combine-versions-template (start end &optional localize) 2529 "Copy region into `emerge-combine-versions-template'. 2530This controls how `emerge-combine-versions' will combine the two versions. 2531With prefix argument, `emerge-combine-versions-template' is made local to this 2532merge buffer. Localization is permanent for any particular merge buffer." 2533 (interactive "r\nP") 2534 (if localize 2535 (make-local-variable 'emerge-combine-versions-template)) 2536 (setq emerge-combine-versions-template (buffer-substring start end)) 2537 (message 2538 (if (assq 'emerge-combine-versions-template (buffer-local-variables)) 2539 "emerge-set-combine-versions-template set locally." 2540 "emerge-set-combine-versions-template set."))) 2541 2542(defun emerge-combine-versions (&optional force) 2543 "Combine versions using the template in `emerge-combine-versions-template'. 2544Refuses to function if this difference has been edited, i.e., if it is 2545neither the A nor the B variant. 2546An argument forces the variant to be selected even if the difference has 2547been edited." 2548 (interactive "P") 2549 (emerge-combine-versions-internal emerge-combine-versions-template force)) 2550 2551(defun emerge-combine-versions-register (char &optional force) 2552 "Combine the two versions using the template in register REG. 2553See documentation of the variable `emerge-combine-versions-template' 2554for how the template is interpreted. 2555Refuses to function if this difference has been edited, i.e., if it is 2556neither the A nor the B variant. 2557An argument forces the variant to be selected even if the difference has 2558been edited." 2559 (interactive "cRegister containing template: \nP") 2560 (let ((template (get-register char))) 2561 (if (not (stringp template)) 2562 (error "Register does not contain text")) 2563 (emerge-combine-versions-internal template force))) 2564 2565(defun emerge-combine-versions-internal (template force) 2566 (let ((operate 2567 (function (lambda () 2568 (emerge-combine-versions-edit merge-begin merge-end 2569 A-begin A-end B-begin B-end) 2570 (if emerge-auto-advance 2571 (emerge-next-difference)))))) 2572 (emerge-select-version force operate operate operate))) 2573 2574(defun emerge-combine-versions-edit (merge-begin merge-end 2575 A-begin A-end B-begin B-end) 2576 (emerge-eval-in-buffer 2577 emerge-merge-buffer 2578 (delete-region merge-begin merge-end) 2579 (goto-char merge-begin) 2580 (let ((i 0)) 2581 (while (< i (length template)) 2582 (let ((c (aref template i))) 2583 (if (= c ?%) 2584 (progn 2585 (setq i (1+ i)) 2586 (setq c 2587 (condition-case nil 2588 (aref template i) 2589 (error ?%))) 2590 (cond ((= c ?a) 2591 (insert-buffer-substring emerge-A-buffer A-begin A-end)) 2592 ((= c ?b) 2593 (insert-buffer-substring emerge-B-buffer B-begin B-end)) 2594 ((= c ?%) 2595 (insert ?%)) 2596 (t 2597 (insert c)))) 2598 (insert c))) 2599 (setq i (1+ i)))) 2600 (goto-char merge-begin) 2601 (aset diff-vector 6 'combined) 2602 (emerge-refresh-mode-line))) 2603 2604(defun emerge-set-merge-mode (mode) 2605 "Set the major mode in a merge buffer. 2606Overrides any change that the mode might make to the mode line or local 2607keymap. Leaves merge in fast mode." 2608 (interactive 2609 (list (intern (completing-read "New major mode for merge buffer: " 2610 obarray 'commandp t nil)))) 2611 (funcall mode) 2612 (emerge-refresh-mode-line) 2613 (if emerge-fast-mode 2614 (emerge-fast-mode) 2615 (emerge-edit-mode))) 2616 2617(defun emerge-one-line-window () 2618 (interactive) 2619 (let ((window-min-height 1)) 2620 (shrink-window (- (window-height) 2)))) 2621 2622;;; Support routines 2623 2624;; Select a difference by placing the visual flags around the appropriate 2625;; group of lines in the A, B, and merge buffers 2626(defun emerge-select-difference (n) 2627 (let ((emerge-globalized-difference-list emerge-difference-list) 2628 (emerge-globalized-number-of-differences emerge-number-of-differences)) 2629 (emerge-place-flags-in-buffer emerge-A-buffer n 0 1) 2630 (emerge-place-flags-in-buffer emerge-B-buffer n 2 3) 2631 (emerge-place-flags-in-buffer nil n 4 5)) 2632 (run-hooks 'emerge-select-hook)) 2633 2634(defun emerge-place-flags-in-buffer (buffer difference before-index 2635 after-index) 2636 (if buffer 2637 (emerge-eval-in-buffer 2638 buffer 2639 (emerge-place-flags-in-buffer1 difference before-index after-index)) 2640 (emerge-place-flags-in-buffer1 difference before-index after-index))) 2641 2642(defun emerge-place-flags-in-buffer1 (difference before-index after-index) 2643 (let ((buffer-read-only nil)) 2644 ;; insert the flag before the difference 2645 (let ((before (aref (aref emerge-globalized-difference-list difference) 2646 before-index)) 2647 here) 2648 (goto-char before) 2649 ;; insert the flag itself 2650 (insert-before-markers emerge-before-flag) 2651 (setq here (point)) 2652 ;; Put the marker(s) referring to this position 1 character before the 2653 ;; end of the flag, so it won't be damaged by the user. 2654 ;; This gets a bit tricky, as there could be a number of markers 2655 ;; that have to be moved. 2656 (set-marker before (1- before)) 2657 (let ((n (1- difference)) after-marker before-marker diff-list) 2658 (while (and 2659 (>= n 0) 2660 (progn 2661 (setq diff-list (aref emerge-globalized-difference-list n) 2662 after-marker (aref diff-list after-index)) 2663 (= after-marker here))) 2664 (set-marker after-marker (1- after-marker)) 2665 (setq before-marker (aref diff-list before-index)) 2666 (if (= before-marker here) 2667 (setq before-marker (1- before-marker))) 2668 (setq n (1- n))))) 2669 ;; insert the flag after the difference 2670 (let* ((after (aref (aref emerge-globalized-difference-list difference) 2671 after-index)) 2672 (here (marker-position after))) 2673 (goto-char here) 2674 ;; insert the flag itself 2675 (insert emerge-after-flag) 2676 ;; Put the marker(s) referring to this position 1 character after the 2677 ;; beginning of the flag, so it won't be damaged by the user. 2678 ;; This gets a bit tricky, as there could be a number of markers 2679 ;; that have to be moved. 2680 (set-marker after (1+ after)) 2681 (let ((n (1+ difference)) before-marker after-marker diff-list) 2682 (while (and 2683 (< n emerge-globalized-number-of-differences) 2684 (progn 2685 (setq diff-list (aref emerge-globalized-difference-list n) 2686 before-marker (aref diff-list before-index)) 2687 (= before-marker here))) 2688 (set-marker before-marker (1+ before-marker)) 2689 (setq after-marker (aref diff-list after-index)) 2690 (if (= after-marker here) 2691 (setq after-marker (1+ after-marker))) 2692 (setq n (1+ n))))))) 2693 2694;; Unselect a difference by removing the visual flags in the buffers. 2695(defun emerge-unselect-difference (n) 2696 (let ((diff-vector (aref emerge-difference-list n))) 2697 (emerge-remove-flags-in-buffer emerge-A-buffer 2698 (aref diff-vector 0) (aref diff-vector 1)) 2699 (emerge-remove-flags-in-buffer emerge-B-buffer 2700 (aref diff-vector 2) (aref diff-vector 3)) 2701 (emerge-remove-flags-in-buffer emerge-merge-buffer 2702 (aref diff-vector 4) (aref diff-vector 5))) 2703 (run-hooks 'emerge-unselect-hook)) 2704 2705(defun emerge-remove-flags-in-buffer (buffer before after) 2706 (emerge-eval-in-buffer 2707 buffer 2708 (let ((buffer-read-only nil)) 2709 ;; remove the flags, if they're there 2710 (goto-char (- before (1- emerge-before-flag-length))) 2711 (if (looking-at emerge-before-flag-match) 2712 (delete-char emerge-before-flag-length) 2713 ;; the flag isn't there 2714 (ding) 2715 (message "Trouble removing flag")) 2716 (goto-char (1- after)) 2717 (if (looking-at emerge-after-flag-match) 2718 (delete-char emerge-after-flag-length) 2719 ;; the flag isn't there 2720 (ding) 2721 (message "Trouble removing flag"))))) 2722 2723;; Select a difference, removing any flags that exist now. 2724(defun emerge-unselect-and-select-difference (n &optional suppress-display) 2725 (if (and (>= emerge-current-difference 0) 2726 (< emerge-current-difference emerge-number-of-differences)) 2727 (emerge-unselect-difference emerge-current-difference)) 2728 (if (and (>= n 0) (< n emerge-number-of-differences)) 2729 (progn 2730 (emerge-select-difference n) 2731 (let* ((diff-vector (aref emerge-difference-list n)) 2732 (selection-type (aref diff-vector 6))) 2733 (if (eq selection-type 'default-A) 2734 (aset diff-vector 6 'A) 2735 (if (eq selection-type 'default-B) 2736 (aset diff-vector 6 'B)))))) 2737 (setq emerge-current-difference n) 2738 (if (not suppress-display) 2739 (progn 2740 (emerge-recenter) 2741 (emerge-refresh-mode-line)))) 2742 2743;; Perform tests to see whether user should be allowed to select a version 2744;; of this difference: 2745;; a valid difference has been selected; and 2746;; the difference text in the merge buffer is: 2747;; the A version (execute a-version), or 2748;; the B version (execute b-version), or 2749;; empty (execute neither-version), or 2750;; argument FORCE is true (execute neither-version) 2751;; Otherwise, signal an error. 2752(defun emerge-select-version (force a-version b-version neither-version) 2753 (emerge-validate-difference) 2754 (let ((buffer-read-only nil)) 2755 (let* ((diff-vector 2756 (aref emerge-difference-list emerge-current-difference)) 2757 (A-begin (1+ (aref diff-vector 0))) 2758 (A-end (1- (aref diff-vector 1))) 2759 (B-begin (1+ (aref diff-vector 2))) 2760 (B-end (1- (aref diff-vector 3))) 2761 (merge-begin (1+ (aref diff-vector 4))) 2762 (merge-end (1- (aref diff-vector 5)))) 2763 (if (emerge-compare-buffers emerge-A-buffer A-begin A-end 2764 emerge-merge-buffer merge-begin 2765 merge-end) 2766 (funcall a-version) 2767 (if (emerge-compare-buffers emerge-B-buffer B-begin B-end 2768 emerge-merge-buffer merge-begin 2769 merge-end) 2770 (funcall b-version) 2771 (if (or force (= merge-begin merge-end)) 2772 (funcall neither-version) 2773 (error "This difference region has been edited"))))))) 2774 2775;; Read a file name, handling all of the various defaulting rules. 2776 2777(defun emerge-read-file-name (prompt alternative-default-dir default-file 2778 A-file must-match) 2779 ;; `prompt' should not have trailing ": ", so that it can be modified 2780 ;; according to context. 2781 ;; If alternative-default-dir is non-nil, it should be used as the default 2782 ;; directory instead if default-directory, if emerge-default-last-directories 2783 ;; is set. 2784 ;; If default-file is set, it should be used as the default value. 2785 ;; If A-file is set, and its directory is different from 2786 ;; alternative-default-dir, and if emerge-default-last-directories is set, 2787 ;; the default file should be the last part of A-file in the default 2788 ;; directory. (Overriding default-file.) 2789 (cond 2790 ;; If this is not the A-file argument (shown by non-nil A-file), and 2791 ;; if emerge-default-last-directories is set, and 2792 ;; the default directory exists but is not the same as the directory of the 2793 ;; A-file, 2794 ;; then make the default file have the same name as the A-file, but in 2795 ;; the default directory. 2796 ((and emerge-default-last-directories 2797 A-file 2798 alternative-default-dir 2799 (not (string-equal alternative-default-dir 2800 (file-name-directory A-file)))) 2801 (read-file-name (format "%s (default %s): " 2802 prompt (file-name-nondirectory A-file)) 2803 alternative-default-dir 2804 (concat alternative-default-dir 2805 (file-name-nondirectory A-file)) 2806 (and must-match 'confirm))) 2807 ;; If there is a default file, use it. 2808 (default-file 2809 (read-file-name (format "%s (default %s): " prompt default-file) 2810 ;; If emerge-default-last-directories is set, use the 2811 ;; directory from the same argument of the last call of 2812 ;; Emerge as the default for this argument. 2813 (and emerge-default-last-directories 2814 alternative-default-dir) 2815 default-file (and must-match 'confirm))) 2816 (t 2817 (read-file-name (concat prompt ": ") 2818 ;; If emerge-default-last-directories is set, use the 2819 ;; directory from the same argument of the last call of 2820 ;; Emerge as the default for this argument. 2821 (and emerge-default-last-directories 2822 alternative-default-dir) 2823 nil (and must-match 'confirm))))) 2824 2825;; Revise the mode line to display which difference we have selected 2826 2827(defun emerge-refresh-mode-line () 2828 (setq mode-line-buffer-identification 2829 (list (format "Emerge: %%b diff %d of %d%s" 2830 (1+ emerge-current-difference) 2831 emerge-number-of-differences 2832 (if (and (>= emerge-current-difference 0) 2833 (< emerge-current-difference 2834 emerge-number-of-differences)) 2835 (cdr (assq (aref (aref emerge-difference-list 2836 emerge-current-difference) 2837 6) 2838 '((A . " - A") 2839 (B . " - B") 2840 (prefer-A . " - A*") 2841 (prefer-B . " - B*") 2842 (combined . " - comb")))) 2843 "")))) 2844 (force-mode-line-update)) 2845 2846;; compare two regions in two buffers for containing the same text 2847(defun emerge-compare-buffers (buffer-x x-begin x-end buffer-y y-begin y-end) 2848 ;; first check that the two regions are the same length 2849 (if (not (and (= (- x-end x-begin) (- y-end y-begin)))) 2850 nil 2851 (catch 'exit 2852 (while (< x-begin x-end) 2853 ;; bite off and compare no more than 1000 characters at a time 2854 (let* ((compare-length (min (- x-end x-begin) 1000)) 2855 (x-string (emerge-eval-in-buffer 2856 buffer-x 2857 (buffer-substring x-begin 2858 (+ x-begin compare-length)))) 2859 (y-string (emerge-eval-in-buffer 2860 buffer-y 2861 (buffer-substring y-begin 2862 (+ y-begin compare-length))))) 2863 (if (not (string-equal x-string y-string)) 2864 (throw 'exit nil) 2865 (setq x-begin (+ x-begin compare-length)) 2866 (setq y-begin (+ y-begin compare-length))))) 2867 t))) 2868 2869;; Construct a unique buffer name. 2870;; The first one tried is prefixsuffix, then prefix<2>suffix, 2871;; prefix<3>suffix, etc. 2872(defun emerge-unique-buffer-name (prefix suffix) 2873 (if (null (get-buffer (concat prefix suffix))) 2874 (concat prefix suffix) 2875 (let ((n 2)) 2876 (while (get-buffer (format "%s<%d>%s" prefix n suffix)) 2877 (setq n (1+ n))) 2878 (format "%s<%d>%s" prefix n suffix)))) 2879 2880;; Verify that we have a difference selected. 2881(defun emerge-validate-difference () 2882 (if (not (and (>= emerge-current-difference 0) 2883 (< emerge-current-difference emerge-number-of-differences))) 2884 (error "No difference selected"))) 2885 2886;;; Functions for saving and restoring a batch of variables 2887 2888;; These functions save (get the values of) and restore (set the values of) 2889;; a list of variables. The argument is a list of symbols (the names of 2890;; the variables). A list element can also be a list of two functions, 2891;; the first of which (when called with no arguments) gets the value, and 2892;; the second (when called with a value as an argument) sets the value. 2893;; A "function" is anything that funcall can handle as an argument. 2894 2895(defun emerge-save-variables (vars) 2896 (mapcar (function (lambda (v) (if (symbolp v) 2897 (symbol-value v) 2898 (funcall (car v))))) 2899 vars)) 2900 2901(defun emerge-restore-variables (vars values) 2902 (while vars 2903 (let ((var (car vars)) 2904 (value (car values))) 2905 (if (symbolp var) 2906 (set var value) 2907 (funcall (car (cdr var)) value))) 2908 (setq vars (cdr vars)) 2909 (setq values (cdr values)))) 2910 2911;; Make a temporary file that only we have access to. 2912;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix. 2913(defun emerge-make-temp-file (prefix) 2914 (let (f (old-modes (default-file-modes))) 2915 (unwind-protect 2916 (progn 2917 (set-default-file-modes emerge-temp-file-mode) 2918 (setq f (make-temp-file (concat emerge-temp-file-prefix prefix)))) 2919 (set-default-file-modes old-modes)) 2920 f)) 2921 2922;;; Functions that query the user before he can write out the current buffer. 2923 2924(defun emerge-query-write-file () 2925 "Ask the user whether to write out an incomplete merge. 2926If answer is yes, call `write-file' to do so. See `emerge-query-and-call' 2927for details of the querying process." 2928 (interactive) 2929 (emerge-query-and-call 'write-file)) 2930 2931(defun emerge-query-save-buffer () 2932 "Ask the user whether to save an incomplete merge. 2933If answer is yes, call `save-buffer' to do so. See `emerge-query-and-call' 2934for details of the querying process." 2935 (interactive) 2936 (emerge-query-and-call 'save-buffer)) 2937 2938(defun emerge-query-and-call (command) 2939 "Ask the user whether to save or write out the incomplete merge. 2940If answer is yes, call COMMAND interactively. During the call, the flags 2941around the current difference are removed." 2942 (if (yes-or-no-p "Do you really write to write out this unfinished merge? ") 2943 ;; He really wants to do it -- unselect the difference for the duration 2944 (progn 2945 (if (and (>= emerge-current-difference 0) 2946 (< emerge-current-difference emerge-number-of-differences)) 2947 (emerge-unselect-difference emerge-current-difference)) 2948 ;; call-interactively takes the value of current-prefix-arg as the 2949 ;; prefix argument value to be passed to the command. Thus, we have 2950 ;; to do nothing special to make sure the prefix argument is 2951 ;; transmitted to the command. 2952 (call-interactively command) 2953 (if (and (>= emerge-current-difference 0) 2954 (< emerge-current-difference emerge-number-of-differences)) 2955 (progn 2956 (emerge-select-difference emerge-current-difference) 2957 (emerge-recenter)))) 2958 ;; He's being smart and not doing it 2959 (message "Not written"))) 2960 2961;; Make sure the current buffer (for a file) has the same contents as the 2962;; file on disk, and attempt to remedy the situation if not. 2963;; Signal an error if we can't make them the same, or the user doesn't want 2964;; to do what is necessary to make them the same. 2965(defun emerge-verify-file-buffer () 2966 ;; First check if the file has been modified since the buffer visited it. 2967 (if (verify-visited-file-modtime (current-buffer)) 2968 (if (buffer-modified-p) 2969 ;; If buffer is not obsolete and is modified, offer to save 2970 (if (yes-or-no-p (format "Save file %s? " buffer-file-name)) 2971 (save-buffer) 2972 (error "Buffer out of sync for file %s" buffer-file-name)) 2973 ;; If buffer is not obsolete and is not modified, do nothing 2974 nil) 2975 (if (buffer-modified-p) 2976 ;; If buffer is obsolete and is modified, give error 2977 (error "Buffer out of sync for file %s" buffer-file-name) 2978 ;; If buffer is obsolete and is not modified, offer to revert 2979 (if (yes-or-no-p (format "Revert file %s? " buffer-file-name)) 2980 (revert-buffer t t) 2981 (error "Buffer out of sync for file %s" buffer-file-name))))) 2982 2983;; Utilities that might have value outside of Emerge. 2984 2985;; Set up the mode in the current buffer to duplicate the mode in another 2986;; buffer. 2987(defun emerge-copy-modes (buffer) 2988 ;; Set the major mode 2989 (funcall (emerge-eval-in-buffer buffer major-mode))) 2990 2991;; Define a key, even if a prefix of it is defined 2992(defun emerge-force-define-key (keymap key definition) 2993 "Like `define-key', but forcibly creates prefix characters as needed. 2994If some prefix of KEY has a non-prefix definition, it is redefined." 2995 ;; Find out if a prefix of key is defined 2996 (let ((v (lookup-key keymap key))) 2997 ;; If so, undefine it 2998 (if (integerp v) 2999 (define-key keymap (substring key 0 v) nil))) 3000 ;; Now define the key 3001 (define-key keymap key definition)) 3002 3003;;;;; Improvements to describe-mode, so that it describes minor modes as well 3004;;;;; as the major mode 3005;;(defun describe-mode (&optional minor) 3006;; "Display documentation of current major mode. 3007;;If optional arg MINOR is non-nil (or prefix argument is given if interactive), 3008;;display documentation of active minor modes as well. 3009;;For this to work correctly for a minor mode, the mode's indicator variable 3010;;\(listed in `minor-mode-alist') must also be a function whose documentation 3011;;describes the minor mode." 3012;; (interactive) 3013;; (with-output-to-temp-buffer "*Help*" 3014;; (princ mode-name) 3015;; (princ " Mode:\n") 3016;; (princ (documentation major-mode)) 3017;; (let ((minor-modes minor-mode-alist) 3018;; (locals (buffer-local-variables))) 3019;; (while minor-modes 3020;; (let* ((minor-mode (car (car minor-modes))) 3021;; (indicator (car (cdr (car minor-modes)))) 3022;; (local-binding (assq minor-mode locals))) 3023;; ;; Document a minor mode if it is listed in minor-mode-alist, 3024;; ;; bound locally in this buffer, non-nil, and has a function 3025;; ;; definition. 3026;; (if (and local-binding 3027;; (cdr local-binding) 3028;; (fboundp minor-mode)) 3029;; (progn 3030;; (princ (format "\n\n\n%s minor mode (indicator%s):\n" 3031;; minor-mode indicator)) 3032;; (princ (documentation minor-mode))))) 3033;; (setq minor-modes (cdr minor-modes)))) 3034;; (save-excursion 3035;; (set-buffer standard-output) 3036;; (help-mode)) 3037;; (print-help-return-message))) 3038 3039;; This goes with the redefinition of describe-mode. 3040;;;; Adjust things so that keyboard macro definitions are documented correctly. 3041;;(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) 3042 3043;; substitute-key-definition should work now. 3044;;;; Function to shadow a definition in a keymap with definitions in another. 3045;;(defun emerge-shadow-key-definition (olddef newdef keymap shadowmap) 3046;; "Shadow OLDDEF with NEWDEF for any keys in KEYMAP with entries in SHADOWMAP. 3047;;In other words, SHADOWMAP will now shadow all definitions of OLDDEF in KEYMAP 3048;;with NEWDEF. Does not affect keys that are already defined in SHADOWMAP, 3049;;including those whose definition is OLDDEF." 3050;; ;; loop through all keymaps accessible from keymap 3051;; (let ((maps (accessible-keymaps keymap))) 3052;; (while maps 3053;; (let ((prefix (car (car maps))) 3054;; (map (cdr (car maps)))) 3055;; ;; examine a keymap 3056;; (if (arrayp map) 3057;; ;; array keymap 3058;; (let ((len (length map)) 3059;; (i 0)) 3060;; (while (< i len) 3061;; (if (eq (aref map i) olddef) 3062;; ;; set the shadowing definition 3063;; (let ((key (concat prefix (char-to-string i)))) 3064;; (emerge-define-key-if-possible shadowmap key newdef))) 3065;; (setq i (1+ i)))) 3066;; ;; sparse keymap 3067;; (while map 3068;; (if (eq (cdr-safe (car-safe map)) olddef) 3069;; ;; set the shadowing definition 3070;; (let ((key 3071;; (concat prefix (char-to-string (car (car map)))))) 3072;; (emerge-define-key-if-possible shadowmap key newdef))) 3073;; (setq map (cdr map))))) 3074;; (setq maps (cdr maps))))) 3075 3076;; Define a key if it (or a prefix) is not already defined in the map. 3077(defun emerge-define-key-if-possible (keymap key definition) 3078 ;; look up the present definition of the key 3079 (let ((present (lookup-key keymap key))) 3080 (if (integerp present) 3081 ;; if it is "too long", look up the valid prefix 3082 (if (not (lookup-key keymap (substring key 0 present))) 3083 ;; if the prefix isn't defined, define it 3084 (define-key keymap key definition)) 3085 ;; if there is no present definition, define it 3086 (if (not present) 3087 (define-key keymap key definition))))) 3088 3089;; Ordinary substitute-key-definition should do this now. 3090;;(defun emerge-recursively-substitute-key-definition (olddef newdef keymap) 3091;; "Like `substitute-key-definition', but act recursively on subkeymaps. 3092;;Make sure that subordinate keymaps aren't shared with other keymaps! 3093;;\(`copy-keymap' will suffice.)" 3094;; ;; Loop through all keymaps accessible from keymap 3095;; (let ((maps (accessible-keymaps keymap))) 3096;; (while maps 3097;; ;; Substitute in this keymap 3098;; (substitute-key-definition olddef newdef (cdr (car maps))) 3099;; (setq maps (cdr maps))))) 3100 3101;; Show the name of the file in the buffer. 3102(defun emerge-show-file-name () 3103 "Displays the name of the file loaded into the current buffer. 3104If the name won't fit on one line, the minibuffer is expanded to hold it, 3105and the command waits for a keystroke from the user. If the keystroke is 3106SPC, it is ignored; if it is anything else, it is processed as a command." 3107 (interactive) 3108 (let ((name (buffer-file-name))) 3109 (or name 3110 (setq name "Buffer has no file name.")) 3111 (save-window-excursion 3112 (select-window (minibuffer-window)) 3113 (unwind-protect 3114 (progn 3115 (erase-buffer) 3116 (insert name) 3117 (if (not (pos-visible-in-window-p)) 3118 (while (and (not (pos-visible-in-window-p)) 3119 (> (1- (frame-height)) (window-height))) 3120 (enlarge-window 1))) 3121 (let* ((echo-keystrokes 0) 3122 (c (read-event))) 3123 (if (not (eq c 32)) 3124 (setq unread-command-events (list c))))) 3125 (erase-buffer))))) 3126 3127;; Improved auto-save file names. 3128;; This function fixes many problems with the standard auto-save file names: 3129;; Auto-save files for non-file buffers get put in the default directory 3130;; for the buffer, whether that makes sense or not. 3131;; Auto-save files for file buffers get put in the directory of the file, 3132;; regardless of whether we can write into it or not. 3133;; Auto-save files for non-file buffers don't use the process id, so if a 3134;; user runs more than on Emacs, they can make auto-save files that overwrite 3135;; each other. 3136;; To use this function, do: 3137;; (fset 'make-auto-save-file-name 3138;; (symbol-function 'emerge-make-auto-save-file-name)) 3139(defun emerge-make-auto-save-file-name () 3140 "Return file name to use for auto-saves of current buffer. 3141Does not consider `auto-save-visited-file-name'; 3142that is checked before calling this function. 3143You can redefine this for customization. 3144See also `auto-save-file-name-p'." 3145 (if buffer-file-name 3146 ;; if buffer has a file, try the format <file directory>/#<file name># 3147 (let ((f (concat (file-name-directory buffer-file-name) 3148 "#" 3149 (file-name-nondirectory buffer-file-name) 3150 "#"))) 3151 (if (file-writable-p f) 3152 ;; the file is writable, so use it 3153 f 3154 ;; the file isn't writable, so use the format 3155 ;; ~/#&<file name>&<hash of directory># 3156 (concat (getenv "HOME") 3157 "/#&" 3158 (file-name-nondirectory buffer-file-name) 3159 "&" 3160 (emerge-hash-string-into-string 3161 (file-name-directory buffer-file-name)) 3162 "#"))) 3163 ;; if buffer has no file, use the format ~/#%<buffer name>%<process id># 3164 (expand-file-name (concat (getenv "HOME") 3165 "/#%" 3166 ;; quote / into \! and \ into \\ 3167 (emerge-unslashify-name (buffer-name)) 3168 "%" 3169 (make-temp-name "") 3170 "#")))) 3171 3172;; Hash a string into five characters more-or-less suitable for use in a file 3173;; name. (Allowed characters are ! through ~, except /.) 3174(defun emerge-hash-string-into-string (s) 3175 (let ((bins (vector 0 0 0 0 0)) 3176 (i 0)) 3177 (while (< i (length s)) 3178 (aset bins (% i 5) (% (+ (* (aref bins (% i 5)) 35) 3179 (aref s i)) 3180 65536)) 3181 (setq i (1+ i))) 3182 (mapconcat (function (lambda (b) 3183 (setq b (+ (% b 93) ?!)) 3184 (if (>= b ?/) 3185 (setq b (1+ b))) 3186 (char-to-string b))) 3187 bins ""))) 3188 3189;; Quote any /s in a string by replacing them with \!. 3190;; Also, replace any \s by \\, to make it one-to-one. 3191(defun emerge-unslashify-name (s) 3192 (let ((limit 0)) 3193 (while (string-match "[/\\]" s limit) 3194 (setq s (concat (substring s 0 (match-beginning 0)) 3195 (if (string= (substring s (match-beginning 0) 3196 (match-end 0)) 3197 "/") 3198 "\\!" 3199 "\\\\") 3200 (substring s (match-end 0)))) 3201 (setq limit (1+ (match-end 0))))) 3202 s) 3203 3204;; Metacharacters that have to be protected from the shell when executing 3205;; a diff/diff3 command. 3206(defcustom emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" 3207 "Characters that must be quoted with \\ when used in a shell command line. 3208More precisely, a [...] regexp to match any one such character." 3209 :type 'regexp 3210 :group 'emerge) 3211 3212;; Quote metacharacters (using \) when executing a diff/diff3 command. 3213(defun emerge-protect-metachars (s) 3214 (let ((limit 0)) 3215 (while (string-match emerge-metachars s limit) 3216 (setq s (concat (substring s 0 (match-beginning 0)) 3217 "\\" 3218 (substring s (match-beginning 0)))) 3219 (setq limit (1+ (match-end 0))))) 3220 s) 3221 3222(provide 'emerge) 3223 3224;;; arch-tag: a575f092-6e44-400e-b8a2-4124e9377585 3225;;; emerge.el ends here 3226