(while-no-input): Don't splice BODY directly into the `or' form.
[emacs.git] / lisp / ediff-util.el
blob9914b8cc973bf95188f43671a646efb433c2e87e
1 ;;; ediff-util.el --- the core commands and utilities of ediff
3 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
4 ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 3, or (at your option)
13 ;; any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
25 ;;; Commentary:
27 ;;; Code:
30 ;; Compiler pacifier
31 (defvar ediff-patch-diagnostics)
32 (defvar ediff-patchbufer)
33 (defvar ediff-use-toolbar-p)
34 (defvar ediff-toolbar-height)
35 (defvar ediff-toolbar)
36 (defvar ediff-toolbar-3way)
37 (defvar bottom-toolbar)
38 (defvar bottom-toolbar-visible-p)
39 (defvar bottom-toolbar-height)
40 (defvar mark-active)
42 (defvar ediff-after-quit-hook-internal nil)
44 (eval-and-compile
45 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
47 (eval-when-compile
48 (let ((load-path (cons (expand-file-name ".") load-path)))
49 (provide 'ediff-util) ; to break recursive load cycle
50 (or (featurep 'ediff-init)
51 (load "ediff-init.el" nil t 'nosuffix))
52 (or (featurep 'ediff-help)
53 (load "ediff-help.el" nil t 'nosuffix))
54 (or (featurep 'ediff-mult)
55 (load "ediff-mult.el" nil t 'nosuffix))
56 (or (featurep 'ediff-wind)
57 (load "ediff-wind.el" nil t 'nosuffix))
58 (or (featurep 'ediff-diff)
59 (load "ediff-diff.el" nil t 'nosuffix))
60 (or (featurep 'ediff-merg)
61 (load "ediff-merg.el" nil t 'nosuffix))
62 (or (featurep 'ediff)
63 (load "ediff.el" nil t 'nosuffix))
64 (or (featurep 'ediff-tbar)
65 (featurep 'emacs)
66 (load "ediff-tbar.el" 'noerror nil 'nosuffix))
68 ;; end pacifier
71 (require 'ediff-init)
72 (require 'ediff-help)
73 (require 'ediff-mult)
74 (require 'ediff-wind)
75 (require 'ediff-diff)
76 (require 'ediff-merg)
78 (if (featurep 'xemacs)
79 (require 'ediff-tbar))
82 ;;; Functions
84 (defun ediff-mode ()
85 "Ediff mode controls all operations in a single Ediff session.
86 This mode is entered through one of the following commands:
87 `ediff'
88 `ediff-files'
89 `ediff-buffers'
90 `ebuffers'
91 `ediff3'
92 `ediff-files3'
93 `ediff-buffers3'
94 `ebuffers3'
95 `ediff-merge'
96 `ediff-merge-files'
97 `ediff-merge-files-with-ancestor'
98 `ediff-merge-buffers'
99 `ediff-merge-buffers-with-ancestor'
100 `ediff-merge-revisions'
101 `ediff-merge-revisions-with-ancestor'
102 `ediff-windows-wordwise'
103 `ediff-windows-linewise'
104 `ediff-regions-wordwise'
105 `ediff-regions-linewise'
106 `epatch'
107 `ediff-patch-file'
108 `ediff-patch-buffer'
109 `epatch-buffer'
110 `erevision'
111 `ediff-revision'
113 Commands:
114 \\{ediff-mode-map}"
115 (kill-all-local-variables)
116 (setq major-mode 'ediff-mode)
117 (setq mode-name "Ediff")
118 ;; We use run-hooks instead of run-mode-hooks for two reasons.
119 ;; The ediff control buffer is read-only and it is not supposed to be
120 ;; modified by minor modes and such. So, run-mode-hooks doesn't do anything
121 ;; useful here on top of what run-hooks does.
122 ;; Second, changing run-hooks to run-mode-hooks would require an
123 ;; if-statement, since XEmacs doesn't have this.
124 (run-hooks 'ediff-mode-hook))
128 ;;; Build keymaps
130 (ediff-defvar-local ediff-mode-map nil
131 "Local keymap used in Ediff mode.
132 This is local to each Ediff Control Panel, so they may vary from invocation
133 to invocation.")
135 ;; Set up the keymap in the control buffer
136 (defun ediff-set-keys ()
137 "Set up Ediff keymap, if necessary."
138 (if (null ediff-mode-map)
139 (ediff-setup-keymap))
140 (use-local-map ediff-mode-map))
142 ;; Reload Ediff keymap. For debugging only.
143 (defun ediff-reload-keymap ()
144 (interactive)
145 (setq ediff-mode-map nil)
146 (ediff-set-keys))
149 (defun ediff-setup-keymap ()
150 "Set up the keymap used in the control buffer of Ediff."
151 (setq ediff-mode-map (make-sparse-keymap))
152 (suppress-keymap ediff-mode-map)
154 (define-key ediff-mode-map
155 (if (featurep 'emacs) [mouse-2] [button2]) 'ediff-help-for-quick-help)
156 (define-key ediff-mode-map "\C-m" 'ediff-help-for-quick-help)
158 (define-key ediff-mode-map "p" 'ediff-previous-difference)
159 (define-key ediff-mode-map "\C-?" 'ediff-previous-difference)
160 (define-key ediff-mode-map [delete] 'ediff-previous-difference)
161 (define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer
162 'ediff-previous-difference nil))
163 ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs
164 (define-key ediff-mode-map [backspace] 'ediff-previous-difference)
165 (define-key ediff-mode-map "n" 'ediff-next-difference)
166 (define-key ediff-mode-map " " 'ediff-next-difference)
167 (define-key ediff-mode-map "j" 'ediff-jump-to-difference)
168 (define-key ediff-mode-map "g" nil)
169 (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point)
170 (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point)
171 (define-key ediff-mode-map "q" 'ediff-quit)
172 (define-key ediff-mode-map "D" 'ediff-show-diff-output)
173 (define-key ediff-mode-map "z" 'ediff-suspend)
174 (define-key ediff-mode-map "\C-l" 'ediff-recenter)
175 (define-key ediff-mode-map "|" 'ediff-toggle-split)
176 (define-key ediff-mode-map "h" 'ediff-toggle-hilit)
177 (or ediff-word-mode
178 (define-key ediff-mode-map "@" 'ediff-toggle-autorefine))
179 (if ediff-narrow-job
180 (define-key ediff-mode-map "%" 'ediff-toggle-narrow-region))
181 (define-key ediff-mode-map "~" 'ediff-swap-buffers)
182 (define-key ediff-mode-map "v" 'ediff-scroll-vertically)
183 (define-key ediff-mode-map "\C-v" 'ediff-scroll-vertically)
184 (define-key ediff-mode-map "^" 'ediff-scroll-vertically)
185 (define-key ediff-mode-map "\M-v" 'ediff-scroll-vertically)
186 (define-key ediff-mode-map "V" 'ediff-scroll-vertically)
187 (define-key ediff-mode-map "<" 'ediff-scroll-horizontally)
188 (define-key ediff-mode-map ">" 'ediff-scroll-horizontally)
189 (define-key ediff-mode-map "i" 'ediff-status-info)
190 (define-key ediff-mode-map "E" 'ediff-documentation)
191 (define-key ediff-mode-map "?" 'ediff-toggle-help)
192 (define-key ediff-mode-map "!" 'ediff-update-diffs)
193 (define-key ediff-mode-map "M" 'ediff-show-current-session-meta-buffer)
194 (define-key ediff-mode-map "R" 'ediff-show-registry)
195 (or ediff-word-mode
196 (define-key ediff-mode-map "*" 'ediff-make-or-kill-fine-diffs))
197 (define-key ediff-mode-map "a" nil)
198 (define-key ediff-mode-map "b" nil)
199 (define-key ediff-mode-map "r" nil)
200 (cond (ediff-merge-job
201 ;; Will barf if no ancestor
202 (define-key ediff-mode-map "/" 'ediff-show-ancestor)
203 ;; In merging, we allow only A->C and B->C copying.
204 (define-key ediff-mode-map "a" 'ediff-copy-A-to-C)
205 (define-key ediff-mode-map "b" 'ediff-copy-B-to-C)
206 (define-key ediff-mode-map "r" 'ediff-restore-diff-in-merge-buffer)
207 (define-key ediff-mode-map "s" 'ediff-shrink-window-C)
208 (define-key ediff-mode-map "+" 'ediff-combine-diffs)
209 (define-key ediff-mode-map "$" nil)
210 (define-key ediff-mode-map "$$" 'ediff-toggle-show-clashes-only)
211 (define-key ediff-mode-map "$*" 'ediff-toggle-skip-changed-regions)
212 (define-key ediff-mode-map "&" 'ediff-re-merge))
213 (ediff-3way-comparison-job
214 (define-key ediff-mode-map "ab" 'ediff-copy-A-to-B)
215 (define-key ediff-mode-map "ba" 'ediff-copy-B-to-A)
216 (define-key ediff-mode-map "ac" 'ediff-copy-A-to-C)
217 (define-key ediff-mode-map "bc" 'ediff-copy-B-to-C)
218 (define-key ediff-mode-map "c" nil)
219 (define-key ediff-mode-map "ca" 'ediff-copy-C-to-A)
220 (define-key ediff-mode-map "cb" 'ediff-copy-C-to-B)
221 (define-key ediff-mode-map "ra" 'ediff-restore-diff)
222 (define-key ediff-mode-map "rb" 'ediff-restore-diff)
223 (define-key ediff-mode-map "rc" 'ediff-restore-diff)
224 (define-key ediff-mode-map "C" 'ediff-toggle-read-only))
225 (t ; 2-way comparison
226 (define-key ediff-mode-map "a" 'ediff-copy-A-to-B)
227 (define-key ediff-mode-map "b" 'ediff-copy-B-to-A)
228 (define-key ediff-mode-map "ra" 'ediff-restore-diff)
229 (define-key ediff-mode-map "rb" 'ediff-restore-diff))
230 ) ; cond
231 (define-key ediff-mode-map "G" 'ediff-submit-report)
232 (define-key ediff-mode-map "#" nil)
233 (define-key ediff-mode-map "#h" 'ediff-toggle-regexp-match)
234 (define-key ediff-mode-map "#f" 'ediff-toggle-regexp-match)
235 (define-key ediff-mode-map "#c" 'ediff-toggle-ignore-case)
236 (or ediff-word-mode
237 (define-key ediff-mode-map "##" 'ediff-toggle-skip-similar))
238 (define-key ediff-mode-map "o" nil)
239 (define-key ediff-mode-map "A" 'ediff-toggle-read-only)
240 (define-key ediff-mode-map "B" 'ediff-toggle-read-only)
241 (define-key ediff-mode-map "w" nil)
242 (define-key ediff-mode-map "wa" 'ediff-save-buffer)
243 (define-key ediff-mode-map "wb" 'ediff-save-buffer)
244 (define-key ediff-mode-map "wd" 'ediff-save-buffer)
245 (define-key ediff-mode-map "=" 'ediff-inferior-compare-regions)
246 (if (and (fboundp 'ediff-show-patch-diagnostics) (ediff-patch-job))
247 (define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics))
248 (if ediff-3way-job
249 (progn
250 (define-key ediff-mode-map "wc" 'ediff-save-buffer)
251 (define-key ediff-mode-map "gc" 'ediff-jump-to-difference-at-point)
254 (define-key ediff-mode-map "m" 'ediff-toggle-wide-display)
256 ;; Allow ediff-mode-map to be referenced indirectly
257 (fset 'ediff-mode-map ediff-mode-map)
258 (run-hooks 'ediff-keymap-setup-hook))
261 ;;; Setup functions
263 ;; Common startup entry for all Ediff functions It now returns control buffer
264 ;; so other functions can do post-processing SETUP-PARAMETERS is a list of the
265 ;; form ((param .val) (param . val)...) This serves a similar purpose to
266 ;; STARTUP-HOOKS, but these parameters are set in the new control buffer right
267 ;; after this buf is created and before any windows are set and such.
268 (defun ediff-setup (buffer-A file-A buffer-B file-B buffer-C file-C
269 startup-hooks setup-parameters
270 &optional merge-buffer-file)
271 (run-hooks 'ediff-before-setup-hook)
272 ;; ediff-convert-standard-filename puts file names in the form appropriate
273 ;; for the OS at hand.
274 (setq file-A (ediff-convert-standard-filename (expand-file-name file-A)))
275 (setq file-B (ediff-convert-standard-filename (expand-file-name file-B)))
276 (if (stringp file-C)
277 (setq file-C
278 (ediff-convert-standard-filename (expand-file-name file-C))))
279 (if (stringp merge-buffer-file)
280 (progn
281 (setq merge-buffer-file
282 (ediff-convert-standard-filename
283 (expand-file-name merge-buffer-file)))
284 ;; check the directory exists
285 (or (file-exists-p (file-name-directory merge-buffer-file))
286 (error "Directory %s given as place to save the merge doesn't exist"
287 (abbreviate-file-name
288 (file-name-directory merge-buffer-file))))
289 (if (and (file-exists-p merge-buffer-file)
290 (file-directory-p merge-buffer-file))
291 (error "The merge buffer file %s must not be a directory"
292 (abbreviate-file-name merge-buffer-file)))
294 (let* ((control-buffer-name
295 (ediff-unique-buffer-name "*Ediff Control Panel" "*"))
296 (control-buffer (ediff-with-current-buffer buffer-A
297 (get-buffer-create control-buffer-name))))
298 (ediff-with-current-buffer control-buffer
299 (ediff-mode)
301 (make-local-variable 'ediff-use-long-help-message)
302 (make-local-variable 'ediff-prefer-iconified-control-frame)
303 (make-local-variable 'ediff-split-window-function)
304 (make-local-variable 'ediff-default-variant)
305 (make-local-variable 'ediff-merge-window-share)
306 (make-local-variable 'ediff-window-setup-function)
307 (make-local-variable 'ediff-keep-variants)
309 (if (featurep 'xemacs)
310 (make-local-hook 'ediff-after-quit-hook-internal))
312 ;; unwrap set up parameters passed as argument
313 (while setup-parameters
314 (set (car (car setup-parameters)) (cdr (car setup-parameters)))
315 (setq setup-parameters (cdr setup-parameters)))
317 ;; set variables classifying the current ediff job
318 ;; must come AFTER setup-parameters
319 (setq ediff-3way-comparison-job (ediff-3way-comparison-job)
320 ediff-merge-job (ediff-merge-job)
321 ediff-merge-with-ancestor-job (ediff-merge-with-ancestor-job)
322 ediff-3way-job (ediff-3way-job)
323 ediff-diff3-job (ediff-diff3-job)
324 ediff-narrow-job (ediff-narrow-job)
325 ediff-windows-job (ediff-windows-job)
326 ediff-word-mode-job (ediff-word-mode-job))
328 ;; Don't delete variants in case of ediff-buffer-* jobs without asking.
329 ;; This is because one may loose work---dangerous.
330 (if (string-match "buffer" (symbol-name ediff-job-name))
331 (setq ediff-keep-variants t))
333 (if (featurep 'xemacs)
334 (make-local-hook 'pre-command-hook))
336 (if (ediff-window-display-p)
337 (add-hook 'pre-command-hook 'ediff-spy-after-mouse nil 'local))
338 (setq ediff-mouse-pixel-position (mouse-pixel-position))
340 ;; adjust for merge jobs
341 (if ediff-merge-job
342 (let ((buf
343 ;; If default variant is `combined', the right stuff is
344 ;; inserted by ediff-do-merge
345 ;; Note: at some point, we tried to put ancestor buffer here
346 ;; (which is currently buffer C. This didn't work right
347 ;; because the merge buffer will contain lossage: diff regions
348 ;; in the ancestor, which correspond to revisions that agree
349 ;; in both buf A and B.
350 (cond ((eq ediff-default-variant 'default-B)
351 buffer-B)
352 (t buffer-A))))
354 (setq ediff-split-window-function
355 ediff-merge-split-window-function)
357 ;; remember the ancestor buffer, if any
358 (setq ediff-ancestor-buffer buffer-C)
360 (setq buffer-C
361 (get-buffer-create
362 (ediff-unique-buffer-name "*ediff-merge" "*")))
363 (save-excursion
364 (set-buffer buffer-C)
365 (insert-buffer-substring buf)
366 (goto-char (point-min))
367 (funcall (ediff-with-current-buffer buf major-mode))
368 (widen) ; merge buffer is always widened
369 (add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t)
371 (setq buffer-read-only nil
372 ediff-buffer-A buffer-A
373 ediff-buffer-B buffer-B
374 ediff-buffer-C buffer-C
375 ediff-control-buffer control-buffer)
377 (ediff-choose-syntax-table)
379 (setq ediff-control-buffer-suffix
380 (if (string-match "<[0-9]*>" control-buffer-name)
381 (substring control-buffer-name
382 (match-beginning 0) (match-end 0))
384 ediff-control-buffer-number
385 (max
388 (string-to-number
389 (substring
390 ediff-control-buffer-suffix
392 (string-match "[0-9]+" ediff-control-buffer-suffix)
393 0))))))
395 (setq ediff-error-buffer
396 (get-buffer-create (ediff-unique-buffer-name "*ediff-errors" "*")))
398 (with-current-buffer ediff-error-buffer
399 (setq buffer-undo-list t))
401 (ediff-with-current-buffer buffer-A (ediff-strip-mode-line-format))
402 (ediff-with-current-buffer buffer-B (ediff-strip-mode-line-format))
403 (if ediff-3way-job
404 (ediff-with-current-buffer buffer-C (ediff-strip-mode-line-format)))
405 (if (ediff-buffer-live-p ediff-ancestor-buffer)
406 (ediff-with-current-buffer ediff-ancestor-buffer
407 (ediff-strip-mode-line-format)))
409 (ediff-save-protected-variables) ; save variables to be restored on exit
411 ;; ediff-setup-diff-regions-function must be set after setup
412 ;; parameters are processed.
413 (setq ediff-setup-diff-regions-function
414 (if ediff-diff3-job
415 'ediff-setup-diff-regions3
416 'ediff-setup-diff-regions))
418 (setq ediff-wide-bounds
419 (list (ediff-make-bullet-proof-overlay
420 '(point-min) '(point-max) ediff-buffer-A)
421 (ediff-make-bullet-proof-overlay
422 '(point-min) '(point-max) ediff-buffer-B)
423 (ediff-make-bullet-proof-overlay
424 '(point-min) '(point-max) ediff-buffer-C)))
426 ;; This has effect only on ediff-windows/regions
427 ;; In all other cases, ediff-visible-region sets visibility bounds to
428 ;; ediff-wide-bounds, and ediff-narrow-bounds are ignored.
429 (if ediff-start-narrowed
430 (setq ediff-visible-bounds ediff-narrow-bounds)
431 (setq ediff-visible-bounds ediff-wide-bounds))
433 (ediff-set-keys) ; comes after parameter setup
435 ;; set up ediff-narrow-bounds, if not set
436 (or ediff-narrow-bounds
437 (setq ediff-narrow-bounds ediff-wide-bounds))
439 ;; All these must be inside ediff-with-current-buffer control-buffer,
440 ;; since these vars are local to control-buffer
441 ;; These won't run if there are errors in diff
442 (ediff-with-current-buffer ediff-buffer-A
443 (ediff-nuke-selective-display)
444 (run-hooks 'ediff-prepare-buffer-hook)
445 (if (ediff-with-current-buffer control-buffer ediff-merge-job)
446 (setq buffer-read-only t))
447 ;; add control-buffer to the list of sessions--no longer used, but may
448 ;; be used again in the future
449 (or (memq control-buffer ediff-this-buffer-ediff-sessions)
450 (setq ediff-this-buffer-ediff-sessions
451 (cons control-buffer ediff-this-buffer-ediff-sessions)))
452 (if ediff-make-buffers-readonly-at-startup
453 (setq buffer-read-only t))
456 (ediff-with-current-buffer ediff-buffer-B
457 (ediff-nuke-selective-display)
458 (run-hooks 'ediff-prepare-buffer-hook)
459 (if (ediff-with-current-buffer control-buffer ediff-merge-job)
460 (setq buffer-read-only t))
461 ;; add control-buffer to the list of sessions
462 (or (memq control-buffer ediff-this-buffer-ediff-sessions)
463 (setq ediff-this-buffer-ediff-sessions
464 (cons control-buffer ediff-this-buffer-ediff-sessions)))
465 (if ediff-make-buffers-readonly-at-startup
466 (setq buffer-read-only t))
469 (if ediff-3way-job
470 (ediff-with-current-buffer ediff-buffer-C
471 (ediff-nuke-selective-display)
472 ;; the merge bufer should never be narrowed
473 ;; (it can happen if it is on rmail-mode or similar)
474 (if (ediff-with-current-buffer control-buffer ediff-merge-job)
475 (widen))
476 (run-hooks 'ediff-prepare-buffer-hook)
477 ;; add control-buffer to the list of sessions
478 (or (memq control-buffer ediff-this-buffer-ediff-sessions)
479 (setq ediff-this-buffer-ediff-sessions
480 (cons control-buffer
481 ediff-this-buffer-ediff-sessions)))
482 (if ediff-make-buffers-readonly-at-startup
483 (setq buffer-read-only t)
484 (setq buffer-read-only nil))
487 (if (ediff-buffer-live-p ediff-ancestor-buffer)
488 (ediff-with-current-buffer ediff-ancestor-buffer
489 (ediff-nuke-selective-display)
490 (setq buffer-read-only t)
491 (run-hooks 'ediff-prepare-buffer-hook)
492 (or (memq control-buffer ediff-this-buffer-ediff-sessions)
493 (setq ediff-this-buffer-ediff-sessions
494 (cons control-buffer
495 ediff-this-buffer-ediff-sessions)))
498 ;; the following must be after setting up ediff-narrow-bounds AND after
499 ;; nuking selective display
500 (funcall ediff-setup-diff-regions-function file-A file-B file-C)
501 (setq ediff-number-of-differences (length ediff-difference-vector-A))
502 (setq ediff-current-difference -1)
504 (ediff-make-current-diff-overlay 'A)
505 (ediff-make-current-diff-overlay 'B)
506 (if ediff-3way-job
507 (ediff-make-current-diff-overlay 'C))
508 (if ediff-merge-with-ancestor-job
509 (ediff-make-current-diff-overlay 'Ancestor))
511 (ediff-setup-windows buffer-A buffer-B buffer-C control-buffer)
513 (let ((shift-A (ediff-overlay-start
514 (ediff-get-value-according-to-buffer-type
515 'A ediff-narrow-bounds)))
516 (shift-B (ediff-overlay-start
517 (ediff-get-value-according-to-buffer-type
518 'B ediff-narrow-bounds)))
519 (shift-C (ediff-overlay-start
520 (ediff-get-value-according-to-buffer-type
521 'C ediff-narrow-bounds))))
522 ;; position point in buf A
523 (save-excursion
524 (select-window ediff-window-A)
525 (goto-char shift-A))
526 ;; position point in buf B
527 (save-excursion
528 (select-window ediff-window-B)
529 (goto-char shift-B))
530 (if ediff-3way-job
531 (save-excursion
532 (select-window ediff-window-C)
533 (goto-char shift-C)))
536 (select-window ediff-control-window)
537 (ediff-visible-region)
539 (run-hooks 'startup-hooks)
540 (ediff-arrange-autosave-in-merge-jobs merge-buffer-file)
542 (ediff-refresh-mode-lines)
543 (setq buffer-read-only t)
544 (setq ediff-session-registry
545 (cons control-buffer ediff-session-registry))
546 (ediff-update-registry)
547 (if (ediff-buffer-live-p ediff-meta-buffer)
548 (ediff-update-meta-buffer
549 ediff-meta-buffer nil ediff-meta-session-number))
550 (run-hooks 'ediff-startup-hook)
551 ) ; eval in control-buffer
552 control-buffer))
555 ;; This function assumes that we are in the window where control buffer is
556 ;; to reside.
557 (defun ediff-setup-control-buffer (ctl-buf)
558 "Set up window for control buffer."
559 (if (window-dedicated-p (selected-window))
560 (set-buffer ctl-buf) ; we are in control frame but just in case
561 (switch-to-buffer ctl-buf))
562 (let ((window-min-height 2))
563 (erase-buffer)
564 (ediff-set-help-message)
565 (insert ediff-help-message)
566 (shrink-window-if-larger-than-buffer)
567 (or (ediff-multiframe-setup-p)
568 (ediff-indent-help-message))
569 (ediff-set-help-overlays)
571 (set-buffer-modified-p nil)
572 (ediff-refresh-mode-lines)
573 (setq ediff-control-window (selected-window))
574 (setq ediff-window-config-saved
575 (format "%S%S%S%S%S%S%S"
576 ediff-control-window
577 ediff-window-A
578 ediff-window-B
579 ediff-window-C
580 ediff-split-window-function
581 (ediff-multiframe-setup-p)
582 ediff-wide-display-p))
584 ;; In multiframe, toolbar is set in ediff-setup-control-frame
585 (if (not (ediff-multiframe-setup-p))
586 (ediff-make-bottom-toolbar)) ; this checks if toolbar is requested
587 (goto-char (point-min))
588 (skip-chars-forward ediff-whitespace)))
590 ;; This executes in control buffer and sets auto-save, visited file name, etc,
591 ;; in the merge buffer
592 (defun ediff-arrange-autosave-in-merge-jobs (merge-buffer-file)
593 (if (not ediff-merge-job)
595 (if (stringp merge-buffer-file)
596 (setq ediff-autostore-merges t
597 ediff-merge-store-file merge-buffer-file))
598 (if (stringp ediff-merge-store-file)
599 (progn
600 ;; save before leaving ctl buffer
601 (ediff-verify-file-merge-buffer ediff-merge-store-file)
602 (setq merge-buffer-file ediff-merge-store-file)
603 (ediff-with-current-buffer ediff-buffer-C
604 (set-visited-file-name merge-buffer-file))))
605 (ediff-with-current-buffer ediff-buffer-C
606 (setq buffer-offer-save t) ; ask before killing buffer
607 ;; make sure the contents is auto-saved
608 (auto-save-mode 1))
612 ;;; Commands for working with Ediff
614 (defun ediff-update-diffs ()
615 "Recompute difference regions in buffers A, B, and C.
616 Buffers are not synchronized with their respective files, so changes done
617 to these buffers are not saved at this point---the user can do this later,
618 if necessary."
619 (interactive)
620 (ediff-barf-if-not-control-buffer)
621 (if (and (ediff-buffer-live-p ediff-ancestor-buffer)
622 (not
623 (y-or-n-p
624 "Ancestor buffer will not be used. Recompute diffs anyway? ")))
625 (error "Recomputation of differences canceled"))
627 (let ((point-A (ediff-with-current-buffer ediff-buffer-A (point)))
628 ;;(point-B (ediff-with-current-buffer ediff-buffer-B (point)))
629 (tmp-buffer (get-buffer-create ediff-tmp-buffer))
630 (buf-A-file-name (buffer-file-name ediff-buffer-A))
631 (buf-B-file-name (buffer-file-name ediff-buffer-B))
632 ;; (null ediff-buffer-C) is no problem, as we later check if
633 ;; ediff-buffer-C is alive
634 (buf-C-file-name (buffer-file-name ediff-buffer-C))
635 (overl-A (ediff-get-value-according-to-buffer-type
636 'A ediff-narrow-bounds))
637 (overl-B (ediff-get-value-according-to-buffer-type
638 'B ediff-narrow-bounds))
639 (overl-C (ediff-get-value-according-to-buffer-type
640 'C ediff-narrow-bounds))
641 beg-A end-A beg-B end-B beg-C end-C
642 file-A file-B file-C)
644 (if (stringp buf-A-file-name)
645 (setq buf-A-file-name (file-name-nondirectory buf-A-file-name)))
646 (if (stringp buf-B-file-name)
647 (setq buf-B-file-name (file-name-nondirectory buf-B-file-name)))
648 (if (stringp buf-C-file-name)
649 (setq buf-C-file-name (file-name-nondirectory buf-C-file-name)))
651 (ediff-unselect-and-select-difference -1)
653 (setq beg-A (ediff-overlay-start overl-A)
654 beg-B (ediff-overlay-start overl-B)
655 beg-C (ediff-overlay-start overl-C)
656 end-A (ediff-overlay-end overl-A)
657 end-B (ediff-overlay-end overl-B)
658 end-C (ediff-overlay-end overl-C))
660 (if ediff-word-mode
661 (progn
662 (ediff-wordify beg-A end-A ediff-buffer-A tmp-buffer)
663 (setq file-A (ediff-make-temp-file tmp-buffer "regA"))
664 (ediff-wordify beg-B end-B ediff-buffer-B tmp-buffer)
665 (setq file-B (ediff-make-temp-file tmp-buffer "regB"))
666 (if ediff-3way-job
667 (progn
668 (ediff-wordify beg-C end-C ediff-buffer-C tmp-buffer)
669 (setq file-C (ediff-make-temp-file tmp-buffer "regC"))))
671 ;; not word-mode
672 (setq file-A (ediff-make-temp-file ediff-buffer-A buf-A-file-name))
673 (setq file-B (ediff-make-temp-file ediff-buffer-B buf-B-file-name))
674 (if ediff-3way-job
675 (setq file-C (ediff-make-temp-file ediff-buffer-C buf-C-file-name)))
678 (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also)
679 (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also)
680 (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also)
681 (ediff-clear-diff-vector
682 'ediff-difference-vector-Ancestor 'fine-diffs-also)
683 ;; let them garbage collect. we can't use the ancestor after recomputing
684 ;; the diffs.
685 (setq ediff-difference-vector-Ancestor nil
686 ediff-ancestor-buffer nil
687 ediff-state-of-merge nil)
689 (setq ediff-killed-diffs-alist nil) ; invalidate saved killed diff regions
691 ;; In case of merge job, fool it into thinking that it is just doing
692 ;; comparison
693 (let ((ediff-setup-diff-regions-function ediff-setup-diff-regions-function)
694 (ediff-3way-comparison-job ediff-3way-comparison-job)
695 (ediff-merge-job ediff-merge-job)
696 (ediff-merge-with-ancestor-job ediff-merge-with-ancestor-job)
697 (ediff-job-name ediff-job-name))
698 (if ediff-merge-job
699 (setq ediff-setup-diff-regions-function 'ediff-setup-diff-regions3
700 ediff-3way-comparison-job t
701 ediff-merge-job nil
702 ediff-merge-with-ancestor-job nil
703 ediff-job-name 'ediff-files3))
704 (funcall ediff-setup-diff-regions-function file-A file-B file-C))
706 (setq ediff-number-of-differences (length ediff-difference-vector-A))
707 (delete-file file-A)
708 (delete-file file-B)
709 (if file-C
710 (delete-file file-C))
712 (if ediff-3way-job
713 (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer))
715 (ediff-jump-to-difference (ediff-diff-at-point 'A point-A))
716 (message "")
719 ;; Not bound to any key---to dangerous. A user can do it if necessary.
720 (defun ediff-revert-buffers-then-recompute-diffs (noconfirm)
721 "Revert buffers A, B and C. Then rerun Ediff on file A and file B."
722 (interactive "P")
723 (ediff-barf-if-not-control-buffer)
724 (let ((bufA ediff-buffer-A)
725 (bufB ediff-buffer-B)
726 (bufC ediff-buffer-C)
727 (ctl-buf ediff-control-buffer)
728 (keep-variants ediff-keep-variants)
729 (ancestor-buf ediff-ancestor-buffer)
730 (ancestor-job ediff-merge-with-ancestor-job)
731 (merge ediff-merge-job)
732 (comparison ediff-3way-comparison-job))
733 (ediff-with-current-buffer bufA
734 (revert-buffer t noconfirm))
735 (ediff-with-current-buffer bufB
736 (revert-buffer t noconfirm))
737 ;; this should only be executed in a 3way comparison, not in merge
738 (if comparison
739 (ediff-with-current-buffer bufC
740 (revert-buffer t noconfirm)))
741 (if merge
742 (progn
743 (set-buffer ctl-buf)
744 ;; the argument says whether to reverse the meaning of
745 ;; ediff-keep-variants, i.e., ediff-really-quit runs here with
746 ;; variants kept.
747 (ediff-really-quit (not keep-variants))
748 (kill-buffer bufC)
749 (if ancestor-job
750 (ediff-merge-buffers-with-ancestor bufA bufB ancestor-buf)
751 (ediff-merge-buffers bufA bufB)))
752 (ediff-update-diffs))))
755 ;; optional NO-REHIGHLIGHT says to not rehighlight buffers
756 (defun ediff-recenter (&optional no-rehighlight)
757 "Bring the highlighted region of all buffers being compared into view.
758 Reestablish the default three-window display."
759 (interactive)
760 (ediff-barf-if-not-control-buffer)
761 (let (buffer-read-only)
762 (if (and (ediff-buffer-live-p ediff-buffer-A)
763 (ediff-buffer-live-p ediff-buffer-B)
764 (or (not ediff-3way-job)
765 (ediff-buffer-live-p ediff-buffer-C)))
766 (ediff-setup-windows
767 ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-control-buffer)
768 (or (eq this-command 'ediff-quit)
769 (message ediff-KILLED-VITAL-BUFFER
770 (beep 1)))
773 ;; set visibility range appropriate to this invocation of Ediff.
774 (ediff-visible-region)
775 ;; raise
776 (if (and (ediff-window-display-p)
777 (symbolp this-command)
778 (symbolp last-command)
779 ;; Either one of the display-changing commands
780 (or (memq this-command
781 '(ediff-recenter
782 ediff-dir-action ediff-registry-action
783 ediff-patch-action
784 ediff-toggle-wide-display ediff-toggle-multiframe))
785 ;; Or one of the movement cmds and prev cmd was an Ediff cmd
786 ;; This avoids raising frames unnecessarily.
787 (and (memq this-command
788 '(ediff-next-difference
789 ediff-previous-difference
790 ediff-jump-to-difference
791 ediff-jump-to-difference-at-point))
792 (not (string-match "^ediff-" (symbol-name last-command)))
794 (progn
795 (if (window-live-p ediff-window-A)
796 (raise-frame (window-frame ediff-window-A)))
797 (if (window-live-p ediff-window-B)
798 (raise-frame (window-frame ediff-window-B)))
799 (if (window-live-p ediff-window-C)
800 (raise-frame (window-frame ediff-window-C)))))
801 (if (and (ediff-window-display-p)
802 (frame-live-p ediff-control-frame)
803 (not ediff-use-long-help-message)
804 (not (ediff-frame-iconified-p ediff-control-frame)))
805 (raise-frame ediff-control-frame))
807 ;; Redisplay whatever buffers are showing, if there is a selected difference
808 (let ((control-frame ediff-control-frame)
809 (control-buf ediff-control-buffer))
810 (if (and (ediff-buffer-live-p ediff-buffer-A)
811 (ediff-buffer-live-p ediff-buffer-B)
812 (or (not ediff-3way-job)
813 (ediff-buffer-live-p ediff-buffer-C)))
814 (progn
815 (or no-rehighlight
816 (ediff-select-difference ediff-current-difference))
818 (ediff-recenter-one-window 'A)
819 (ediff-recenter-one-window 'B)
820 (if ediff-3way-job
821 (ediff-recenter-one-window 'C))
823 (ediff-with-current-buffer control-buf
824 (ediff-recenter-ancestor) ; check if ancestor is alive
826 (if (and (ediff-multiframe-setup-p)
827 (not ediff-use-long-help-message)
828 (not (ediff-frame-iconified-p ediff-control-frame)))
829 ;; never grab mouse on quit in this place
830 (ediff-reset-mouse
831 control-frame
832 (eq this-command 'ediff-quit))))
835 (or no-rehighlight
836 (ediff-restore-highlighting))
837 (ediff-with-current-buffer control-buf (ediff-refresh-mode-lines))
840 ;; this function returns to the window it was called from
841 ;; (which was the control window)
842 (defun ediff-recenter-one-window (buf-type)
843 (if (ediff-valid-difference-p)
844 ;; context must be saved before switching to windows A/B/C
845 (let* ((ctl-wind (selected-window))
846 (shift (ediff-overlay-start
847 (ediff-get-value-according-to-buffer-type
848 buf-type ediff-narrow-bounds)))
849 (job-name ediff-job-name)
850 (control-buf ediff-control-buffer)
851 (window-name (ediff-get-symbol-from-alist
852 buf-type ediff-window-alist))
853 (window (if (window-live-p (symbol-value window-name))
854 (symbol-value window-name))))
856 (if (and window ediff-windows-job)
857 (set-window-start window shift))
858 (if window
859 (progn
860 (select-window window)
861 (ediff-deactivate-mark)
862 (ediff-position-region
863 (ediff-get-diff-posn buf-type 'beg nil control-buf)
864 (ediff-get-diff-posn buf-type 'end nil control-buf)
865 (ediff-get-diff-posn buf-type 'beg nil control-buf)
866 job-name
868 (select-window ctl-wind)
871 (defun ediff-recenter-ancestor ()
872 ;; do half-hearted job by recentering the ancestor buffer, if it is alive and
873 ;; visible.
874 (if (and (ediff-buffer-live-p ediff-ancestor-buffer)
875 (ediff-valid-difference-p))
876 (let ((window (ediff-get-visible-buffer-window ediff-ancestor-buffer))
877 (ctl-wind (selected-window))
878 (job-name ediff-job-name)
879 (ctl-buf ediff-control-buffer))
880 (ediff-with-current-buffer ediff-ancestor-buffer
881 (goto-char (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf))
882 (if window
883 (progn
884 (select-window window)
885 (ediff-position-region
886 (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf)
887 (ediff-get-diff-posn 'Ancestor 'end nil ctl-buf)
888 (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf)
889 job-name))))
890 (select-window ctl-wind)
894 ;; This will have to be refined for 3way jobs
895 (defun ediff-toggle-split ()
896 "Toggle vertical/horizontal window split.
897 Does nothing if file-A and file-B are in different frames."
898 (interactive)
899 (ediff-barf-if-not-control-buffer)
900 (let* ((wind-A (if (window-live-p ediff-window-A) ediff-window-A))
901 (wind-B (if (window-live-p ediff-window-B) ediff-window-B))
902 (wind-C (if (window-live-p ediff-window-C) ediff-window-C))
903 (frame-A (if wind-A (window-frame wind-A)))
904 (frame-B (if wind-B (window-frame wind-B)))
905 (frame-C (if wind-C (window-frame wind-C))))
906 (if (or (eq frame-A frame-B)
907 (not (frame-live-p frame-A))
908 (not (frame-live-p frame-B))
909 (if ediff-3way-comparison-job
910 (or (not (frame-live-p frame-C))
911 (eq frame-A frame-C) (eq frame-B frame-C))))
912 (setq ediff-split-window-function
913 (if (eq ediff-split-window-function 'split-window-vertically)
914 'split-window-horizontally
915 'split-window-vertically))
916 (message "Buffers being compared are in different frames"))
917 (ediff-recenter 'no-rehighlight)))
919 (defun ediff-toggle-hilit ()
920 "Switch between highlighting using ASCII flags and highlighting using faces.
921 On a dumb terminal, switches between ASCII highlighting and no highlighting."
922 (interactive)
923 (ediff-barf-if-not-control-buffer)
925 (ediff-unselect-and-select-difference
926 ediff-current-difference 'unselect-only)
927 ;; cycle through highlighting
928 (cond ((and ediff-use-faces
929 (ediff-has-face-support-p)
930 ediff-highlight-all-diffs)
931 (message "Unhighlighting unselected difference regions")
932 (setq ediff-highlight-all-diffs nil
933 ediff-highlighting-style 'face))
934 ((or (and ediff-use-faces (ediff-has-face-support-p)
935 (eq ediff-highlighting-style 'face)) ; has face support
936 (and (not (ediff-has-face-support-p)) ; no face support
937 (eq ediff-highlighting-style 'off)))
938 (message "Highlighting with ASCII flags")
939 (setq ediff-highlighting-style 'ascii
940 ediff-highlight-all-diffs nil
941 ediff-use-faces nil))
942 ((eq ediff-highlighting-style 'ascii)
943 (message "ASCII highlighting flags removed")
944 (setq ediff-highlighting-style 'off
945 ediff-highlight-all-diffs nil))
946 ((ediff-has-face-support-p) ; catch-all for cases with face support
947 (message "Re-highlighting all difference regions")
948 (setq ediff-use-faces t
949 ediff-highlighting-style 'face
950 ediff-highlight-all-diffs t)))
952 (if (and ediff-use-faces ediff-highlight-all-diffs)
953 (ediff-paint-background-regions)
954 (ediff-paint-background-regions 'unhighlight))
956 (ediff-unselect-and-select-difference
957 ediff-current-difference 'select-only))
960 (defun ediff-toggle-autorefine ()
961 "Toggle auto-refine mode."
962 (interactive)
963 (ediff-barf-if-not-control-buffer)
964 (if ediff-word-mode
965 (error "No fine differences in this mode"))
966 (cond ((eq ediff-auto-refine 'nix)
967 (setq ediff-auto-refine 'on)
968 (ediff-make-fine-diffs ediff-current-difference 'noforce)
969 (message "Auto-refining is ON"))
970 ((eq ediff-auto-refine 'on)
971 (message "Auto-refining is OFF")
972 (setq ediff-auto-refine 'off))
973 (t ;; nix 'em
974 (ediff-set-fine-diff-properties ediff-current-difference 'default)
975 (message "Refinements are HIDDEN")
976 (setq ediff-auto-refine 'nix))
979 (defun ediff-show-ancestor ()
980 "Show the ancestor buffer in a suitable window."
981 (interactive)
982 (ediff-recenter)
983 (or (ediff-buffer-live-p ediff-ancestor-buffer)
984 (if ediff-merge-with-ancestor-job
985 (error "Lost connection to ancestor buffer...sorry")
986 (error "Not merging with ancestor")))
987 (let (wind)
988 (cond ((setq wind (ediff-get-visible-buffer-window ediff-ancestor-buffer))
989 (raise-frame (window-frame wind)))
990 (t (set-window-buffer ediff-window-C ediff-ancestor-buffer)))))
992 (defun ediff-make-or-kill-fine-diffs (arg)
993 "Compute fine diffs. With negative prefix arg, kill fine diffs.
994 In both cases, operates on the current difference region."
995 (interactive "P")
996 (ediff-barf-if-not-control-buffer)
997 (cond ((eq arg '-)
998 (ediff-clear-fine-differences ediff-current-difference))
999 ((and (numberp arg) (< arg 0))
1000 (ediff-clear-fine-differences ediff-current-difference))
1001 (t (ediff-make-fine-diffs))))
1004 (defun ediff-toggle-help ()
1005 "Toggle short/long help message."
1006 (interactive)
1007 (ediff-barf-if-not-control-buffer)
1008 (let (buffer-read-only)
1009 (erase-buffer)
1010 (setq ediff-use-long-help-message (not ediff-use-long-help-message))
1011 (ediff-set-help-message))
1012 ;; remember the icon status of the control frame when the user requested
1013 ;; full control message
1014 (if (and ediff-use-long-help-message (ediff-multiframe-setup-p))
1015 (setq ediff-prefer-iconified-control-frame
1016 (ediff-frame-iconified-p ediff-control-frame)))
1018 (setq ediff-window-config-saved "") ; force redisplay
1019 (ediff-recenter 'no-rehighlight))
1022 ;; If BUF, this is the buffer to toggle, not current buffer.
1023 (defun ediff-toggle-read-only (&optional buf)
1024 "Toggle read-only in current buffer.
1025 If buffer is under version control and locked, check it out first.
1026 If optional argument BUF is specified, toggle read-only in that buffer instead
1027 of the current buffer."
1028 (interactive)
1029 (ediff-barf-if-not-control-buffer)
1030 (let ((ctl-buf (if (null buf) (current-buffer)))
1031 (buf-type (ediff-char-to-buftype last-command-char)))
1032 (or buf (ediff-recenter))
1033 (or buf
1034 (setq buf (ediff-get-buffer buf-type)))
1036 (ediff-with-current-buffer buf ; eval in buf A/B/C
1037 (let* ((file (buffer-file-name buf))
1038 (file-writable (and file
1039 (file-exists-p file)
1040 (file-writable-p file)))
1041 (toggle-ro-cmd (cond (ediff-toggle-read-only-function)
1042 ((ediff-file-checked-out-p file)
1043 'toggle-read-only)
1044 (file-writable 'toggle-read-only)
1045 (t (key-binding "\C-x\C-q")))))
1046 ;; If the file is checked in, make sure we don't make buffer modifiable
1047 ;; without warning the user. The user can fool our checks by making the
1048 ;; buffer non-RO without checking the file out. We regard this as a
1049 ;; user problem.
1050 (if (and (ediff-file-checked-in-p file)
1051 ;; If ctl-buf is null, this means we called this
1052 ;; non-interactively, in which case don't ask questions
1053 ctl-buf)
1054 (cond ((not buffer-read-only)
1055 (setq toggle-ro-cmd 'toggle-read-only))
1056 ((and (or (beep 1) t) ; always beep
1057 (y-or-n-p
1058 (format
1059 "File %s is under version control. Check it out? "
1060 (ediff-abbreviate-file-name file))))
1061 ;; if we checked the file out, we should also change the
1062 ;; original state of buffer-read-only to nil. If we don't
1063 ;; do this, the mode line will show %%, since the file was
1064 ;; RO before ediff started, so the user will think the file
1065 ;; is checked in.
1066 (ediff-with-current-buffer ctl-buf
1067 (ediff-change-saved-variable
1068 'buffer-read-only nil buf-type)))
1070 (setq toggle-ro-cmd 'toggle-read-only)
1071 (beep 1) (beep 1)
1072 (message
1073 "Boy, this is risky! Don't modify this file...")
1074 (sit-for 3)))) ; let the user see the warning
1075 (if (and toggle-ro-cmd
1076 (string-match "toggle-read-only" (symbol-name toggle-ro-cmd)))
1077 (save-excursion
1078 (save-window-excursion
1079 (select-window (ediff-get-visible-buffer-window buf))
1080 (command-execute toggle-ro-cmd)))
1081 (error "Don't know how to toggle read-only in buffer %S" buf))
1083 ;; Check if we made the current buffer updatable, but its file is RO.
1084 ;; Signal a warning in this case.
1085 (if (and file (not buffer-read-only)
1086 (eq this-command 'ediff-toggle-read-only)
1087 (file-exists-p file)
1088 (not (file-writable-p file)))
1089 (progn
1090 (beep 1)
1091 (message "Warning: file %s is read-only"
1092 (ediff-abbreviate-file-name file))))
1093 ))))
1095 ;; checkout if visited file is checked in
1096 (defun ediff-maybe-checkout (buf)
1097 (let ((file (expand-file-name (buffer-file-name buf)))
1098 (checkout-function (key-binding "\C-x\C-q")))
1099 (if (and (ediff-file-checked-in-p file)
1100 (or (beep 1) t)
1101 (y-or-n-p
1102 (format
1103 "File %s is under version control. Check it out? "
1104 (ediff-abbreviate-file-name file))))
1105 (ediff-with-current-buffer buf
1106 (command-execute checkout-function)))))
1109 ;; This is a simple-minded check for whether a file is under version control.
1110 ;; If file,v exists but file doesn't, this file is considered to be not checked
1111 ;; in and not checked out for the purpose of patching (since patch won't be
1112 ;; able to read such a file anyway).
1113 ;; FILE is a string representing file name
1114 ;;(defun ediff-file-under-version-control (file)
1115 ;; (let* ((filedir (file-name-directory file))
1116 ;; (file-nondir (file-name-nondirectory file))
1117 ;; (trial (concat file-nondir ",v"))
1118 ;; (full-trial (concat filedir trial))
1119 ;; (full-rcs-trial (concat filedir "RCS/" trial)))
1120 ;; (and (stringp file)
1121 ;; (file-exists-p file)
1122 ;; (or
1123 ;; (and
1124 ;; (file-exists-p full-trial)
1125 ;; ;; in FAT FS, `file,v' and `file' may turn out to be the same!
1126 ;; ;; don't be fooled by this!
1127 ;; (not (equal (file-attributes file)
1128 ;; (file-attributes full-trial))))
1129 ;; ;; check if a version is in RCS/ directory
1130 ;; (file-exists-p full-rcs-trial)))
1131 ;; ))
1134 (defun ediff-file-checked-out-p (file)
1135 (or (not (featurep 'vc-hooks))
1136 (and (vc-backend file)
1137 (if (fboundp 'vc-state)
1138 (or (memq (vc-state file) '(edited needs-merge))
1139 (stringp (vc-state file)))
1140 ;; XEmacs has no vc-state
1141 (when (featurep 'xemacs) (vc-locking-user file)))
1144 (defun ediff-file-checked-in-p (file)
1145 (and (featurep 'vc-hooks)
1146 ;; CVS files are considered not checked in
1147 (not (memq (vc-backend file) '(nil CVS)))
1148 (if (fboundp 'vc-state)
1149 (and
1150 (not (memq (vc-state file) '(edited needs-merge)))
1151 (not (stringp (vc-state file))))
1152 ;; XEmacs has no vc-state
1153 (when (featurep 'xemacs) (not (vc-locking-user file))))
1156 (defun ediff-file-compressed-p (file)
1157 (condition-case nil
1158 (require 'jka-compr)
1159 (error))
1160 (if (featurep 'jka-compr)
1161 (string-match (jka-compr-build-file-regexp) file)))
1164 (defun ediff-swap-buffers ()
1165 "Rotate the display of buffers A, B, and C."
1166 (interactive)
1167 (ediff-barf-if-not-control-buffer)
1168 (if (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))
1169 (let ((buf ediff-buffer-A)
1170 (values ediff-buffer-values-orig-A)
1171 (diff-vec ediff-difference-vector-A)
1172 (hide-regexp ediff-regexp-hide-A)
1173 (focus-regexp ediff-regexp-focus-A)
1174 (wide-visibility-p (eq ediff-visible-bounds ediff-wide-bounds))
1175 (overlay (if (ediff-has-face-support-p)
1176 ediff-current-diff-overlay-A)))
1177 (if ediff-3way-comparison-job
1178 (progn
1179 (set-window-buffer ediff-window-A ediff-buffer-C)
1180 (set-window-buffer ediff-window-B ediff-buffer-A)
1181 (set-window-buffer ediff-window-C ediff-buffer-B)
1183 (set-window-buffer ediff-window-A ediff-buffer-B)
1184 (set-window-buffer ediff-window-B ediff-buffer-A))
1185 ;; swap diff buffers
1186 (if ediff-3way-comparison-job
1187 (setq ediff-buffer-A ediff-buffer-C
1188 ediff-buffer-C ediff-buffer-B
1189 ediff-buffer-B buf)
1190 (setq ediff-buffer-A ediff-buffer-B
1191 ediff-buffer-B buf))
1193 ;; swap saved buffer characteristics
1194 (if ediff-3way-comparison-job
1195 (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-C
1196 ediff-buffer-values-orig-C ediff-buffer-values-orig-B
1197 ediff-buffer-values-orig-B values)
1198 (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-B
1199 ediff-buffer-values-orig-B values))
1201 ;; swap diff vectors
1202 (if ediff-3way-comparison-job
1203 (setq ediff-difference-vector-A ediff-difference-vector-C
1204 ediff-difference-vector-C ediff-difference-vector-B
1205 ediff-difference-vector-B diff-vec)
1206 (setq ediff-difference-vector-A ediff-difference-vector-B
1207 ediff-difference-vector-B diff-vec))
1209 ;; swap hide/focus regexp
1210 (if ediff-3way-comparison-job
1211 (setq ediff-regexp-hide-A ediff-regexp-hide-C
1212 ediff-regexp-hide-C ediff-regexp-hide-B
1213 ediff-regexp-hide-B hide-regexp
1214 ediff-regexp-focus-A ediff-regexp-focus-C
1215 ediff-regexp-focus-C ediff-regexp-focus-B
1216 ediff-regexp-focus-B focus-regexp)
1217 (setq ediff-regexp-hide-A ediff-regexp-hide-B
1218 ediff-regexp-hide-B hide-regexp
1219 ediff-regexp-focus-A ediff-regexp-focus-B
1220 ediff-regexp-focus-B focus-regexp))
1222 ;; The following is needed for XEmacs, since there one can't move
1223 ;; overlay to another buffer. In Emacs, this swap is redundant.
1224 (if (ediff-has-face-support-p)
1225 (if ediff-3way-comparison-job
1226 (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-C
1227 ediff-current-diff-overlay-C ediff-current-diff-overlay-B
1228 ediff-current-diff-overlay-B overlay)
1229 (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-B
1230 ediff-current-diff-overlay-B overlay)))
1232 ;; swap wide bounds
1233 (setq ediff-wide-bounds
1234 (cond (ediff-3way-comparison-job
1235 (list (nth 2 ediff-wide-bounds)
1236 (nth 0 ediff-wide-bounds)
1237 (nth 1 ediff-wide-bounds)))
1238 (ediff-3way-job
1239 (list (nth 1 ediff-wide-bounds)
1240 (nth 0 ediff-wide-bounds)
1241 (nth 2 ediff-wide-bounds)))
1243 (list (nth 1 ediff-wide-bounds)
1244 (nth 0 ediff-wide-bounds)))))
1245 ;; swap narrow bounds
1246 (setq ediff-narrow-bounds
1247 (cond (ediff-3way-comparison-job
1248 (list (nth 2 ediff-narrow-bounds)
1249 (nth 0 ediff-narrow-bounds)
1250 (nth 1 ediff-narrow-bounds)))
1251 (ediff-3way-job
1252 (list (nth 1 ediff-narrow-bounds)
1253 (nth 0 ediff-narrow-bounds)
1254 (nth 2 ediff-narrow-bounds)))
1256 (list (nth 1 ediff-narrow-bounds)
1257 (nth 0 ediff-narrow-bounds)))))
1258 (if wide-visibility-p
1259 (setq ediff-visible-bounds ediff-wide-bounds)
1260 (setq ediff-visible-bounds ediff-narrow-bounds))
1262 (if ediff-3way-job
1263 (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer))
1264 (ediff-recenter 'no-rehighlight)
1268 (defun ediff-toggle-wide-display ()
1269 "Toggle wide/regular display.
1270 This is especially useful when comparing buffers side-by-side."
1271 (interactive)
1272 (ediff-barf-if-not-control-buffer)
1273 (or (ediff-window-display-p)
1274 (error "%sEmacs is not running as a window application"
1275 (if (featurep 'emacs) "" "X")))
1276 (ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows
1277 (let ((ctl-buf ediff-control-buffer))
1278 (setq ediff-wide-display-p (not ediff-wide-display-p))
1279 (if (not ediff-wide-display-p)
1280 (ediff-with-current-buffer ctl-buf
1281 (modify-frame-parameters
1282 ediff-wide-display-frame ediff-wide-display-orig-parameters)
1283 ;;(sit-for (if (featurep 'xemacs) 0.4 0))
1284 ;; restore control buf, since ctl window may have been deleted
1285 ;; during resizing
1286 (set-buffer ctl-buf)
1287 (setq ediff-wide-display-orig-parameters nil
1288 ediff-window-B nil) ; force update of window config
1289 (ediff-recenter 'no-rehighlight))
1290 (funcall ediff-make-wide-display-function)
1291 ;;(sit-for (if (featurep 'xemacs) 0.4 0))
1292 (ediff-with-current-buffer ctl-buf
1293 (setq ediff-window-B nil) ; force update of window config
1294 (ediff-recenter 'no-rehighlight)))))
1296 ;;;###autoload
1297 (defun ediff-toggle-multiframe ()
1298 "Switch from multiframe display to single-frame display and back.
1299 To change the default, set the variable `ediff-window-setup-function',
1300 which see."
1301 (interactive)
1302 (let (window-setup-func)
1303 (or (ediff-window-display-p)
1304 (error "%sEmacs is not running as a window application"
1305 (if (featurep 'emacs) "" "X")))
1307 (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe)
1308 (setq window-setup-func 'ediff-setup-windows-plain))
1309 ((eq ediff-window-setup-function 'ediff-setup-windows-plain)
1310 (if (ediff-in-control-buffer-p)
1311 (ediff-kill-bottom-toolbar))
1312 (setq window-setup-func 'ediff-setup-windows-multiframe)))
1314 ;; change default
1315 (setq-default ediff-window-setup-function window-setup-func)
1316 ;; change in all active ediff sessions
1317 (mapc (lambda(buf) (ediff-with-current-buffer buf
1318 (setq ediff-window-setup-function window-setup-func
1319 ediff-window-B nil)))
1320 ediff-session-registry)
1321 (if (ediff-in-control-buffer-p)
1322 (ediff-recenter 'no-rehighlight))))
1325 ;;;###autoload
1326 (defun ediff-toggle-use-toolbar ()
1327 "Enable or disable Ediff toolbar.
1328 Works only in versions of Emacs that support toolbars.
1329 To change the default, set the variable `ediff-use-toolbar-p', which see."
1330 (interactive)
1331 (if (featurep 'ediff-tbar)
1332 (progn
1333 (or (ediff-window-display-p)
1334 (error "%sEmacs is not running as a window application"
1335 (if (featurep 'emacs) "" "X")))
1336 (if (ediff-use-toolbar-p)
1337 (ediff-kill-bottom-toolbar))
1338 ;; do this only after killing the toolbar
1339 (setq ediff-use-toolbar-p (not ediff-use-toolbar-p))
1341 (mapc (lambda(buf)
1342 (ediff-with-current-buffer buf
1343 ;; force redisplay
1344 (setq ediff-window-config-saved "")
1346 ediff-session-registry)
1347 (if (ediff-in-control-buffer-p)
1348 (ediff-recenter 'no-rehighlight)))))
1351 ;; if was using toolbar, kill it
1352 (defun ediff-kill-bottom-toolbar ()
1353 ;; Using ctl-buffer or ediff-control-window for LOCALE does not
1354 ;; work properly in XEmacs 19.14: we have to use
1355 ;;(selected-frame).
1356 ;; The problem with this is that any previous bottom-toolbar
1357 ;; will not re-appear after our cleanup here. Is there a way
1358 ;; to do "push" and "pop" toolbars ? --marcpa
1359 (if (featurep 'xemacs)
1360 (when (ediff-use-toolbar-p)
1361 (set-specifier bottom-toolbar (list (selected-frame) nil))
1362 (set-specifier bottom-toolbar-visible-p (list (selected-frame) nil)))))
1364 ;; If wants to use toolbar, make it.
1365 ;; If not, zero the toolbar for XEmacs.
1366 ;; Do nothing for Emacs.
1367 (defun ediff-make-bottom-toolbar (&optional frame)
1368 (when (ediff-window-display-p)
1369 (setq frame (or frame (selected-frame)))
1370 (if (featurep 'xemacs)
1371 (cond ((ediff-use-toolbar-p) ; this checks for XEmacs
1372 (set-specifier
1373 bottom-toolbar
1374 (list frame (if (ediff-3way-comparison-job)
1375 ediff-toolbar-3way ediff-toolbar)))
1376 (set-specifier bottom-toolbar-visible-p (list frame t))
1377 (set-specifier bottom-toolbar-height
1378 (list frame ediff-toolbar-height)))
1379 ((ediff-has-toolbar-support-p)
1380 (set-specifier bottom-toolbar-height (list frame 0)))))))
1382 ;; Merging
1384 (defun ediff-toggle-show-clashes-only ()
1385 "Toggle the mode that shows only the merge regions where both variants differ from the ancestor."
1386 (interactive)
1387 (ediff-barf-if-not-control-buffer)
1388 (if (not ediff-merge-with-ancestor-job)
1389 (error "This command makes sense only when merging with an ancestor"))
1390 (setq ediff-show-clashes-only (not ediff-show-clashes-only))
1391 (if ediff-show-clashes-only
1392 (message "Focus on regions where both buffers differ from the ancestor")
1393 (message "Canceling focus on regions where changes clash")))
1395 (defun ediff-toggle-skip-changed-regions ()
1396 "Toggle the mode that skips the merge regions that differ from the default."
1397 (interactive)
1398 (ediff-barf-if-not-control-buffer)
1399 (setq ediff-skip-merge-regions-that-differ-from-default
1400 (not ediff-skip-merge-regions-that-differ-from-default))
1401 (if ediff-skip-merge-regions-that-differ-from-default
1402 (message "Skipping regions that differ from default setting")
1403 (message "Showing regions that differ from default setting")))
1407 ;; Widening/narrowing
1409 (defun ediff-toggle-narrow-region ()
1410 "Toggle narrowing in buffers A, B, and C.
1411 Used in ediff-windows/regions only."
1412 (interactive)
1413 (if (eq ediff-buffer-A ediff-buffer-B)
1414 (error ediff-NO-DIFFERENCES))
1415 (if (eq ediff-visible-bounds ediff-wide-bounds)
1416 (setq ediff-visible-bounds ediff-narrow-bounds)
1417 (setq ediff-visible-bounds ediff-wide-bounds))
1418 (ediff-recenter 'no-rehighlight))
1420 ;; Narrow bufs A/B/C to ediff-visible-bounds. If this is currently set to
1421 ;; ediff-wide-bounds, then this actually widens.
1422 ;; This function does nothing if job-name is not
1423 ;; ediff-regions-wordwise/linewise or ediff-windows-wordwise/linewise.
1424 ;; Does nothing if buffer-A = buffer-B since we can't narrow
1425 ;; to two different regions in one buffer.
1426 (defun ediff-visible-region ()
1427 (if (or (eq ediff-buffer-A ediff-buffer-B)
1428 (eq ediff-buffer-A ediff-buffer-C)
1429 (eq ediff-buffer-C ediff-buffer-B))
1431 ;; If ediff-*-regions/windows, ediff-visible-bounds is already set
1432 ;; Otherwise, always use full range.
1433 (if (not ediff-narrow-job)
1434 (setq ediff-visible-bounds ediff-wide-bounds))
1435 (let ((overl-A (ediff-get-value-according-to-buffer-type
1436 'A ediff-visible-bounds))
1437 (overl-B (ediff-get-value-according-to-buffer-type
1438 'B ediff-visible-bounds))
1439 (overl-C (ediff-get-value-according-to-buffer-type
1440 'C ediff-visible-bounds))
1442 (ediff-with-current-buffer ediff-buffer-A
1443 (if (ediff-overlay-buffer overl-A)
1444 (narrow-to-region
1445 (ediff-overlay-start overl-A) (ediff-overlay-end overl-A))))
1446 (ediff-with-current-buffer ediff-buffer-B
1447 (if (ediff-overlay-buffer overl-B)
1448 (narrow-to-region
1449 (ediff-overlay-start overl-B) (ediff-overlay-end overl-B))))
1451 (if (and ediff-3way-job (ediff-overlay-buffer overl-C))
1452 (ediff-with-current-buffer ediff-buffer-C
1453 (narrow-to-region
1454 (ediff-overlay-start overl-C) (ediff-overlay-end overl-C))))
1458 ;; Window scrolling operations
1460 ;; Performs some operation on the two file windows (if they are showing).
1461 ;; Traps all errors on the operation in windows A/B/C.
1462 ;; Usually, errors come from scrolling off the
1463 ;; beginning or end of the buffer, and this gives error messages.
1464 (defun ediff-operate-on-windows (operation arg)
1466 ;; make sure windows aren't dead
1467 (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)))
1468 (ediff-recenter 'no-rehighlight))
1469 (if (not (and (ediff-buffer-live-p ediff-buffer-A)
1470 (ediff-buffer-live-p ediff-buffer-B)
1471 (or (not ediff-3way-job) ediff-buffer-C)
1473 (error ediff-KILLED-VITAL-BUFFER))
1475 (let* ((wind (selected-window))
1476 (wind-A ediff-window-A)
1477 (wind-B ediff-window-B)
1478 (wind-C ediff-window-C)
1479 (coefA (ediff-get-region-size-coefficient 'A operation))
1480 (coefB (ediff-get-region-size-coefficient 'B operation))
1481 (three-way ediff-3way-job)
1482 (coefC (if three-way
1483 (ediff-get-region-size-coefficient 'C operation))))
1485 (select-window wind-A)
1486 (condition-case nil
1487 (funcall operation (round (* coefA arg)))
1488 (error))
1489 (select-window wind-B)
1490 (condition-case nil
1491 (funcall operation (round (* coefB arg)))
1492 (error))
1493 (if three-way
1494 (progn
1495 (select-window wind-C)
1496 (condition-case nil
1497 (funcall operation (round (* coefC arg)))
1498 (error))))
1499 (select-window wind)))
1501 (defun ediff-scroll-vertically (&optional arg)
1502 "Vertically scroll buffers A, B \(and C if appropriate\).
1503 With optional argument ARG, scroll ARG lines; otherwise scroll by nearly
1504 the one half of the height of window-A."
1505 (interactive "P")
1506 (ediff-barf-if-not-control-buffer)
1508 ;; make sure windows aren't dead
1509 (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)))
1510 (ediff-recenter 'no-rehighlight))
1511 (if (not (and (ediff-buffer-live-p ediff-buffer-A)
1512 (ediff-buffer-live-p ediff-buffer-B)
1513 (or (not ediff-3way-job)
1514 (ediff-buffer-live-p ediff-buffer-C))
1516 (error ediff-KILLED-VITAL-BUFFER))
1518 (ediff-operate-on-windows
1519 (if (memq last-command-char '(?v ?\C-v))
1520 'scroll-up
1521 'scroll-down)
1522 ;; calculate argument to scroll-up/down
1523 ;; if there is an explicit argument
1524 (if (and arg (not (equal arg '-)))
1525 ;; use it
1526 (prefix-numeric-value arg)
1527 ;; if not, see if we can determine a default amount (the window height)
1528 (let (default-amount)
1529 (setq default-amount
1530 (- (/ (min (window-height ediff-window-A)
1531 (window-height ediff-window-B)
1532 (if ediff-3way-job
1533 (window-height ediff-window-C)
1534 500)) ; some large number
1536 1 next-screen-context-lines))
1537 ;; window found
1538 (if arg
1539 ;; C-u as argument means half of default amount
1540 (/ default-amount 2)
1541 ;; no argument means default amount
1542 default-amount)))))
1545 (defun ediff-scroll-horizontally (&optional arg)
1546 "Horizontally scroll buffers A, B \(and C if appropriate\).
1547 If an argument is given, that is how many columns are scrolled, else nearly
1548 the width of the A/B/C windows."
1549 (interactive "P")
1550 (ediff-barf-if-not-control-buffer)
1552 ;; make sure windows aren't dead
1553 (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)))
1554 (ediff-recenter 'no-rehighlight))
1555 (if (not (and (ediff-buffer-live-p ediff-buffer-A)
1556 (ediff-buffer-live-p ediff-buffer-B)
1557 (or (not ediff-3way-job)
1558 (ediff-buffer-live-p ediff-buffer-C))
1560 (error ediff-KILLED-VITAL-BUFFER))
1562 (ediff-operate-on-windows
1563 ;; Arrange for scroll-left and scroll-right being called
1564 ;; interactively so that they set the window's min_hscroll.
1565 ;; Otherwise, automatic hscrolling will undo the effect of
1566 ;; hscrolling.
1567 (if (= last-command-char ?<)
1568 (lambda (arg)
1569 (let ((prefix-arg arg))
1570 (call-interactively 'scroll-left)))
1571 (lambda (arg)
1572 (let ((prefix-arg arg))
1573 (call-interactively 'scroll-right))))
1574 ;; calculate argument to scroll-left/right
1575 ;; if there is an explicit argument
1576 (if (and arg (not (equal arg '-)))
1577 ;; use it
1578 (prefix-numeric-value arg)
1579 ;; if not, see if we can determine a default amount
1580 ;; (half the window width)
1581 (if (null ediff-control-window)
1582 ;; no control window, use nil
1584 (let ((default-amount
1585 (- (/ (min (window-width ediff-window-A)
1586 (window-width ediff-window-B)
1587 (if ediff-3way-comparison-job
1588 (window-width ediff-window-C)
1589 500) ; some large number
1592 3)))
1593 ;; window found
1594 (if arg
1595 ;; C-u as argument means half of default amount
1596 (/ default-amount 2)
1597 ;; no argument means default amount
1598 default-amount))))))
1601 ;;BEG, END show the region to be positioned.
1602 ;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions
1603 ;;differently.
1604 (defun ediff-position-region (beg end pos job-name)
1605 (if (> end (point-max))
1606 (setq end (point-max)))
1607 (if ediff-windows-job
1608 (if (pos-visible-in-window-p end)
1609 () ; do nothing, wind is already positioned
1610 ;; at this point, windows are positioned at the beginning of the
1611 ;; file regions (not diff-regions) being compared.
1612 (save-excursion
1613 (move-to-window-line (- (window-height) 2))
1614 (let ((amount (+ 2 (count-lines (point) end))))
1615 (scroll-up amount))))
1616 (set-window-start (selected-window) beg)
1617 (if (pos-visible-in-window-p end)
1618 ;; Determine the number of lines that the region occupies
1619 (let ((lines 0)
1620 (prev-point 0))
1621 (while ( and (> end (progn
1622 (move-to-window-line lines)
1623 (point)))
1624 ;; `end' may be beyond the window bottom, so check
1625 ;; that we are making progress
1626 (< prev-point (point)))
1627 (setq prev-point (point))
1628 (setq lines (1+ lines)))
1629 ;; And position the beginning on the right line
1630 (goto-char beg)
1631 (recenter (/ (1+ (max (- (1- (window-height (selected-window)))
1632 lines)
1635 2))))
1636 (goto-char pos)
1639 ;; get number of lines from window start to region end
1640 (defun ediff-get-lines-to-region-end (buf-type &optional n ctl-buf)
1641 (or n (setq n ediff-current-difference))
1642 (or ctl-buf (setq ctl-buf ediff-control-buffer))
1643 (ediff-with-current-buffer ctl-buf
1644 (let* ((buf (ediff-get-buffer buf-type))
1645 (wind (eval (ediff-get-symbol-from-alist
1646 buf-type ediff-window-alist)))
1647 (beg (window-start wind))
1648 (end (ediff-get-diff-posn buf-type 'end))
1649 lines)
1650 (ediff-with-current-buffer buf
1651 (if (< beg end)
1652 (setq lines (count-lines beg end))
1653 (setq lines 0))
1654 lines
1655 ))))
1657 ;; Calculate the number of lines from window end to the start of diff region
1658 (defun ediff-get-lines-to-region-start (buf-type &optional diff-num ctl-buf)
1659 (or diff-num (setq diff-num ediff-current-difference))
1660 (or ctl-buf (setq ctl-buf ediff-control-buffer))
1661 (ediff-with-current-buffer ctl-buf
1662 (let* ((buf (ediff-get-buffer buf-type))
1663 (wind (eval (ediff-get-symbol-from-alist
1664 buf-type ediff-window-alist)))
1665 (end (or (window-end wind) (window-end wind t)))
1666 (beg (ediff-get-diff-posn buf-type 'beg diff-num)))
1667 (ediff-with-current-buffer buf
1668 (if (< beg end)
1669 (count-lines (max beg (point-min)) (min end (point-max))) 0))
1673 ;; region size coefficient is a coefficient by which to adjust scrolling
1674 ;; up/down of the window displaying buffer of type BUFTYPE.
1675 ;; The purpose of this coefficient is to make the windows scroll in sync, so
1676 ;; that it won't happen that one diff region is scrolled off while the other is
1677 ;; still seen.
1679 ;; If the difference region is invalid, the coefficient is 1
1680 (defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf)
1681 (ediff-with-current-buffer (or ctl-buf ediff-control-buffer)
1682 (if (ediff-valid-difference-p n)
1683 (let* ((func (cond ((eq op 'scroll-down)
1684 'ediff-get-lines-to-region-start)
1685 ((eq op 'scroll-up)
1686 'ediff-get-lines-to-region-end)
1687 (t '(lambda (a b c) 0))))
1688 (max-lines (max (funcall func 'A n ctl-buf)
1689 (funcall func 'B n ctl-buf)
1690 (if (ediff-buffer-live-p ediff-buffer-C)
1691 (funcall func 'C n ctl-buf)
1692 0))))
1693 ;; this covers the horizontal coefficient as well:
1694 ;; if max-lines = 0 then coef = 1
1695 (if (> max-lines 0)
1696 (/ (+ (funcall func buf-type n ctl-buf) 0.0)
1697 (+ max-lines 0.0))
1699 1)))
1702 (defun ediff-next-difference (&optional arg)
1703 "Advance to the next difference.
1704 With a prefix argument, go forward that many differences."
1705 (interactive "p")
1706 (ediff-barf-if-not-control-buffer)
1707 (if (< ediff-current-difference ediff-number-of-differences)
1708 (let ((n (min ediff-number-of-differences
1709 (+ ediff-current-difference (or arg 1))))
1710 non-clash-skip skip-changed regexp-skip)
1712 (ediff-visible-region)
1713 (or (>= n ediff-number-of-differences)
1714 (setq regexp-skip (funcall ediff-skip-diff-region-function n))
1715 ;; this won't exec if regexp-skip is t
1716 (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
1717 skip-changed
1718 (ediff-skip-merge-region-if-changed-from-default-p n))
1719 (ediff-install-fine-diff-if-necessary n))
1720 ;; Skip loop
1721 (while (and (< n ediff-number-of-differences)
1723 ;; regexp skip
1724 regexp-skip
1725 ;; skip clashes, if necessary
1726 non-clash-skip
1727 ;; skip processed regions
1728 skip-changed
1729 ;; skip difference regions that differ in white space
1730 (and ediff-ignore-similar-regions
1731 (ediff-merge-region-is-non-clash n)
1732 (or (eq (ediff-no-fine-diffs-p n) t)
1733 (and (ediff-merge-job)
1734 (eq (ediff-no-fine-diffs-p n) 'C)))
1736 (setq n (1+ n))
1737 (if (= 0 (mod n 20))
1738 (message "Skipped over region %d and counting ..." n))
1739 (or (>= n ediff-number-of-differences)
1740 (setq regexp-skip (funcall ediff-skip-diff-region-function n))
1741 ;; this won't exec if regexp-skip is t
1742 (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
1743 skip-changed
1744 (ediff-skip-merge-region-if-changed-from-default-p n))
1745 (ediff-install-fine-diff-if-necessary n))
1747 (message "")
1748 (ediff-unselect-and-select-difference n)
1749 ) ; let
1750 (ediff-visible-region)
1751 (error "At end of the difference list")))
1753 (defun ediff-previous-difference (&optional arg)
1754 "Go to the previous difference.
1755 With a prefix argument, go back that many differences."
1756 (interactive "p")
1757 (ediff-barf-if-not-control-buffer)
1758 (if (> ediff-current-difference -1)
1759 (let ((n (max -1 (- ediff-current-difference (or arg 1))))
1760 non-clash-skip skip-changed regexp-skip)
1762 (ediff-visible-region)
1763 (or (< n 0)
1764 (setq regexp-skip (funcall ediff-skip-diff-region-function n))
1765 ;; this won't exec if regexp-skip is t
1766 (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
1767 skip-changed
1768 (ediff-skip-merge-region-if-changed-from-default-p n))
1769 (ediff-install-fine-diff-if-necessary n))
1770 (while (and (> n -1)
1772 ;; regexp skip
1773 regexp-skip
1774 ;; skip clashes, if necessary
1775 non-clash-skip
1776 ;; skipp changed regions
1777 skip-changed
1778 ;; skip difference regions that differ in white space
1779 (and ediff-ignore-similar-regions
1780 (ediff-merge-region-is-non-clash n)
1781 (or (eq (ediff-no-fine-diffs-p n) t)
1782 (and (ediff-merge-job)
1783 (eq (ediff-no-fine-diffs-p n) 'C)))
1785 (if (= 0 (mod (1+ n) 20))
1786 (message "Skipped over region %d and counting ..." (1+ n)))
1787 (setq n (1- n))
1788 (or (< n 0)
1789 (setq regexp-skip (funcall ediff-skip-diff-region-function n))
1790 ;; this won't exec if regexp-skip is t
1791 (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n)
1792 skip-changed
1793 (ediff-skip-merge-region-if-changed-from-default-p n))
1794 (ediff-install-fine-diff-if-necessary n))
1796 (message "")
1797 (ediff-unselect-and-select-difference n)
1798 ) ; let
1799 (ediff-visible-region)
1800 (error "At beginning of the difference list")))
1802 ;; The diff number is as perceived by the user (i.e., 1+ the internal
1803 ;; representation)
1804 (defun ediff-jump-to-difference (difference-number)
1805 "Go to the difference specified as a prefix argument.
1806 If the prefix is negative, count differences from the end."
1807 (interactive "p")
1808 (ediff-barf-if-not-control-buffer)
1809 (setq difference-number
1810 (cond ((< difference-number 0)
1811 (+ ediff-number-of-differences difference-number))
1812 ((> difference-number 0) (1- difference-number))
1813 (t -1)))
1814 ;; -1 is allowed by ediff-unselect-and-select-difference --- it is the
1815 ;; position before the first one.
1816 (if (and (>= difference-number -1)
1817 (<= difference-number ediff-number-of-differences))
1818 (ediff-unselect-and-select-difference difference-number)
1819 (error ediff-BAD-DIFF-NUMBER
1820 this-command (1+ difference-number) ediff-number-of-differences)))
1822 (defun ediff-jump-to-difference-at-point (arg)
1823 "Go to difference closest to the point in buffer A, B, or C.
1824 The buffer depends on last command character \(a, b, or c\) that invoked this
1825 command. For instance, if the command was `ga' then the point value in buffer
1826 A is used.
1827 With a prefix argument, synchronize all files around the current point position
1828 in the specified buffer."
1829 (interactive "P")
1830 (ediff-barf-if-not-control-buffer)
1831 (let* ((buf-type (ediff-char-to-buftype last-command-char))
1832 (buffer (ediff-get-buffer buf-type))
1833 (pt (ediff-with-current-buffer buffer (point)))
1834 (diff-no (ediff-diff-at-point buf-type nil (if arg 'after)))
1835 (past-last-diff (< ediff-number-of-differences diff-no))
1836 (beg (if past-last-diff
1837 (ediff-with-current-buffer buffer (point-max))
1838 (ediff-get-diff-posn buf-type 'beg (1- diff-no))))
1839 ctl-wind wind-A wind-B wind-C
1840 shift)
1841 (if past-last-diff
1842 (ediff-jump-to-difference -1)
1843 (ediff-jump-to-difference diff-no))
1844 (setq ctl-wind (selected-window)
1845 wind-A ediff-window-A
1846 wind-B ediff-window-B
1847 wind-C ediff-window-C)
1848 (if arg
1849 (progn
1850 (ediff-with-current-buffer buffer
1851 (setq shift (- beg pt)))
1852 (select-window wind-A)
1853 (if past-last-diff (goto-char (point-max)))
1854 (condition-case nil
1855 (backward-char shift) ; noerror, if beginning of buffer
1856 (error))
1857 (recenter)
1858 (select-window wind-B)
1859 (if past-last-diff (goto-char (point-max)))
1860 (condition-case nil
1861 (backward-char shift) ; noerror, if beginning of buffer
1862 (error))
1863 (recenter)
1864 (if (window-live-p wind-C)
1865 (progn
1866 (select-window wind-C)
1867 (if past-last-diff (goto-char (point-max)))
1868 (condition-case nil
1869 (backward-char shift) ; noerror, if beginning of buffer
1870 (error))
1871 (recenter)
1873 (select-window ctl-wind)
1878 ;; find region most related to the current point position (or POS, if given)
1879 ;; returns diff number as seen by the user (i.e., 1+ the internal
1880 ;; representation)
1881 ;; The optional argument WHICH-DIFF can be `after' or `before'. If `after',
1882 ;; find the diff after the point. If `before', find the diff before the
1883 ;; point. If the point is inside a diff, return that diff.
1884 (defun ediff-diff-at-point (buf-type &optional pos which-diff)
1885 (let ((buffer (ediff-get-buffer buf-type))
1886 (ctl-buffer ediff-control-buffer)
1887 (max-dif-num (1- ediff-number-of-differences))
1888 (diff-no -1)
1889 (prev-beg 0)
1890 (prev-end 0)
1891 (beg 0)
1892 (end 0))
1894 (ediff-with-current-buffer buffer
1895 (setq pos (or pos (point)))
1896 (while (and (or (< pos prev-beg) (> pos beg))
1897 (< diff-no max-dif-num))
1898 (setq diff-no (1+ diff-no))
1899 (setq prev-beg beg
1900 prev-end end)
1901 (setq beg (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer)
1902 end (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer))
1905 ;; boost diff-no by 1, if past the last diff region
1906 (if (and (memq which-diff '(after before))
1907 (> pos beg) (= diff-no max-dif-num))
1908 (setq diff-no (1+ diff-no)))
1910 (cond ((eq which-diff 'after) (1+ diff-no))
1911 ((eq which-diff 'before) diff-no)
1912 ((< (abs (count-lines pos (max 1 prev-end)))
1913 (abs (count-lines pos (max 1 beg))))
1914 diff-no) ; choose prev difference
1916 (1+ diff-no))) ; choose next difference
1920 ;;; Copying diffs.
1922 (defun ediff-diff-to-diff (arg &optional keys)
1923 "Copy buffer-X'th difference region to buffer Y \(X,Y are A, B, or C\).
1924 If numerical prefix argument, copy the difference specified in the arg.
1925 Otherwise, copy the difference given by `ediff-current-difference'.
1926 This command assumes it is bound to a 2-character key sequence, `ab', `ba',
1927 `ac', etc., which is used to determine the types of buffers to be used for
1928 copying difference regions. The first character in the sequence specifies
1929 the source buffer and the second specifies the target.
1931 If the second optional argument, a 2-character string, is given, use it to
1932 determine the source and the target buffers instead of the command keys."
1933 (interactive "P")
1934 (ediff-barf-if-not-control-buffer)
1935 (or keys (setq keys (this-command-keys)))
1936 (if (eq arg '-) (setq arg -1)) ; translate neg arg to -1
1937 (if (numberp arg) (ediff-jump-to-difference arg))
1939 (let* ((key1 (aref keys 0))
1940 (key2 (aref keys 1))
1941 (char1 (ediff-event-key key1))
1942 (char2 (ediff-event-key key2))
1943 ediff-verbose-p)
1944 (ediff-copy-diff ediff-current-difference
1945 (ediff-char-to-buftype char1)
1946 (ediff-char-to-buftype char2))
1947 ;; recenter with rehighlighting, but no messages
1948 (ediff-recenter)))
1950 (defun ediff-copy-A-to-B (arg)
1951 "Copy ARGth difference region from buffer A to B.
1952 ARG is a prefix argument. If nil, copy the current difference region."
1953 (interactive "P")
1954 (ediff-diff-to-diff arg "ab"))
1956 (defun ediff-copy-B-to-A (arg)
1957 "Copy ARGth difference region from buffer B to A.
1958 ARG is a prefix argument. If nil, copy the current difference region."
1959 (interactive "P")
1960 (ediff-diff-to-diff arg "ba"))
1962 (defun ediff-copy-A-to-C (arg)
1963 "Copy ARGth difference region from buffer A to buffer C.
1964 ARG is a prefix argument. If nil, copy the current difference region."
1965 (interactive "P")
1966 (ediff-diff-to-diff arg "ac"))
1968 (defun ediff-copy-B-to-C (arg)
1969 "Copy ARGth difference region from buffer B to buffer C.
1970 ARG is a prefix argument. If nil, copy the current difference region."
1971 (interactive "P")
1972 (ediff-diff-to-diff arg "bc"))
1974 (defun ediff-copy-C-to-B (arg)
1975 "Copy ARGth difference region from buffer C to B.
1976 ARG is a prefix argument. If nil, copy the current difference region."
1977 (interactive "P")
1978 (ediff-diff-to-diff arg "cb"))
1980 (defun ediff-copy-C-to-A (arg)
1981 "Copy ARGth difference region from buffer C to A.
1982 ARG is a prefix argument. If nil, copy the current difference region."
1983 (interactive "P")
1984 (ediff-diff-to-diff arg "ca"))
1988 ;; Copy diff N from FROM-BUF-TYPE \(given as A, B or C\) to TO-BUF-TYPE.
1989 ;; If optional DO-NOT-SAVE is non-nil, do not save the old value of the
1990 ;; target diff. This is used in merging, when constructing the merged
1991 ;; version.
1992 (defun ediff-copy-diff (n from-buf-type to-buf-type
1993 &optional batch-invocation reg-to-copy)
1994 (let* ((to-buf (ediff-get-buffer to-buf-type))
1995 ;;(from-buf (if (not reg-to-copy) (ediff-get-buffer from-buf-type)))
1996 (ctrl-buf ediff-control-buffer)
1997 (saved-p t)
1998 (three-way ediff-3way-job)
1999 messg
2000 ediff-verbose-p
2001 reg-to-delete reg-to-delete-beg reg-to-delete-end)
2003 (setq reg-to-delete-beg
2004 (ediff-get-diff-posn to-buf-type 'beg n ctrl-buf))
2005 (setq reg-to-delete-end
2006 (ediff-get-diff-posn to-buf-type 'end n ctrl-buf))
2008 (if reg-to-copy
2009 (setq from-buf-type nil)
2010 (setq reg-to-copy (ediff-get-region-contents n from-buf-type ctrl-buf)))
2012 (setq reg-to-delete (ediff-get-region-contents
2013 n to-buf-type ctrl-buf
2014 reg-to-delete-beg reg-to-delete-end))
2016 (if (string= reg-to-delete reg-to-copy)
2017 (setq saved-p nil) ; don't copy identical buffers
2018 ;; seems ok to copy
2019 (if (or batch-invocation (ediff-test-save-region n to-buf-type))
2020 (condition-case conds
2021 (progn
2022 (ediff-with-current-buffer to-buf
2023 ;; to prevent flags from interfering if buffer is writable
2024 (let ((inhibit-read-only (null buffer-read-only)))
2026 (goto-char reg-to-delete-end)
2027 (insert reg-to-copy)
2029 (if (> reg-to-delete-end reg-to-delete-beg)
2030 (kill-region reg-to-delete-beg reg-to-delete-end))
2032 (or batch-invocation
2033 (setq
2034 messg
2035 (ediff-save-diff-region n to-buf-type reg-to-delete))))
2036 (error (message "ediff-copy-diff: %s %s"
2037 (car conds)
2038 (mapconcat 'prin1-to-string (cdr conds) " "))
2039 (beep 1)
2040 (sit-for 2) ; let the user see the error msg
2041 (setq saved-p nil)
2045 ;; adjust state of difference in case 3-way and diff was copied ok
2046 (if (and saved-p three-way)
2047 (ediff-set-state-of-diff-in-all-buffers n ctrl-buf))
2049 (if batch-invocation
2050 (ediff-clear-fine-differences n)
2051 ;; If diff3 job, we should recompute fine diffs so we clear them
2052 ;; before reinserting flags (and thus before ediff-recenter).
2053 (if (and saved-p three-way)
2054 (ediff-clear-fine-differences n))
2056 (ediff-refresh-mode-lines)
2058 ;; For diff2 jobs, don't recompute fine diffs, since we know there
2059 ;; aren't any. So we clear diffs after ediff-recenter.
2060 (if (and saved-p (not three-way))
2061 (ediff-clear-fine-differences n))
2062 ;; Make sure that the message about saving and how to restore is seen
2063 ;; by the user
2064 (message "%s" messg))
2067 ;; Save Nth diff of buffer BUF-TYPE \(A, B, or C\).
2068 ;; That is to say, the Nth diff on the `ediff-killed-diffs-alist'. REG
2069 ;; is the region to save. It is redundant here, but is passed anyway, for
2070 ;; convenience.
2071 (defun ediff-save-diff-region (n buf-type reg)
2072 (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist))
2073 (buf (ediff-get-buffer buf-type))
2074 (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved))))
2076 (if this-buf-n-th-diff-saved
2077 ;; either nothing saved for n-th diff and buffer or we OK'ed
2078 ;; overriding
2079 (setcdr this-buf-n-th-diff-saved reg)
2080 (if n-th-diff-saved ;; n-th diff saved, but for another buffer
2081 (nconc n-th-diff-saved (list (cons buf reg)))
2082 (setq ediff-killed-diffs-alist ;; create record for n-th diff
2083 (cons (list n (cons buf reg))
2084 ediff-killed-diffs-alist))))
2085 (message "Saving old diff region #%d of buffer %S. To recover, type `r%s'"
2086 (1+ n) buf-type
2087 (if ediff-merge-job
2088 "" (downcase (symbol-name buf-type))))
2091 ;; Test if saving Nth difference region of buffer BUF-TYPE is possible.
2092 (defun ediff-test-save-region (n buf-type)
2093 (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist))
2094 (buf (ediff-get-buffer buf-type))
2095 (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved))))
2097 (if this-buf-n-th-diff-saved
2098 (if (yes-or-no-p
2099 (format
2100 "You've previously copied diff region %d to buffer %S. Confirm? "
2101 (1+ n) buf-type))
2103 (error "Quit"))
2104 t)))
2106 (defun ediff-pop-diff (n buf-type)
2107 "Pop last killed Nth diff region from buffer BUF-TYPE."
2108 (let* ((n-th-record (assoc n ediff-killed-diffs-alist))
2109 (buf (ediff-get-buffer buf-type))
2110 (saved-rec (assoc buf (cdr n-th-record)))
2111 (three-way ediff-3way-job)
2112 (ctl-buf ediff-control-buffer)
2113 ediff-verbose-p
2114 saved-diff reg-beg reg-end recovered)
2116 (if (cdr saved-rec)
2117 (setq saved-diff (cdr saved-rec))
2118 (if (> ediff-number-of-differences 0)
2119 (error "Nothing saved for diff %d in buffer %S" (1+ n) buf-type)
2120 (error ediff-NO-DIFFERENCES)))
2122 (setq reg-beg (ediff-get-diff-posn buf-type 'beg n ediff-control-buffer))
2123 (setq reg-end (ediff-get-diff-posn buf-type 'end n ediff-control-buffer))
2125 (condition-case conds
2126 (ediff-with-current-buffer buf
2127 (let ((inhibit-read-only (null buffer-read-only)))
2129 (goto-char reg-end)
2130 (insert saved-diff)
2132 (if (> reg-end reg-beg)
2133 (kill-region reg-beg reg-end))
2135 (setq recovered t)
2137 (error (message "ediff-pop-diff: %s %s"
2138 (car conds)
2139 (mapconcat 'prin1-to-string (cdr conds) " "))
2140 (beep 1)))
2142 ;; Clearing fine diffs is necessary for
2143 ;; ediff-unselect-and-select-difference to properly recompute them. We
2144 ;; can't rely on ediff-copy-diff to clear this vector, as the user might
2145 ;; have modified diff regions after copying and, thus, may have recomputed
2146 ;; fine diffs.
2147 (if recovered
2148 (ediff-clear-fine-differences n))
2150 ;; adjust state of difference
2151 (if (and three-way recovered)
2152 (ediff-set-state-of-diff-in-all-buffers n ctl-buf))
2154 (ediff-refresh-mode-lines)
2156 (if recovered
2157 (progn
2158 (setq n-th-record (delq saved-rec n-th-record))
2159 (message "Diff region %d in buffer %S restored" (1+ n) buf-type)
2163 (defun ediff-restore-diff (arg &optional key)
2164 "Restore ARGth diff from `ediff-killed-diffs-alist'.
2165 ARG is a prefix argument. If ARG is nil, restore the current-difference.
2166 If the second optional argument, a character, is given, use it to
2167 determine the target buffer instead of last-command-char"
2168 (interactive "P")
2169 (ediff-barf-if-not-control-buffer)
2170 (if (numberp arg)
2171 (ediff-jump-to-difference arg))
2172 (ediff-pop-diff ediff-current-difference
2173 (ediff-char-to-buftype (or key last-command-char)))
2174 ;; recenter with rehighlighting, but no messages
2175 (let (ediff-verbose-p)
2176 (ediff-recenter)))
2178 (defun ediff-restore-diff-in-merge-buffer (arg)
2179 "Restore ARGth diff in the merge buffer.
2180 ARG is a prefix argument. If nil, restore the current diff."
2181 (interactive "P")
2182 (ediff-restore-diff arg ?c))
2185 (defun ediff-toggle-regexp-match ()
2186 "Toggle between focusing and hiding of difference regions that match
2187 a regular expression typed in by the user."
2188 (interactive)
2189 (ediff-barf-if-not-control-buffer)
2190 (let ((regexp-A "")
2191 (regexp-B "")
2192 (regexp-C "")
2193 msg-connective alt-msg-connective alt-connective)
2194 (cond
2195 ((or (and (eq ediff-skip-diff-region-function
2196 ediff-focus-on-regexp-matches-function)
2197 (eq last-command-char ?f))
2198 (and (eq ediff-skip-diff-region-function
2199 ediff-hide-regexp-matches-function)
2200 (eq last-command-char ?h)))
2201 (message "Selective browsing by regexp turned off")
2202 (setq ediff-skip-diff-region-function 'ediff-show-all-diffs))
2203 ((eq last-command-char ?h)
2204 (setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function
2205 regexp-A
2206 (read-string
2207 (format
2208 "Ignore A-regions matching this regexp (default %s): "
2209 ediff-regexp-hide-A))
2210 regexp-B
2211 (read-string
2212 (format
2213 "Ignore B-regions matching this regexp (default %s): "
2214 ediff-regexp-hide-B)))
2215 (if ediff-3way-comparison-job
2216 (setq regexp-C
2217 (read-string
2218 (format
2219 "Ignore C-regions matching this regexp (default %s): "
2220 ediff-regexp-hide-C))))
2221 (if (eq ediff-hide-regexp-connective 'and)
2222 (setq msg-connective "BOTH"
2223 alt-msg-connective "ONE OF"
2224 alt-connective 'or)
2225 (setq msg-connective "ONE OF"
2226 alt-msg-connective "BOTH"
2227 alt-connective 'and))
2228 (if (y-or-n-p
2229 (format
2230 "Ignore regions that match %s regexps, OK? "
2231 msg-connective))
2232 (message "Will ignore regions that match %s regexps" msg-connective)
2233 (setq ediff-hide-regexp-connective alt-connective)
2234 (message "Will ignore regions that match %s regexps"
2235 alt-msg-connective))
2237 (or (string= regexp-A "") (setq ediff-regexp-hide-A regexp-A))
2238 (or (string= regexp-B "") (setq ediff-regexp-hide-B regexp-B))
2239 (or (string= regexp-C "") (setq ediff-regexp-hide-C regexp-C)))
2241 ((eq last-command-char ?f)
2242 (setq ediff-skip-diff-region-function
2243 ediff-focus-on-regexp-matches-function
2244 regexp-A
2245 (read-string
2246 (format
2247 "Focus on A-regions matching this regexp (default %s): "
2248 ediff-regexp-focus-A))
2249 regexp-B
2250 (read-string
2251 (format
2252 "Focus on B-regions matching this regexp (default %s): "
2253 ediff-regexp-focus-B)))
2254 (if ediff-3way-comparison-job
2255 (setq regexp-C
2256 (read-string
2257 (format
2258 "Focus on C-regions matching this regexp (default %s): "
2259 ediff-regexp-focus-C))))
2260 (if (eq ediff-focus-regexp-connective 'and)
2261 (setq msg-connective "BOTH"
2262 alt-msg-connective "ONE OF"
2263 alt-connective 'or)
2264 (setq msg-connective "ONE OF"
2265 alt-msg-connective "BOTH"
2266 alt-connective 'and))
2267 (if (y-or-n-p
2268 (format
2269 "Focus on regions that match %s regexps, OK? "
2270 msg-connective))
2271 (message "Will focus on regions that match %s regexps"
2272 msg-connective)
2273 (setq ediff-focus-regexp-connective alt-connective)
2274 (message "Will focus on regions that match %s regexps"
2275 alt-msg-connective))
2277 (or (string= regexp-A "") (setq ediff-regexp-focus-A regexp-A))
2278 (or (string= regexp-B "") (setq ediff-regexp-focus-B regexp-B))
2279 (or (string= regexp-C "") (setq ediff-regexp-focus-C regexp-C))))))
2281 (defun ediff-toggle-skip-similar ()
2282 (interactive)
2283 (ediff-barf-if-not-control-buffer)
2284 (if (not (eq ediff-auto-refine 'on))
2285 (error
2286 "Can't skip over whitespace regions: first turn auto-refining on"))
2287 (setq ediff-ignore-similar-regions (not ediff-ignore-similar-regions))
2288 (if ediff-ignore-similar-regions
2289 (message
2290 "Skipping regions that differ only in white space & line breaks")
2291 (message "Skipping over white-space differences turned off")))
2293 (defun ediff-focus-on-regexp-matches (n)
2294 "Focus on diffs that match regexp `ediff-regexp-focus-A/B'.
2295 Regions to be ignored according to this function are those where
2296 buf A region doesn't match `ediff-regexp-focus-A' and buf B region
2297 doesn't match `ediff-regexp-focus-B'.
2298 This function returns nil if the region number N (specified as
2299 an argument) is not to be ignored and t if region N is to be ignored.
2301 N is a region number used by Ediff internally. It is 1 less
2302 the number seen by the user."
2303 (if (ediff-valid-difference-p n)
2304 (let* ((ctl-buf ediff-control-buffer)
2305 (regex-A ediff-regexp-focus-A)
2306 (regex-B ediff-regexp-focus-B)
2307 (regex-C ediff-regexp-focus-C)
2308 (reg-A-match (ediff-with-current-buffer ediff-buffer-A
2309 (save-restriction
2310 (narrow-to-region
2311 (ediff-get-diff-posn 'A 'beg n ctl-buf)
2312 (ediff-get-diff-posn 'A 'end n ctl-buf))
2313 (goto-char (point-min))
2314 (re-search-forward regex-A nil t))))
2315 (reg-B-match (ediff-with-current-buffer ediff-buffer-B
2316 (save-restriction
2317 (narrow-to-region
2318 (ediff-get-diff-posn 'B 'beg n ctl-buf)
2319 (ediff-get-diff-posn 'B 'end n ctl-buf))
2320 (re-search-forward regex-B nil t))))
2321 (reg-C-match (if ediff-3way-comparison-job
2322 (ediff-with-current-buffer ediff-buffer-C
2323 (save-restriction
2324 (narrow-to-region
2325 (ediff-get-diff-posn 'C 'beg n ctl-buf)
2326 (ediff-get-diff-posn 'C 'end n ctl-buf))
2327 (re-search-forward regex-C nil t))))))
2328 (not (eval (if ediff-3way-comparison-job
2329 (list ediff-focus-regexp-connective
2330 reg-A-match reg-B-match reg-C-match)
2331 (list ediff-focus-regexp-connective
2332 reg-A-match reg-B-match))))
2335 (defun ediff-hide-regexp-matches (n)
2336 "Hide diffs that match regexp `ediff-regexp-hide-A/B/C'.
2337 Regions to be ignored are those where buf A region matches
2338 `ediff-regexp-hide-A' and buf B region matches `ediff-regexp-hide-B'.
2339 This function returns nil if the region number N (specified as
2340 an argument) is not to be ignored and t if region N is to be ignored.
2342 N is a region number used by Ediff internally. It is 1 less
2343 the number seen by the user."
2344 (if (ediff-valid-difference-p n)
2345 (let* ((ctl-buf ediff-control-buffer)
2346 (regex-A ediff-regexp-hide-A)
2347 (regex-B ediff-regexp-hide-B)
2348 (regex-C ediff-regexp-hide-C)
2349 (reg-A-match (ediff-with-current-buffer ediff-buffer-A
2350 (save-restriction
2351 (narrow-to-region
2352 (ediff-get-diff-posn 'A 'beg n ctl-buf)
2353 (ediff-get-diff-posn 'A 'end n ctl-buf))
2354 (goto-char (point-min))
2355 (re-search-forward regex-A nil t))))
2356 (reg-B-match (ediff-with-current-buffer ediff-buffer-B
2357 (save-restriction
2358 (narrow-to-region
2359 (ediff-get-diff-posn 'B 'beg n ctl-buf)
2360 (ediff-get-diff-posn 'B 'end n ctl-buf))
2361 (goto-char (point-min))
2362 (re-search-forward regex-B nil t))))
2363 (reg-C-match (if ediff-3way-comparison-job
2364 (ediff-with-current-buffer ediff-buffer-C
2365 (save-restriction
2366 (narrow-to-region
2367 (ediff-get-diff-posn 'C 'beg n ctl-buf)
2368 (ediff-get-diff-posn 'C 'end n ctl-buf))
2369 (goto-char (point-min))
2370 (re-search-forward regex-C nil t))))))
2371 (eval (if ediff-3way-comparison-job
2372 (list ediff-hide-regexp-connective
2373 reg-A-match reg-B-match reg-C-match)
2374 (list ediff-hide-regexp-connective reg-A-match reg-B-match)))
2379 ;;; Quitting, suspending, etc.
2381 (defun ediff-quit (reverse-default-keep-variants)
2382 "Finish an Ediff session and exit Ediff.
2383 Unselects the selected difference, if any, restores the read-only and modified
2384 flags of the compared file buffers, kills Ediff buffers for this session
2385 \(but not buffers A, B, C\).
2387 If `ediff-keep-variants' is nil, the user will be asked whether the buffers
2388 containing the variants should be removed \(if they haven't been modified\).
2389 If it is t, they will be preserved unconditionally. A prefix argument,
2390 temporarily reverses the meaning of this variable."
2391 (interactive "P")
2392 (ediff-barf-if-not-control-buffer)
2393 (let ((ctl-buf (current-buffer))
2394 (ctl-frm (selected-frame))
2395 (minibuffer-auto-raise t))
2396 (if (y-or-n-p (format "Quit this Ediff session%s? "
2397 (if (ediff-buffer-live-p ediff-meta-buffer)
2398 " & show containing session group" "")))
2399 (progn
2400 (message "")
2401 (set-buffer ctl-buf)
2402 (ediff-really-quit reverse-default-keep-variants))
2403 (select-frame ctl-frm)
2404 (raise-frame ctl-frm)
2405 (message ""))))
2408 ;; Perform the quit operations.
2409 (defun ediff-really-quit (reverse-default-keep-variants)
2410 (ediff-unhighlight-diffs-totally)
2411 (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also)
2412 (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also)
2413 (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also)
2414 (ediff-clear-diff-vector 'ediff-difference-vector-Ancestor 'fine-diffs-also)
2416 (ediff-delete-temp-files)
2418 ;; Restore the visibility range. This affects only ediff-*-regions/windows.
2419 ;; Since for other job names ediff-visible-region sets
2420 ;; ediff-visible-bounds to ediff-wide-bounds, the settings below are
2421 ;; ignored for such jobs.
2422 (if ediff-quit-widened
2423 (setq ediff-visible-bounds ediff-wide-bounds)
2424 (setq ediff-visible-bounds ediff-narrow-bounds))
2426 ;; Apply selective display to narrow or widen
2427 (ediff-visible-region)
2428 (mapc (lambda (overl)
2429 (if (ediff-overlayp overl)
2430 (ediff-delete-overlay overl)))
2431 ediff-wide-bounds)
2432 (mapc (lambda (overl)
2433 (if (ediff-overlayp overl)
2434 (ediff-delete-overlay overl)))
2435 ediff-narrow-bounds)
2437 ;; restore buffer mode line id's in buffer-A/B/C
2438 (let ((control-buffer ediff-control-buffer)
2439 (meta-buffer ediff-meta-buffer)
2440 (after-quit-hook-internal ediff-after-quit-hook-internal)
2441 (session-number ediff-meta-session-number)
2442 ;; suitable working frame
2443 (warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t))
2444 (cond ((window-live-p ediff-window-A)
2445 (window-frame ediff-window-A))
2446 ((window-live-p ediff-window-B)
2447 (window-frame ediff-window-B))
2448 (t (next-frame))))))
2449 (condition-case nil
2450 (ediff-with-current-buffer ediff-buffer-A
2451 (setq ediff-this-buffer-ediff-sessions
2452 (delq control-buffer ediff-this-buffer-ediff-sessions))
2453 (kill-local-variable 'mode-line-buffer-identification)
2454 (kill-local-variable 'mode-line-format)
2456 (error))
2458 (condition-case nil
2459 (ediff-with-current-buffer ediff-buffer-B
2460 (setq ediff-this-buffer-ediff-sessions
2461 (delq control-buffer ediff-this-buffer-ediff-sessions))
2462 (kill-local-variable 'mode-line-buffer-identification)
2463 (kill-local-variable 'mode-line-format)
2465 (error))
2467 (condition-case nil
2468 (ediff-with-current-buffer ediff-buffer-C
2469 (setq ediff-this-buffer-ediff-sessions
2470 (delq control-buffer ediff-this-buffer-ediff-sessions))
2471 (kill-local-variable 'mode-line-buffer-identification)
2472 (kill-local-variable 'mode-line-format)
2474 (error))
2476 (condition-case nil
2477 (ediff-with-current-buffer ediff-ancestor-buffer
2478 (setq ediff-this-buffer-ediff-sessions
2479 (delq control-buffer ediff-this-buffer-ediff-sessions))
2480 (kill-local-variable 'mode-line-buffer-identification)
2481 (kill-local-variable 'mode-line-format)
2483 (error))
2485 (setq ediff-session-registry
2486 (delq ediff-control-buffer ediff-session-registry))
2487 (ediff-update-registry)
2488 ;; restore state of buffers to what it was before ediff
2489 (ediff-restore-protected-variables)
2491 ;; If the user interrupts (canceling saving the merge buffer), continue
2492 ;; normally.
2493 (condition-case nil
2494 (if (ediff-merge-job)
2495 (run-hooks 'ediff-quit-merge-hook))
2496 (quit))
2498 (run-hooks 'ediff-cleanup-hook)
2500 (ediff-janitor
2501 'ask
2502 ;; reverse-default-keep-variants is t if the user quits with a prefix arg
2503 (if reverse-default-keep-variants
2504 (not ediff-keep-variants)
2505 ediff-keep-variants))
2507 ;; one hook here is ediff-cleanup-mess, which kills the control buffer and
2508 ;; other auxiliary buffers. we made it into a hook to let the users do their
2509 ;; own cleanup, if needed.
2510 (run-hooks 'ediff-quit-hook)
2511 (ediff-update-meta-buffer meta-buffer nil session-number)
2513 ;; warp mouse into a working window
2514 (setq warp-frame ; if mouse is over a reasonable frame, use it
2515 (cond ((ediff-good-frame-under-mouse))
2516 (t warp-frame)))
2517 (if (and (ediff-window-display-p) (frame-live-p warp-frame) ediff-grab-mouse)
2518 (set-mouse-position (if (featurep 'emacs)
2519 warp-frame
2520 (frame-selected-window warp-frame))
2521 2 1))
2523 (run-hooks 'after-quit-hook-internal)
2526 ;; Returns frame under mouse, if this frame is not a minibuffer
2527 ;; frame. Otherwise: nil
2528 (defun ediff-good-frame-under-mouse ()
2529 (let ((frame-or-win (car (mouse-position)))
2530 (buf-name "")
2531 frame obj-ok)
2532 (setq obj-ok
2533 (if (featurep 'emacs)
2534 (frame-live-p frame-or-win)
2535 (window-live-p frame-or-win)))
2536 (if obj-ok
2537 (setq frame (if (featurep 'emacs) frame-or-win (window-frame frame-or-win))
2538 buf-name
2539 (buffer-name (window-buffer (frame-selected-window frame)))))
2540 (if (string-match "Minibuf" buf-name)
2542 frame)))
2545 (defun ediff-delete-temp-files ()
2546 (if (and (stringp ediff-temp-file-A) (file-exists-p ediff-temp-file-A))
2547 (delete-file ediff-temp-file-A))
2548 (if (and (stringp ediff-temp-file-B) (file-exists-p ediff-temp-file-B))
2549 (delete-file ediff-temp-file-B))
2550 (if (and (stringp ediff-temp-file-C) (file-exists-p ediff-temp-file-C))
2551 (delete-file ediff-temp-file-C)))
2554 ;; Kill control buffer, other auxiliary Ediff buffers.
2555 ;; Leave one of the frames split between buffers A/B/C
2556 (defun ediff-cleanup-mess ()
2557 (let* ((buff-A ediff-buffer-A)
2558 (buff-B ediff-buffer-B)
2559 (buff-C ediff-buffer-C)
2560 (ctl-buf ediff-control-buffer)
2561 (ctl-wind (ediff-get-visible-buffer-window ctl-buf))
2562 (ctl-frame ediff-control-frame)
2563 (three-way-job ediff-3way-job)
2564 (main-frame (cond ((window-live-p ediff-window-A)
2565 (window-frame ediff-window-A))
2566 ((window-live-p ediff-window-B)
2567 (window-frame ediff-window-B)))))
2569 (ediff-kill-buffer-carefully ediff-diff-buffer)
2570 (ediff-kill-buffer-carefully ediff-custom-diff-buffer)
2571 (ediff-kill-buffer-carefully ediff-fine-diff-buffer)
2572 (ediff-kill-buffer-carefully ediff-tmp-buffer)
2573 (ediff-kill-buffer-carefully ediff-error-buffer)
2574 (ediff-kill-buffer-carefully ediff-msg-buffer)
2575 (ediff-kill-buffer-carefully ediff-debug-buffer)
2576 (if (boundp 'ediff-patch-diagnostics)
2577 (ediff-kill-buffer-carefully ediff-patch-diagnostics))
2579 ;; delete control frame or window
2580 (cond ((and (ediff-window-display-p) (frame-live-p ctl-frame))
2581 (delete-frame ctl-frame))
2582 ((window-live-p ctl-wind)
2583 (delete-window ctl-wind)))
2585 ;; Hide bottom toolbar. --marcpa
2586 (if (not (ediff-multiframe-setup-p))
2587 (ediff-kill-bottom-toolbar))
2589 (ediff-kill-buffer-carefully ctl-buf)
2591 (if (frame-live-p main-frame)
2592 (select-frame main-frame))
2594 ;; display only if not visible
2595 (condition-case nil
2596 (or (ediff-get-visible-buffer-window buff-B)
2597 (switch-to-buffer buff-B))
2598 (error))
2599 (condition-case nil
2600 (or (ediff-get-visible-buffer-window buff-A)
2601 (progn
2602 (if (and (ediff-get-visible-buffer-window buff-B)
2603 (ediff-buffer-live-p buff-A))
2604 (funcall ediff-split-window-function))
2605 (switch-to-buffer buff-A)))
2606 (error))
2607 (if three-way-job
2608 (condition-case nil
2609 (or (ediff-get-visible-buffer-window buff-C)
2610 (progn
2611 (if (and (or (ediff-get-visible-buffer-window buff-A)
2612 (ediff-get-visible-buffer-window buff-B))
2613 (ediff-buffer-live-p buff-C))
2614 (funcall ediff-split-window-function))
2615 (switch-to-buffer buff-C)))
2616 (error)))
2617 (balance-windows)
2618 (message "")
2621 (defun ediff-janitor (ask keep-variants)
2622 "Kill buffers A, B, and, possibly, C, if these buffers aren't modified.
2623 In merge jobs, buffer C is not deleted here, but rather according to
2624 ediff-quit-merge-hook.
2625 A side effect of cleaning up may be that you should be careful when comparing
2626 the same buffer in two separate Ediff sessions: quitting one of them might
2627 delete this buffer in another session as well."
2628 (ediff-dispose-of-variant-according-to-user
2629 ediff-buffer-A 'A ask keep-variants)
2630 (ediff-dispose-of-variant-according-to-user
2631 ediff-buffer-B 'B ask keep-variants)
2632 (if ediff-merge-job ; don't del buf C if merging--del ancestor buf instead
2633 (ediff-dispose-of-variant-according-to-user
2634 ediff-ancestor-buffer 'Ancestor ask keep-variants)
2635 (ediff-dispose-of-variant-according-to-user
2636 ediff-buffer-C 'C ask keep-variants)
2639 ;; Kill the variant buffer, according to user directives (ask, kill
2640 ;; unconditionaly, keep)
2641 ;; BUFF is the buffer, BUFF-TYPE is either 'A, or 'B, 'C, 'Ancestor
2642 (defun ediff-dispose-of-variant-according-to-user (buff bufftype ask keep-variants)
2643 ;; if this is indirect buffer, kill it and substitute with direct buf
2644 (if (and (ediff-buffer-live-p buff)
2645 (ediff-with-current-buffer buff ediff-temp-indirect-buffer))
2646 (let ((wind (ediff-get-visible-buffer-window buff))
2647 (base (buffer-base-buffer buff))
2648 (modified-p (buffer-modified-p buff)))
2649 (if (and (window-live-p wind) (ediff-buffer-live-p base))
2650 (set-window-buffer wind base))
2651 ;; Kill indirect buffer even if it is modified, because the base buffer
2652 ;; is still there. Note that if the base buffer is dead then so will be
2653 ;; the indirect buffer
2654 (ediff-with-current-buffer buff
2655 (set-buffer-modified-p nil))
2656 (ediff-kill-buffer-carefully buff)
2657 (ediff-with-current-buffer base
2658 (set-buffer-modified-p modified-p)))
2659 ;; otherwise, ask or use the value of keep-variants
2660 (or (not (ediff-buffer-live-p buff))
2661 keep-variants
2662 (buffer-modified-p buff)
2663 (and ask
2664 (not (y-or-n-p (format "Kill buffer %S [%s]? "
2665 bufftype (buffer-name buff)))))
2666 (ediff-kill-buffer-carefully buff))
2669 (defun ediff-maybe-save-and-delete-merge (&optional save-and-continue)
2670 "Default hook to run on quitting a merge job.
2671 This can also be used to save merge buffer in the middle of an Ediff session.
2673 If the optional SAVE-AND-CONTINUE argument is non-nil, save merge buffer and
2674 continue. Otherwise:
2675 If `ediff-autostore-merges' is nil, this does nothing.
2676 If it is t, it saves the merge buffer in the file `ediff-merge-store-file'
2677 or asks the user, if the latter is nil. It then asks the user whether to
2678 delete the merge buffer.
2679 If `ediff-autostore-merges' is neither nil nor t, the merge buffer is saved
2680 only if this merge job is part of a group, i.e., was invoked from within
2681 `ediff-merge-directories', `ediff-merge-directory-revisions', and such."
2682 (let ((merge-store-file ediff-merge-store-file)
2683 (ediff-autostore-merges ; fake ediff-autostore-merges, if necessary
2684 (if save-and-continue t ediff-autostore-merges)))
2685 (if ediff-autostore-merges
2686 (cond ((stringp merge-store-file)
2687 ;; store, ask to delete
2688 (ediff-write-merge-buffer-and-maybe-kill
2689 ediff-buffer-C merge-store-file 'show-file save-and-continue))
2690 ((eq ediff-autostore-merges t)
2691 ;; ask for file name
2692 (setq merge-store-file
2693 (read-file-name "Save the result of the merge in file: "))
2694 (ediff-write-merge-buffer-and-maybe-kill
2695 ediff-buffer-C merge-store-file nil save-and-continue))
2696 ((and (ediff-buffer-live-p ediff-meta-buffer)
2697 (ediff-with-current-buffer ediff-meta-buffer
2698 (ediff-merge-metajob)))
2699 ;; The parent metajob passed nil as the autostore file.
2700 nil)))
2703 ;; write merge buffer. If the optional argument save-and-continue is non-nil,
2704 ;; then don't kill the merge buffer
2705 (defun ediff-write-merge-buffer-and-maybe-kill (buf file
2706 &optional
2707 show-file save-and-continue)
2708 (if (not (eq (find-buffer-visiting file) buf))
2709 (let ((warn-message
2710 (format "Another buffer is visiting file %s. Too dangerous to save the merge buffer"
2711 file)))
2712 (beep)
2713 (message "%s" warn-message)
2714 (with-output-to-temp-buffer ediff-msg-buffer
2715 (princ "\n\n")
2716 (princ warn-message)
2717 (princ "\n\n")
2719 (sit-for 2))
2720 (ediff-with-current-buffer buf
2721 (if (or (not (file-exists-p file))
2722 (y-or-n-p (format "File %s exists, overwrite? " file)))
2723 (progn
2724 ;;(write-region (point-min) (point-max) file)
2725 (ediff-with-current-buffer buf
2726 (set-visited-file-name file)
2727 (save-buffer))
2728 (if show-file
2729 (progn
2730 (message "Merge buffer saved in: %s" file)
2731 (set-buffer-modified-p nil)
2732 (sit-for 3)))
2733 (if (and
2734 (not save-and-continue)
2735 (y-or-n-p "Merge buffer saved. Now kill the buffer? "))
2736 (ediff-kill-buffer-carefully buf)))))
2739 ;; The default way of suspending Ediff.
2740 ;; Buries Ediff buffers, kills all windows.
2741 (defun ediff-default-suspend-function ()
2742 (let* ((buf-A ediff-buffer-A)
2743 (buf-B ediff-buffer-B)
2744 (buf-C ediff-buffer-C)
2745 (buf-A-wind (ediff-get-visible-buffer-window buf-A))
2746 (buf-B-wind (ediff-get-visible-buffer-window buf-B))
2747 (buf-C-wind (ediff-get-visible-buffer-window buf-C))
2748 (buf-patch (if (boundp 'ediff-patchbufer) ediff-patchbufer nil))
2749 (buf-patch-diag (if (boundp 'ediff-patch-diagnostics)
2750 ediff-patch-diagnostics nil))
2751 (buf-err ediff-error-buffer)
2752 (buf-diff ediff-diff-buffer)
2753 (buf-custom-diff ediff-custom-diff-buffer)
2754 (buf-fine-diff ediff-fine-diff-buffer))
2756 ;; hide the control panel
2757 (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
2758 (iconify-frame ediff-control-frame)
2759 (bury-buffer))
2760 (if buf-err (bury-buffer buf-err))
2761 (if buf-diff (bury-buffer buf-diff))
2762 (if buf-custom-diff (bury-buffer buf-custom-diff))
2763 (if buf-fine-diff (bury-buffer buf-fine-diff))
2764 (if buf-patch (bury-buffer buf-patch))
2765 (if buf-patch-diag (bury-buffer buf-patch-diag))
2766 (if (window-live-p buf-A-wind)
2767 (progn
2768 (select-window buf-A-wind)
2769 (delete-other-windows)
2770 (bury-buffer))
2771 (if (ediff-buffer-live-p buf-A)
2772 (progn
2773 (set-buffer buf-A)
2774 (bury-buffer))))
2775 (if (window-live-p buf-B-wind)
2776 (progn
2777 (select-window buf-B-wind)
2778 (delete-other-windows)
2779 (bury-buffer))
2780 (if (ediff-buffer-live-p buf-B)
2781 (progn
2782 (set-buffer buf-B)
2783 (bury-buffer))))
2784 (if (window-live-p buf-C-wind)
2785 (progn
2786 (select-window buf-C-wind)
2787 (delete-other-windows)
2788 (bury-buffer))
2789 (if (ediff-buffer-live-p buf-C)
2790 (progn
2791 (set-buffer buf-C)
2792 (bury-buffer))))
2796 (defun ediff-suspend ()
2797 "Suspend Ediff.
2798 To resume, switch to the appropriate `Ediff Control Panel'
2799 buffer and then type \\[ediff-recenter]. Ediff will automatically set
2800 up an appropriate window config."
2801 (interactive)
2802 (ediff-barf-if-not-control-buffer)
2803 (run-hooks 'ediff-suspend-hook)
2804 (message
2805 "To resume, type M-x eregistry and select the desired Ediff session"))
2807 ;; ediff-barf-if-not-control-buffer ensures only called from ediff.
2808 (declare-function ediff-version "ediff" ())
2810 (defun ediff-status-info ()
2811 "Show the names of the buffers or files being operated on by Ediff.
2812 Hit \\[ediff-recenter] to reset the windows afterward."
2813 (interactive)
2814 (ediff-barf-if-not-control-buffer)
2815 (save-excursion
2816 (ediff-skip-unsuitable-frames))
2817 (with-output-to-temp-buffer ediff-msg-buffer
2818 (ediff-with-current-buffer standard-output
2819 (fundamental-mode))
2820 (raise-frame (selected-frame))
2821 (princ (ediff-version))
2822 (princ "\n\n")
2823 (ediff-with-current-buffer ediff-buffer-A
2824 (if buffer-file-name
2825 (princ
2826 (format "File A = %S\n" buffer-file-name))
2827 (princ
2828 (format "Buffer A = %S\n" (buffer-name)))))
2829 (ediff-with-current-buffer ediff-buffer-B
2830 (if buffer-file-name
2831 (princ
2832 (format "File B = %S\n" buffer-file-name))
2833 (princ
2834 (format "Buffer B = %S\n" (buffer-name)))))
2835 (if ediff-3way-job
2836 (ediff-with-current-buffer ediff-buffer-C
2837 (if buffer-file-name
2838 (princ
2839 (format "File C = %S\n" buffer-file-name))
2840 (princ
2841 (format "Buffer C = %S\n" (buffer-name))))))
2842 (princ (format "Customized diff output %s\n"
2843 (if (ediff-buffer-live-p ediff-custom-diff-buffer)
2844 (concat "\tin buffer "
2845 (buffer-name ediff-custom-diff-buffer))
2846 " is not available")))
2847 (princ (format "Plain diff output %s\n"
2848 (if (ediff-buffer-live-p ediff-diff-buffer)
2849 (concat "\tin buffer "
2850 (buffer-name ediff-diff-buffer))
2851 " is not available")))
2853 (let* ((A-line (ediff-with-current-buffer ediff-buffer-A
2854 (1+ (count-lines (point-min) (point)))))
2855 (B-line (ediff-with-current-buffer ediff-buffer-B
2856 (1+ (count-lines (point-min) (point)))))
2857 C-line)
2858 (princ (format "\Buffer A's point is on line %d\n" A-line))
2859 (princ (format "Buffer B's point is on line %d\n" B-line))
2860 (if ediff-3way-job
2861 (progn
2862 (setq C-line (ediff-with-current-buffer ediff-buffer-C
2863 (1+ (count-lines (point-min) (point)))))
2864 (princ (format "Buffer C's point is on line %d\n" C-line)))))
2866 (princ (format "\nCurrent difference number = %S\n"
2867 (cond ((< ediff-current-difference 0) 'start)
2868 ((>= ediff-current-difference
2869 ediff-number-of-differences) 'end)
2870 (t (1+ ediff-current-difference)))))
2872 (princ
2873 (format "\n%s regions that differ in white space & line breaks only"
2874 (if ediff-ignore-similar-regions
2875 "Ignoring" "Showing")))
2876 (if (and ediff-merge-job ediff-show-clashes-only)
2877 (princ
2878 "\nFocusing on regions where both buffers differ from the ancestor"))
2879 (if (and ediff-skip-merge-regions-that-differ-from-default ediff-merge-job)
2880 (princ
2881 "\nSkipping merge regions that differ from default setting"))
2883 (cond ((eq ediff-skip-diff-region-function 'ediff-show-all-diffs)
2884 (princ "\nSelective browsing by regexp is off\n"))
2885 ((eq ediff-skip-diff-region-function
2886 ediff-hide-regexp-matches-function)
2887 (princ
2888 "\nIgnoring regions that match")
2889 (princ
2890 (format
2891 "\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n"
2892 ediff-regexp-hide-A ediff-hide-regexp-connective
2893 ediff-regexp-hide-B)))
2894 ((eq ediff-skip-diff-region-function
2895 ediff-focus-on-regexp-matches-function)
2896 (princ
2897 "\nFocusing on regions that match")
2898 (princ
2899 (format
2900 "\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n"
2901 ediff-regexp-focus-A ediff-focus-regexp-connective
2902 ediff-regexp-focus-B)))
2903 (t (princ "\nSelective browsing via a user-defined method.\n")))
2905 (princ
2906 (format "\nBugs/suggestions: type `%s' while in Ediff Control Panel."
2907 (substitute-command-keys "\\[ediff-submit-report]")))
2908 ) ; with output
2909 (if (frame-live-p ediff-control-frame)
2910 (ediff-reset-mouse ediff-control-frame))
2911 (if (window-live-p ediff-control-window)
2912 (select-window ediff-control-window)))
2917 ;;; Support routines
2919 ;; Select a difference by placing the ASCII flags around the appropriate
2920 ;; group of lines in the A, B buffers
2921 ;; This may have to be modified for buffer C, when it will be supported.
2922 (defun ediff-select-difference (n)
2923 (if (and (ediff-buffer-live-p ediff-buffer-A)
2924 (ediff-buffer-live-p ediff-buffer-B)
2925 (ediff-valid-difference-p n))
2926 (progn
2927 (cond
2928 ((and (ediff-has-face-support-p) ediff-use-faces)
2929 (ediff-highlight-diff n))
2930 ((eq ediff-highlighting-style 'ascii)
2931 (ediff-place-flags-in-buffer
2932 'A ediff-buffer-A ediff-control-buffer n)
2933 (ediff-place-flags-in-buffer
2934 'B ediff-buffer-B ediff-control-buffer n)
2935 (if ediff-3way-job
2936 (ediff-place-flags-in-buffer
2937 'C ediff-buffer-C ediff-control-buffer n))
2938 (if (ediff-buffer-live-p ediff-ancestor-buffer)
2939 (ediff-place-flags-in-buffer
2940 'Ancestor ediff-ancestor-buffer
2941 ediff-control-buffer n))
2944 (ediff-install-fine-diff-if-necessary n)
2945 ;; set current difference here so the hook will be able to refer to it
2946 (setq ediff-current-difference n)
2947 (run-hooks 'ediff-select-hook))))
2950 ;; Unselect a difference by removing the ASCII flags in the buffers.
2951 ;; This may have to be modified for buffer C, when it will be supported.
2952 (defun ediff-unselect-difference (n)
2953 (if (ediff-valid-difference-p n)
2954 (progn
2955 (cond ((and (ediff-has-face-support-p) ediff-use-faces)
2956 (ediff-unhighlight-diff))
2957 ((eq ediff-highlighting-style 'ascii)
2958 (ediff-remove-flags-from-buffer
2959 ediff-buffer-A
2960 (ediff-get-diff-overlay n 'A))
2961 (ediff-remove-flags-from-buffer
2962 ediff-buffer-B
2963 (ediff-get-diff-overlay n 'B))
2964 (if ediff-3way-job
2965 (ediff-remove-flags-from-buffer
2966 ediff-buffer-C
2967 (ediff-get-diff-overlay n 'C)))
2968 (if (ediff-buffer-live-p ediff-ancestor-buffer)
2969 (ediff-remove-flags-from-buffer
2970 ediff-ancestor-buffer
2971 (ediff-get-diff-overlay n 'Ancestor)))
2974 ;; unhighlight fine diffs
2975 (ediff-set-fine-diff-properties ediff-current-difference 'default)
2976 (run-hooks 'ediff-unselect-hook))))
2979 ;; Unselects prev diff and selects a new one, if FLAG has value other than
2980 ;; 'select-only or 'unselect-only. If FLAG is 'select-only, the
2981 ;; next difference is selected, but the current selection is not
2982 ;; unselected. If FLAG is 'unselect-only then the current selection is
2983 ;; unselected, but the next one is not selected. If NO-RECENTER is non-nil,
2984 ;; don't recenter buffers after selecting/unselecting.
2985 (defun ediff-unselect-and-select-difference (n &optional flag no-recenter)
2986 (let ((ediff-current-difference n))
2987 (or no-recenter
2988 (ediff-recenter 'no-rehighlight)))
2990 (let ((control-buf ediff-control-buffer))
2991 (unwind-protect
2992 (progn
2993 (or (eq flag 'select-only)
2994 (ediff-unselect-difference ediff-current-difference))
2996 (or (eq flag 'unselect-only)
2997 (ediff-select-difference n))
2998 ;; need to set current diff here even though it is also set in
2999 ;; ediff-select-difference because ediff-select-difference might not
3000 ;; be called if unselect-only is specified
3001 (setq ediff-current-difference n)
3002 ) ; end protected section
3004 (ediff-with-current-buffer control-buf (ediff-refresh-mode-lines)))
3009 (defun ediff-highlight-diff-in-one-buffer (n buf-type)
3010 (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
3011 (let* ((buff (ediff-get-buffer buf-type))
3012 (last (ediff-with-current-buffer buff (point-max)))
3013 (begin (ediff-get-diff-posn buf-type 'beg n))
3014 (end (ediff-get-diff-posn buf-type 'end n))
3015 (xtra (if (equal begin end) 1 0))
3016 (end-hilit (min last (+ end xtra)))
3017 (current-diff-overlay
3018 (symbol-value
3019 (ediff-get-symbol-from-alist
3020 buf-type ediff-current-diff-overlay-alist))))
3022 (if (featurep 'xemacs)
3023 (ediff-move-overlay current-diff-overlay begin end-hilit)
3024 (ediff-move-overlay current-diff-overlay begin end-hilit buff))
3025 (ediff-overlay-put current-diff-overlay 'priority
3026 (ediff-highest-priority begin end-hilit buff))
3027 (ediff-overlay-put current-diff-overlay 'ediff-diff-num n)
3029 ;; unhighlight the background overlay for diff n so it won't
3030 ;; interfere with the current diff overlay
3031 (ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil)
3035 (defun ediff-unhighlight-diff-in-one-buffer (buf-type)
3036 (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
3037 (let ((current-diff-overlay
3038 (symbol-value
3039 (ediff-get-symbol-from-alist
3040 buf-type ediff-current-diff-overlay-alist)))
3041 (overlay
3042 (ediff-get-diff-overlay ediff-current-difference buf-type))
3045 (ediff-move-overlay current-diff-overlay 1 1)
3047 ;; rehighlight the overlay in the background of the
3048 ;; current difference region
3049 (ediff-set-overlay-face
3050 overlay
3051 (if (and (ediff-has-face-support-p)
3052 ediff-use-faces ediff-highlight-all-diffs)
3053 (ediff-background-face buf-type ediff-current-difference)))
3056 (defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type)
3057 (ediff-unselect-and-select-difference -1)
3058 (if (and (ediff-has-face-support-p) ediff-use-faces)
3059 (let* ((inhibit-quit t)
3060 (current-diff-overlay-var
3061 (ediff-get-symbol-from-alist
3062 buf-type ediff-current-diff-overlay-alist))
3063 (current-diff-overlay (symbol-value current-diff-overlay-var)))
3064 (ediff-paint-background-regions 'unhighlight)
3065 (if (ediff-overlayp current-diff-overlay)
3066 (ediff-delete-overlay current-diff-overlay))
3067 (set current-diff-overlay-var nil)
3071 (defun ediff-highlight-diff (n)
3072 "Put face on diff N. Invoked for X displays only."
3073 (ediff-highlight-diff-in-one-buffer n 'A)
3074 (ediff-highlight-diff-in-one-buffer n 'B)
3075 (ediff-highlight-diff-in-one-buffer n 'C)
3076 (ediff-highlight-diff-in-one-buffer n 'Ancestor)
3080 (defun ediff-unhighlight-diff ()
3081 "Remove overlays from buffers A, B, and C."
3082 (ediff-unhighlight-diff-in-one-buffer 'A)
3083 (ediff-unhighlight-diff-in-one-buffer 'B)
3084 (ediff-unhighlight-diff-in-one-buffer 'C)
3085 (ediff-unhighlight-diff-in-one-buffer 'Ancestor)
3088 ;; delete highlighting overlays, restore faces to their original form
3089 (defun ediff-unhighlight-diffs-totally ()
3090 (ediff-unhighlight-diffs-totally-in-one-buffer 'A)
3091 (ediff-unhighlight-diffs-totally-in-one-buffer 'B)
3092 (ediff-unhighlight-diffs-totally-in-one-buffer 'C)
3093 (ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor)
3097 ;; This is adapted from a similar function in `emerge.el'.
3098 ;; PROMPT should not have a trailing ': ', so that it can be modified
3099 ;; according to context.
3100 ;; If DEFAULT-FILE is set, it should be used as the default value.
3101 ;; If DEFAULT-DIR is non-nil, use it as the default directory.
3102 ;; Otherwise, use the value of Emacs' variable `default-directory.'
3103 (defun ediff-read-file-name (prompt default-dir default-file &optional no-dirs)
3104 ;; hack default-dir if it is not set
3105 (setq default-dir
3106 (file-name-as-directory
3107 (ediff-abbreviate-file-name
3108 (expand-file-name (or default-dir
3109 (and default-file
3110 (file-name-directory default-file))
3111 default-directory)))))
3113 ;; strip the directory from default-file
3114 (if default-file
3115 (setq default-file (file-name-nondirectory default-file)))
3116 (if (string= default-file "")
3117 (setq default-file nil))
3119 (let (f)
3120 (setq f (expand-file-name
3121 (read-file-name
3122 (format "%s%s "
3123 prompt
3124 (cond (default-file
3125 (concat " (default " default-file "):"))
3126 (t (concat " (default " default-dir "):"))))
3127 default-dir
3128 (or default-file default-dir)
3129 t ; must match, no-confirm
3130 (if default-file (file-name-directory default-file))
3132 default-dir
3134 ;; If user entered a directory name, expand the default file in that
3135 ;; directory. This allows the user to enter a directory name for the
3136 ;; B-file and diff against the default-file in that directory instead
3137 ;; of a DIRED listing!
3138 (if (and (file-directory-p f) default-file)
3139 (setq f (expand-file-name
3140 (file-name-nondirectory default-file) f)))
3141 (if (and no-dirs (file-directory-p f))
3142 (error "File %s is a directory" f))
3145 ;; If PREFIX is given, then it is used as a prefix for the temp file
3146 ;; name. Otherwise, `ediff' is used. If FILE is given, use this
3147 ;; file and don't create a new one.
3148 ;; In MS-DOS, make sure the prefix isn't too long, or else
3149 ;; `make-temp-name' isn't guaranteed to return a unique filename.
3150 ;; Also, save buffer from START to END in the file.
3151 ;; START defaults to (point-min), END to (point-max)
3152 (defun ediff-make-temp-file (buff &optional prefix given-file start end)
3153 (let* ((p (ediff-convert-standard-filename (or prefix "ediff")))
3154 (short-p p)
3155 (coding-system-for-write
3156 (ediff-with-current-buffer buff
3157 (if (boundp 'buffer-file-coding-system)
3158 buffer-file-coding-system
3159 ediff-coding-system-for-write)))
3160 f short-f)
3161 (if (and (fboundp 'msdos-long-file-names)
3162 (not (msdos-long-file-names))
3163 (> (length p) 2))
3164 (setq short-p (substring p 0 2)))
3166 (setq f (concat ediff-temp-file-prefix p)
3167 short-f (concat ediff-temp-file-prefix short-p)
3168 f (cond (given-file)
3169 ((find-file-name-handler f 'insert-file-contents)
3170 ;; to thwart file handlers in write-region, e.g., if file
3171 ;; name ends with .Z or .gz
3172 ;; This is needed so that patches produced by ediff will
3173 ;; have more meaningful names
3174 (ediff-make-empty-tmp-file short-f))
3175 (prefix
3176 ;; Prefix is most often the same as the file name for the
3177 ;; variant. Here we are trying to use the original file
3178 ;; name but in the temp directory.
3179 (ediff-make-empty-tmp-file f 'keep-name))
3181 ;; If don't care about name, add some random stuff
3182 ;; to proposed file name.
3183 (ediff-make-empty-tmp-file short-f))))
3185 ;; create the file
3186 (ediff-with-current-buffer buff
3187 (write-region (if start start (point-min))
3188 (if end end (point-max))
3190 nil ; don't append---erase
3191 'no-message)
3192 (set-file-modes f ediff-temp-file-mode)
3193 (expand-file-name f))))
3195 ;; Create a temporary file.
3196 ;; The returned file name (created by appending some random characters at the
3197 ;; end of PROPOSED-NAME is guaranteed to point to a newly created empty file.
3198 ;; This is a replacement for make-temp-name, which eliminates a security hole.
3199 ;; If KEEP-PROPOSED-NAME isn't nil, try to keep PROPOSED-NAME, unless such file
3200 ;; already exists.
3201 ;; It is a modified version of make-temp-file in emacs 20.5
3202 (defun ediff-make-empty-tmp-file (proposed-name &optional keep-proposed-name)
3203 (let ((file proposed-name))
3204 (while (condition-case ()
3205 (progn
3206 (if (or (file-exists-p file) (not keep-proposed-name))
3207 (setq file (make-temp-name proposed-name)))
3208 ;; the with-temp-buffer thing is a workaround for an XEmacs
3209 ;; bug: write-region complains that we are trying to visit a
3210 ;; file in an indirect buffer, failing to notice that the
3211 ;; VISIT flag is unset and that we are actually writing from a
3212 ;; string and not from any buffer.
3213 (with-temp-buffer
3214 (write-region "" nil file nil 'silent nil 'excl))
3215 nil)
3216 (file-already-exists t))
3217 ;; the file was somehow created by someone else between
3218 ;; `make-temp-name' and `write-region', let's try again.
3219 nil)
3220 file))
3223 ;; Quote metacharacters (using \) when executing diff in Unix, but not in
3224 ;; EMX OS/2
3225 ;;(defun ediff-protect-metachars (str)
3226 ;; (or (memq system-type '(emx vax-vms axp-vms))
3227 ;; (let ((limit 0))
3228 ;; (while (string-match ediff-metachars str limit)
3229 ;; (setq str (concat (substring str 0 (match-beginning 0))
3230 ;; "\\"
3231 ;; (substring str (match-beginning 0))))
3232 ;; (setq limit (1+ (match-end 0))))))
3233 ;; str)
3235 ;; Make sure the current buffer (for a file) has the same contents as the
3236 ;; file on disk, and attempt to remedy the situation if not.
3237 ;; Signal an error if we can't make them the same, or the user doesn't want
3238 ;; to do what is necessary to make them the same.
3239 ;; Also, Ediff always offers to revert obsolete buffers, whether they
3240 ;; are modified or not.
3241 (defun ediff-verify-file-buffer (&optional file-magic)
3242 ;; First check if the file has been modified since the buffer visited it.
3243 (if (verify-visited-file-modtime (current-buffer))
3244 (if (buffer-modified-p)
3245 ;; If buffer is not obsolete and is modified, offer to save
3246 (if (yes-or-no-p
3247 (format "Buffer %s has been modified. Save it in file %s? "
3248 (buffer-name)
3249 buffer-file-name))
3250 (condition-case nil
3251 (save-buffer)
3252 (error
3253 (beep)
3254 (message "Couldn't save %s" buffer-file-name)))
3255 (error "Buffer is out of sync for file %s" buffer-file-name))
3256 ;; If buffer is not obsolete and is not modified, do nothing
3257 nil)
3258 ;; If buffer is obsolete, offer to revert
3259 (if (yes-or-no-p
3260 (format "File %s was modified since visited by buffer %s. REVERT file %s? "
3261 buffer-file-name
3262 (buffer-name)
3263 buffer-file-name))
3264 (progn
3265 (if file-magic
3266 (erase-buffer))
3267 (revert-buffer t t))
3268 (error "Buffer out of sync for file %s" buffer-file-name))))
3270 ;; if there is another buffer visiting the file of the merge buffer, offer to
3271 ;; save and delete the buffer; else bark
3272 (defun ediff-verify-file-merge-buffer (file)
3273 (let ((buff (if (stringp file) (find-buffer-visiting file)))
3274 warn-message)
3275 (or (null buff)
3276 (progn
3277 (setq warn-message
3278 (format "Buffer %s is visiting %s. Save and kill the buffer? "
3279 (buffer-name buff) file))
3280 (with-output-to-temp-buffer ediff-msg-buffer
3281 (princ "\n\n")
3282 (princ warn-message)
3283 (princ "\n\n"))
3284 (if (y-or-n-p
3285 (message "%s" warn-message))
3286 (with-current-buffer buff
3287 (save-buffer)
3288 (kill-buffer (current-buffer)))
3289 (error "Too dangerous to merge versions of a file visited by another buffer"))))
3294 (defun ediff-filename-magic-p (file)
3295 (or (ediff-file-compressed-p file)
3296 (ediff-file-remote-p file)))
3299 (defun ediff-save-buffer (arg)
3300 "Safe way of saving buffers A, B, C, and the diff output.
3301 `wa' saves buffer A, `wb' saves buffer B, `wc' saves buffer C,
3302 and `wd' saves the diff output.
3304 With prefix argument, `wd' saves plain diff output.
3305 Without an argument, it saves customized diff argument, if available
3306 \(and plain output, if customized output was not generated\)."
3307 (interactive "P")
3308 (ediff-barf-if-not-control-buffer)
3309 (ediff-compute-custom-diffs-maybe)
3310 (ediff-with-current-buffer
3311 (cond ((memq last-command-char '(?a ?b ?c))
3312 (ediff-get-buffer
3313 (ediff-char-to-buftype last-command-char)))
3314 ((eq last-command-char ?d)
3315 (message "Saving diff output ...")
3316 (sit-for 1) ; let the user see the message
3317 (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer))
3318 ediff-diff-buffer)
3319 ((ediff-buffer-live-p ediff-custom-diff-buffer)
3320 ediff-custom-diff-buffer)
3321 ((ediff-buffer-live-p ediff-diff-buffer)
3322 ediff-diff-buffer)
3323 (t (error "Output from `diff' not found"))))
3325 (save-buffer)))
3328 ;; idea suggested by Hannu Koivisto <azure@iki.fi>
3329 (defun ediff-clone-buffer-for-region-comparison (buff region-name)
3330 (let ((cloned-buff (ediff-make-cloned-buffer buff region-name))
3331 (pop-up-windows t)
3332 wind
3333 other-wind
3334 msg-buf)
3335 (ediff-with-current-buffer cloned-buff
3336 (setq ediff-temp-indirect-buffer t))
3337 (pop-to-buffer cloned-buff)
3338 (setq wind (ediff-get-visible-buffer-window cloned-buff))
3339 (select-window wind)
3340 (delete-other-windows)
3341 (ediff-activate-mark)
3342 (split-window-vertically)
3343 (ediff-select-lowest-window)
3344 (setq other-wind (selected-window))
3345 (with-temp-buffer
3346 (erase-buffer)
3347 (insert
3348 (format "\n ******* Mark a region in buffer %s (or confirm the existing one) *******\n"
3349 (buffer-name cloned-buff)))
3350 (insert
3351 (ediff-with-current-buffer buff
3352 (format "\n\t When done, type %s Use %s to abort\n "
3353 (ediff-format-bindings-of 'exit-recursive-edit)
3354 (ediff-format-bindings-of 'abort-recursive-edit))))
3355 (goto-char (point-min))
3356 (setq msg-buf (current-buffer))
3357 (set-window-buffer other-wind msg-buf)
3358 (shrink-window-if-larger-than-buffer)
3359 (if (window-live-p wind)
3360 (select-window wind))
3361 (condition-case nil
3362 (recursive-edit)
3363 (quit
3364 (ediff-kill-buffer-carefully cloned-buff)))
3366 cloned-buff))
3369 (defun ediff-clone-buffer-for-window-comparison (buff wind region-name)
3370 (let ((cloned-buff (ediff-make-cloned-buffer buff region-name)))
3371 (ediff-with-current-buffer cloned-buff
3372 (setq ediff-temp-indirect-buffer t))
3373 (set-window-buffer wind cloned-buff)
3374 cloned-buff))
3376 (defun ediff-clone-buffer-for-current-diff-comparison (buff buf-type reg-name)
3377 (let ((cloned-buff (ediff-make-cloned-buffer buff reg-name))
3378 (reg-start (ediff-get-diff-posn buf-type 'beg))
3379 (reg-end (ediff-get-diff-posn buf-type 'end)))
3380 (ediff-with-current-buffer cloned-buff
3381 ;; set region to be the current diff region
3382 (goto-char reg-start)
3383 (set-mark reg-end)
3384 (setq ediff-temp-indirect-buffer t))
3385 cloned-buff))
3389 (defun ediff-make-cloned-buffer (buff region-name)
3390 (ediff-make-indirect-buffer
3391 buff (generate-new-buffer-name
3392 (concat (if (stringp buff) buff (buffer-name buff)) region-name))))
3395 (defun ediff-make-indirect-buffer (base-buf indirect-buf-name)
3396 (if (featurep 'xemacs)
3397 (make-indirect-buffer base-buf indirect-buf-name)
3398 (make-indirect-buffer base-buf indirect-buf-name 'clone)))
3401 ;; This function operates only from an ediff control buffer
3402 (defun ediff-compute-custom-diffs-maybe ()
3403 (let ((buf-A-file-name (buffer-file-name ediff-buffer-A))
3404 (buf-B-file-name (buffer-file-name ediff-buffer-B))
3405 file-A file-B)
3406 (unless (and buf-A-file-name
3407 (file-exists-p buf-A-file-name)
3408 (not (ediff-file-remote-p buf-A-file-name)))
3409 (setq file-A
3410 (ediff-make-temp-file ediff-buffer-A)))
3411 (unless (and buf-B-file-name
3412 (file-exists-p buf-B-file-name)
3413 (not (ediff-file-remote-p buf-B-file-name)))
3414 (setq file-B
3415 (ediff-make-temp-file ediff-buffer-B)))
3416 (or (ediff-buffer-live-p ediff-custom-diff-buffer)
3417 (setq ediff-custom-diff-buffer
3418 (get-buffer-create
3419 (ediff-unique-buffer-name "*ediff-custom-diff" "*"))))
3420 (ediff-with-current-buffer ediff-custom-diff-buffer
3421 (setq buffer-read-only nil)
3422 (erase-buffer))
3423 (ediff-exec-process
3424 ediff-custom-diff-program ediff-custom-diff-buffer 'synchronize
3425 ediff-custom-diff-options
3426 ;; repetition of buf-A-file-name is needed so it'll return a file
3427 (or file-A buf-A-file-name)
3428 (or file-B buf-B-file-name))
3429 ;; put the diff file in diff-mode, if it is available
3430 (if (fboundp 'diff-mode)
3431 (with-current-buffer ediff-custom-diff-buffer
3432 (diff-mode)))
3433 (and file-A (delete-file file-A))
3434 (and file-B (delete-file file-B))
3437 (defun ediff-show-diff-output (arg)
3438 (interactive "P")
3439 (ediff-barf-if-not-control-buffer)
3440 (ediff-compute-custom-diffs-maybe)
3441 (save-excursion
3442 (ediff-skip-unsuitable-frames ' ok-unsplittable))
3443 (let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer))
3444 ediff-diff-buffer)
3445 ((ediff-buffer-live-p ediff-custom-diff-buffer)
3446 ediff-custom-diff-buffer)
3447 ((ediff-buffer-live-p ediff-diff-buffer)
3448 ediff-diff-buffer)
3450 (beep)
3451 (message "Output from `diff' not found")
3452 nil))))
3453 (if buf
3454 (progn
3455 (ediff-with-current-buffer buf
3456 (goto-char (point-min)))
3457 (switch-to-buffer buf)
3458 (raise-frame (selected-frame)))))
3459 (if (frame-live-p ediff-control-frame)
3460 (ediff-reset-mouse ediff-control-frame))
3461 (if (window-live-p ediff-control-window)
3462 (select-window ediff-control-window)))
3465 (defun ediff-inferior-compare-regions ()
3466 "Compare regions in an active Ediff session.
3467 Like ediff-regions-linewise but is called from under an active Ediff session on
3468 the files that belong to that session.
3470 After quitting the session invoked via this function, type C-l to the parent
3471 Ediff Control Panel to restore highlighting."
3472 (interactive)
3473 (let ((answer "")
3474 (possibilities (list ?A ?B ?C))
3475 (zmacs-regions t)
3476 use-current-diff-p
3477 begA begB endA endB bufA bufB)
3479 (if (ediff-valid-difference-p ediff-current-difference)
3480 (progn
3481 (ediff-set-fine-diff-properties ediff-current-difference 'default)
3482 (ediff-unhighlight-diff)))
3483 (ediff-paint-background-regions 'unhighlight)
3485 (cond ((ediff-merge-job)
3486 (setq bufB ediff-buffer-C)
3487 ;; ask which buffer to compare to the merge buffer
3488 (while (cond ((eq answer ?A)
3489 (setq bufA ediff-buffer-A
3490 possibilities '(?B))
3491 nil)
3492 ((eq answer ?B)
3493 (setq bufA ediff-buffer-B
3494 possibilities '(?A))
3495 nil)
3496 ((equal answer ""))
3497 (t (beep 1)
3498 (message "Valid values are A or B")
3499 (sit-for 2)
3501 (let ((cursor-in-echo-area t))
3502 (message
3503 "Which buffer to compare to the merge buffer (A or B)? ")
3504 (setq answer (capitalize (read-char-exclusive))))))
3506 ((ediff-3way-comparison-job)
3507 ;; ask which two buffers to compare
3508 (while (cond ((memq answer possibilities)
3509 (setq possibilities (delq answer possibilities))
3510 (setq bufA
3511 (eval
3512 (ediff-get-symbol-from-alist
3513 answer ediff-buffer-alist)))
3514 nil)
3515 ((equal answer ""))
3516 (t (beep 1)
3517 (message
3518 "Valid values are %s"
3519 (mapconcat 'char-to-string possibilities " or "))
3520 (sit-for 2)
3522 (let ((cursor-in-echo-area t))
3523 (message "Enter the 1st buffer you want to compare (%s): "
3524 (mapconcat 'char-to-string possibilities " or "))
3525 (setq answer (capitalize (read-char-exclusive)))))
3526 (setq answer "") ; silence error msg
3527 (while (cond ((memq answer possibilities)
3528 (setq possibilities (delq answer possibilities))
3529 (setq bufB
3530 (eval
3531 (ediff-get-symbol-from-alist
3532 answer ediff-buffer-alist)))
3533 nil)
3534 ((equal answer ""))
3535 (t (beep 1)
3536 (message
3537 "Valid values are %s"
3538 (mapconcat 'char-to-string possibilities " or "))
3539 (sit-for 2)
3541 (let ((cursor-in-echo-area t))
3542 (message "Enter the 2nd buffer you want to compare (%s): "
3543 (mapconcat 'char-to-string possibilities "/"))
3544 (setq answer (capitalize (read-char-exclusive))))))
3545 (t ; 2way comparison
3546 (setq bufA ediff-buffer-A
3547 bufB ediff-buffer-B
3548 possibilities nil)))
3550 (if (and (ediff-valid-difference-p ediff-current-difference)
3551 (y-or-n-p "Compare currently highlighted difference regions? "))
3552 (setq use-current-diff-p t))
3554 (setq bufA (if use-current-diff-p
3555 (ediff-clone-buffer-for-current-diff-comparison
3556 bufA 'A "-Region.A-")
3557 (ediff-clone-buffer-for-region-comparison bufA "-Region.A-")))
3558 (ediff-with-current-buffer bufA
3559 (setq begA (region-beginning)
3560 endA (region-end))
3561 (goto-char begA)
3562 (beginning-of-line)
3563 (setq begA (point))
3564 (goto-char endA)
3565 (end-of-line)
3566 (or (eobp) (forward-char)) ; include the newline char
3567 (setq endA (point)))
3569 (setq bufB (if use-current-diff-p
3570 (ediff-clone-buffer-for-current-diff-comparison
3571 bufB 'B "-Region.B-")
3572 (ediff-clone-buffer-for-region-comparison bufB "-Region.B-")))
3573 (ediff-with-current-buffer bufB
3574 (setq begB (region-beginning)
3575 endB (region-end))
3576 (goto-char begB)
3577 (beginning-of-line)
3578 (setq begB (point))
3579 (goto-char endB)
3580 (end-of-line)
3581 (or (eobp) (forward-char)) ; include the newline char
3582 (setq endB (point)))
3585 (ediff-regions-internal
3586 bufA begA endA bufB begB endB
3587 nil ; setup-hook
3588 (if use-current-diff-p ; job name
3589 'ediff-regions-wordwise
3590 'ediff-regions-linewise)
3591 (if use-current-diff-p ; word mode, if diffing current diff
3592 t nil)
3593 ;; setup param to pass to ediff-setup
3594 (list (cons 'ediff-split-window-function ediff-split-window-function)))
3599 (defun ediff-remove-flags-from-buffer (buffer overlay)
3600 (ediff-with-current-buffer buffer
3601 (let ((inhibit-read-only t))
3602 (if (featurep 'xemacs)
3603 (ediff-overlay-put overlay 'begin-glyph nil)
3604 (ediff-overlay-put overlay 'before-string nil))
3606 (if (featurep 'xemacs)
3607 (ediff-overlay-put overlay 'end-glyph nil)
3608 (ediff-overlay-put overlay 'after-string nil))
3613 (defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer diff)
3614 (ediff-with-current-buffer buffer
3615 (ediff-place-flags-in-buffer1 buf-type ctl-buffer diff)))
3618 (defun ediff-place-flags-in-buffer1 (buf-type ctl-buffer diff-no)
3619 (let* ((curr-overl (ediff-with-current-buffer ctl-buffer
3620 (ediff-get-diff-overlay diff-no buf-type)))
3621 (before (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer))
3622 after beg-of-line flag)
3624 ;; insert flag before the difference
3625 (goto-char before)
3626 (setq beg-of-line (bolp))
3628 (setq flag (ediff-with-current-buffer ctl-buffer
3629 (if (eq ediff-highlighting-style 'ascii)
3630 (if beg-of-line
3631 ediff-before-flag-bol ediff-before-flag-mol))))
3633 ;; insert the flag itself
3634 (if (featurep 'xemacs)
3635 (ediff-overlay-put curr-overl 'begin-glyph flag)
3636 (ediff-overlay-put curr-overl 'before-string flag))
3638 ;; insert the flag after the difference
3639 ;; `after' must be set here, after the before-flag was inserted
3640 (setq after (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer))
3641 (goto-char after)
3642 (setq beg-of-line (bolp))
3644 (setq flag (ediff-with-current-buffer ctl-buffer
3645 (if (eq ediff-highlighting-style 'ascii)
3646 (if beg-of-line
3647 ediff-after-flag-eol ediff-after-flag-mol))))
3649 ;; insert the flag itself
3650 (if (featurep 'xemacs)
3651 (ediff-overlay-put curr-overl 'end-glyph flag)
3652 (ediff-overlay-put curr-overl 'after-string flag))
3656 ;;; Some diff region tests
3658 ;; t if diff region is empty.
3659 ;; In case of buffer C, t also if it is not a 3way
3660 ;; comparison job (merging jobs return t as well).
3661 (defun ediff-empty-diff-region-p (n buf-type)
3662 (if (eq buf-type 'C)
3663 (or (not ediff-3way-comparison-job)
3664 (= (ediff-get-diff-posn 'C 'beg n)
3665 (ediff-get-diff-posn 'C 'end n)))
3666 (= (ediff-get-diff-posn buf-type 'beg n)
3667 (ediff-get-diff-posn buf-type 'end n))))
3669 ;; Test if diff region is white space only.
3670 ;; If 2-way job and buf-type = C, then returns t.
3671 (defun ediff-whitespace-diff-region-p (n buf-type)
3672 (or (and (eq buf-type 'C) (not ediff-3way-job))
3673 (ediff-empty-diff-region-p n buf-type)
3674 (let ((beg (ediff-get-diff-posn buf-type 'beg n))
3675 (end (ediff-get-diff-posn buf-type 'end n)))
3676 (ediff-with-current-buffer (ediff-get-buffer buf-type)
3677 (save-excursion
3678 (goto-char beg)
3679 (skip-chars-forward ediff-whitespace)
3680 (>= (point) end))))))
3683 (defun ediff-get-region-contents (n buf-type ctrl-buf &optional start end)
3684 (ediff-with-current-buffer
3685 (ediff-with-current-buffer ctrl-buf (ediff-get-buffer buf-type))
3686 (buffer-substring
3687 (or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf))
3688 (or end (ediff-get-diff-posn buf-type 'end n ctrl-buf)))))
3690 ;; Returns positions of difference sectors in the BUF-TYPE buffer.
3691 ;; BUF-TYPE should be a symbol -- `A', `B', or `C'.
3692 ;; POS is either `beg' or `end'--it specifies whether you want the position at
3693 ;; the beginning of a difference or at the end.
3695 ;; The optional argument N says which difference (default:
3696 ;; `ediff-current-difference'). N is the internal difference number (1- what
3697 ;; the user sees). The optional argument CONTROL-BUF says
3698 ;; which control buffer is in effect in case it is not the current
3699 ;; buffer.
3700 (defun ediff-get-diff-posn (buf-type pos &optional n control-buf)
3701 (let (diff-overlay)
3702 (or control-buf
3703 (setq control-buf (current-buffer)))
3705 (ediff-with-current-buffer control-buf
3706 (or n (setq n ediff-current-difference))
3707 (if (or (< n 0) (>= n ediff-number-of-differences))
3708 (if (> ediff-number-of-differences 0)
3709 (error ediff-BAD-DIFF-NUMBER
3710 this-command (1+ n) ediff-number-of-differences)
3711 (error ediff-NO-DIFFERENCES)))
3712 (setq diff-overlay (ediff-get-diff-overlay n buf-type)))
3713 (if (not (ediff-buffer-live-p (ediff-overlay-buffer diff-overlay)))
3714 (error ediff-KILLED-VITAL-BUFFER))
3715 (if (eq pos 'beg)
3716 (ediff-overlay-start diff-overlay)
3717 (ediff-overlay-end diff-overlay))
3721 ;; Restore highlighting to what it should be according to ediff-use-faces,
3722 ;; ediff-highlighting-style, and ediff-highlight-all-diffs variables.
3723 (defun ediff-restore-highlighting (&optional ctl-buf)
3724 (ediff-with-current-buffer (or ctl-buf (current-buffer))
3725 (if (and (ediff-has-face-support-p)
3726 ediff-use-faces
3727 ediff-highlight-all-diffs)
3728 (ediff-paint-background-regions))
3729 (ediff-select-difference ediff-current-difference)))
3733 ;; null out difference overlays so they won't slow down future
3734 ;; editing operations
3735 ;; VEC is either a difference vector or a fine-diff vector
3736 (defun ediff-clear-diff-vector (vec-var &optional fine-diffs-also)
3737 (if (vectorp (symbol-value vec-var))
3738 (mapc (lambda (elt)
3739 (ediff-delete-overlay
3740 (ediff-get-diff-overlay-from-diff-record elt))
3741 (if fine-diffs-also
3742 (ediff-clear-fine-diff-vector elt))
3744 (symbol-value vec-var)))
3745 ;; allow them to be garbage collected
3746 (set vec-var nil))
3750 ;;; Misc
3752 ;; In Emacs, this just makes overlay. In the future, when Emacs will start
3753 ;; supporting sticky overlays, this function will make a sticky overlay.
3754 ;; BEG and END are expressions telling where overlay starts.
3755 ;; If they are numbers or buffers, then all is well. Otherwise, they must
3756 ;; be expressions to be evaluated in buffer BUF in order to get the overlay
3757 ;; bounds.
3758 ;; If BUFF is not a live buffer, then return nil; otherwise, return the
3759 ;; newly created overlay.
3760 (defun ediff-make-bullet-proof-overlay (beg end buff)
3761 (if (ediff-buffer-live-p buff)
3762 (let (overl)
3763 (ediff-with-current-buffer buff
3764 (or (number-or-marker-p beg)
3765 (setq beg (eval beg)))
3766 (or (number-or-marker-p end)
3767 (setq end (eval end)))
3768 (setq overl
3769 (if (featurep 'xemacs)
3770 (make-extent beg end buff)
3771 ;; advance front and rear of the overlay
3772 (make-overlay beg end buff nil 'rear-advance)))
3774 ;; never detach
3775 (ediff-overlay-put
3776 overl (if (featurep 'emacs) 'evaporate 'detachable) nil)
3777 ;; make overlay open-ended
3778 ;; In emacs, it is made open ended at creation time
3779 (when (featurep 'xemacs)
3780 (ediff-overlay-put overl 'start-open nil)
3781 (ediff-overlay-put overl 'end-open nil))
3782 (ediff-overlay-put overl 'ediff-diff-num 0)
3783 overl))))
3786 (defun ediff-make-current-diff-overlay (type)
3787 (if (ediff-has-face-support-p)
3788 (let ((overlay (ediff-get-symbol-from-alist
3789 type ediff-current-diff-overlay-alist))
3790 (buffer (ediff-get-buffer type))
3791 (face (ediff-get-symbol-from-alist
3792 type ediff-current-diff-face-alist)))
3793 (set overlay
3794 (ediff-make-bullet-proof-overlay (point-max) (point-max) buffer))
3795 (ediff-set-overlay-face (symbol-value overlay) face)
3796 (ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer))
3800 ;; Like other-buffer, but prefers visible buffers and ignores temporary or
3801 ;; other insignificant buffers (those beginning with "^[ *]").
3802 ;; Gets one arg--buffer name or a list of buffer names (it won't return
3803 ;; these buffers).
3804 ;; EXCL-BUFF-LIST is an exclusion list.
3805 (defun ediff-other-buffer (excl-buff-lst)
3806 (or (listp excl-buff-lst) (setq excl-buff-lst (list excl-buff-lst)))
3807 (let* ((all-buffers (nconc (ediff-get-selected-buffers) (buffer-list)))
3808 ;; we compute this the second time because we need to do memq on it
3809 ;; later, and nconc above will break it. Either this or use slow
3810 ;; append instead of nconc
3811 (selected-buffers (ediff-get-selected-buffers))
3812 (prefered-buffer (car all-buffers))
3813 visible-dired-buffers
3814 (excl-buff-name-list
3815 (mapcar
3816 (lambda (b) (cond ((stringp b) b)
3817 ((bufferp b) (buffer-name b))))
3818 excl-buff-lst))
3819 ;; if at least one buffer on the exclusion list is dired, then force
3820 ;; all others to be dired. This is because this means that the user
3821 ;; has already chosen a dired buffer before
3822 (use-dired-major-mode
3823 (cond ((null (ediff-buffer-live-p (car excl-buff-lst))) 'unknown)
3824 ((eq (ediff-with-current-buffer (car excl-buff-lst) major-mode)
3825 'dired-mode)
3826 'yes)
3827 (t 'no)))
3828 ;; significant-buffers must be visible and not belong
3829 ;; to the exclusion list `buff-list'
3830 ;; We also exclude temporary buffers, but keep mail and gnus buffers
3831 ;; Furthermore, we exclude dired buffers, unless they are the only
3832 ;; ones visible (and there are at least two of them).
3833 ;; Also, any visible window not on the exclusion list that is first in
3834 ;; the buffer list is chosen regardless. (This is because the user
3835 ;; clicked on it or did something to distinguish it).
3836 (significant-buffers
3837 (mapcar
3838 (lambda (x)
3839 (cond ((member (buffer-name x) excl-buff-name-list) nil)
3840 ((memq x selected-buffers) x)
3841 ((not (ediff-get-visible-buffer-window x)) nil)
3842 ((eq x prefered-buffer) x)
3843 ;; if prev selected buffer is dired, look only at
3844 ;; dired.
3845 ((eq use-dired-major-mode 'yes)
3846 (if (eq (ediff-with-current-buffer x major-mode)
3847 'dired-mode)
3848 x nil))
3849 ((eq (ediff-with-current-buffer x major-mode)
3850 'dired-mode)
3851 (if (null use-dired-major-mode)
3852 ;; don't know if we must enforce dired.
3853 ;; Remember this buffer in case
3854 ;; dired buffs are the only ones visible.
3855 (setq visible-dired-buffers
3856 (cons x visible-dired-buffers)))
3857 ;; skip, if dired is not forced
3858 nil)
3859 ((memq (ediff-with-current-buffer x major-mode)
3860 '(rmail-mode
3861 vm-mode
3862 gnus-article-mode
3863 mh-show-mode))
3865 ((string-match "^[ *]" (buffer-name x)) nil)
3866 ((string= "*scratch*" (buffer-name x)) nil)
3867 (t x)))
3868 all-buffers))
3869 (clean-significant-buffers (delq nil significant-buffers))
3870 less-significant-buffers)
3872 (if (and (null clean-significant-buffers)
3873 (> (length visible-dired-buffers) 0))
3874 (setq clean-significant-buffers visible-dired-buffers))
3876 (cond (clean-significant-buffers (car clean-significant-buffers))
3877 ;; try also buffers that are not displayed in windows
3878 ((setq less-significant-buffers
3879 (delq nil
3880 (mapcar
3881 (lambda (x)
3882 (cond ((member (buffer-name x) excl-buff-name-list)
3883 nil)
3884 ((eq use-dired-major-mode 'yes)
3885 (if (eq (ediff-with-current-buffer
3886 x major-mode)
3887 'dired-mode)
3888 x nil))
3889 ((eq (ediff-with-current-buffer x major-mode)
3890 'dired-mode)
3891 nil)
3892 ((string-match "^[ *]" (buffer-name x)) nil)
3893 ((string= "*scratch*" (buffer-name x)) nil)
3894 (t x)))
3895 all-buffers)))
3896 (car less-significant-buffers))
3897 (t "*scratch*"))
3901 ;; If current buffer is a Buffer-menu buffer, then take the selected buffers
3902 ;; and append the buffer at the cursor to the end.
3903 ;; This list would be the preferred list.
3904 (defun ediff-get-selected-buffers ()
3905 (if (eq major-mode 'Buffer-menu-mode)
3906 (let ((lis (condition-case nil
3907 (list (Buffer-menu-buffer t))
3908 (error))
3910 (save-excursion
3911 (goto-char (point-max))
3912 (while (search-backward "\n>" nil t)
3913 (forward-char 1)
3914 (setq lis (cons (Buffer-menu-buffer t) lis)))
3915 lis))
3918 ;; Construct a unique buffer name.
3919 ;; The first one tried is prefixsuffix, then prefix<2>suffix,
3920 ;; prefix<3>suffix, etc.
3921 (defun ediff-unique-buffer-name (prefix suffix)
3922 (if (null (get-buffer (concat prefix suffix)))
3923 (concat prefix suffix)
3924 (let ((n 2))
3925 (while (get-buffer (format "%s<%d>%s" prefix n suffix))
3926 (setq n (1+ n)))
3927 (format "%s<%d>%s" prefix n suffix))))
3930 (defun ediff-submit-report ()
3931 "Submit bug report on Ediff."
3932 (interactive)
3933 (ediff-barf-if-not-control-buffer)
3934 (let ((reporter-prompt-for-summary-p t)
3935 (ctl-buf ediff-control-buffer)
3936 (ediff-device-type (ediff-device-type))
3937 varlist salutation buffer-name)
3938 (setq varlist '(ediff-diff-program ediff-diff-options
3939 ediff-diff3-program ediff-diff3-options
3940 ediff-patch-program ediff-patch-options
3941 ediff-shell
3942 ediff-use-faces
3943 ediff-auto-refine ediff-highlighting-style
3944 ediff-buffer-A ediff-buffer-B ediff-control-buffer
3945 ediff-forward-word-function
3946 ediff-control-frame
3947 ediff-control-frame-parameters
3948 ediff-control-frame-position-function
3949 ediff-prefer-iconified-control-frame
3950 ediff-window-setup-function
3951 ediff-split-window-function
3952 ediff-job-name
3953 ediff-word-mode
3954 buffer-name
3955 ediff-device-type
3957 (setq salutation "
3958 Congratulations! You may have unearthed a bug in Ediff!
3960 Please make a concise and accurate summary of what happened
3961 and mail it to the address above.
3962 -----------------------------------------------------------
3965 (ediff-skip-unsuitable-frames)
3966 (ediff-reset-mouse)
3968 (switch-to-buffer ediff-msg-buffer)
3969 (erase-buffer)
3970 (delete-other-windows)
3971 (insert "
3972 Please read this first:
3973 ----------------------
3975 Some ``bugs'' may actually be no bugs at all. For instance, if you are
3976 reporting that certain difference regions are not matched as you think they
3977 should, this is most likely due to the way Unix diff program decides what
3978 constitutes a difference region. Ediff is an Emacs interface to diff, and
3979 it has nothing to do with those decisions---it only takes the output from
3980 diff and presents it in a way that is better suited for human browsing and
3981 manipulation.
3983 If Emacs happens to dump core, this is NOT an Ediff problem---it is
3984 an Emacs bug. Report this to Emacs maintainers.
3986 Another popular topic for reports is compilation messages. Because Ediff
3987 interfaces to several other packages and runs under Emacs and XEmacs,
3988 byte-compilation may produce output like this:
3990 While compiling toplevel forms in file ediff.el:
3991 ** reference to free variable pm-color-alist
3992 ........................
3993 While compiling the end of the data:
3994 ** The following functions are not known to be defined:
3995 ediff-valid-color-p, ediff-set-face,
3996 ........................
3998 These are NOT errors, but inevitable warnings, which ought to be ignored.
4000 Please do not report those and similar things. However, comments and
4001 suggestions are always welcome.
4003 Mail anyway? (y or n) ")
4005 (if (y-or-n-p "Mail anyway? ")
4006 (progn
4007 (if (ediff-buffer-live-p ctl-buf)
4008 (set-buffer ctl-buf))
4009 (setq buffer-name (buffer-name))
4010 (require 'reporter)
4011 (reporter-submit-bug-report "kifer@cs.stonybrook.edu"
4012 (ediff-version)
4013 varlist
4015 'delete-other-windows
4016 salutation))
4017 (bury-buffer)
4018 (beep 1)(message "Bug report aborted")
4019 (if (ediff-buffer-live-p ctl-buf)
4020 (ediff-with-current-buffer ctl-buf
4021 (ediff-recenter 'no-rehighlight))))
4025 ;; Find an appropriate syntax table for everyone to use
4026 ;; If buffer B is not fundamental or text mode, use its syntax table
4027 ;; Otherwise, use buffer B's.
4028 ;; The syntax mode is used in ediff-forward-word-function
4029 ;; The important thing is that every buffer should use the same syntax table
4030 ;; during the refinement operation
4031 (defun ediff-choose-syntax-table ()
4032 (setq ediff-syntax-table
4033 (ediff-with-current-buffer ediff-buffer-A
4034 (if (not (memq major-mode
4035 '(fundamental-mode text-mode indented-text-mode)))
4036 (syntax-table))))
4037 (if (not ediff-syntax-table)
4038 (setq ediff-syntax-table
4039 (ediff-with-current-buffer ediff-buffer-B
4040 (syntax-table))))
4044 (defun ediff-deactivate-mark ()
4045 (if (featurep 'xemacs)
4046 (zmacs-deactivate-region)
4047 (deactivate-mark)))
4048 (defun ediff-activate-mark ()
4049 (if (featurep 'xemacs)
4050 (zmacs-activate-region)
4051 (progn
4052 (make-local-variable 'transient-mark-mode)
4053 (setq mark-active t
4054 transient-mark-mode t))))
4056 (defun ediff-nuke-selective-display ()
4057 (if (featurep 'xemacs)
4058 (nuke-selective-display)
4059 (save-excursion
4060 (save-restriction
4061 (widen)
4062 (goto-char (point-min))
4063 (let ((mod-p (buffer-modified-p))
4064 buffer-read-only end)
4065 (and (eq t selective-display)
4066 (while (search-forward "\^M" nil t)
4067 (end-of-line)
4068 (setq end (point))
4069 (beginning-of-line)
4070 (while (search-forward "\^M" end t)
4071 (delete-char -1)
4072 (insert "\^J"))))
4073 (set-buffer-modified-p mod-p)
4074 (setq selective-display nil))))))
4077 ;; The next two are modified versions from emerge.el.
4078 ;; VARS must be a list of symbols
4079 ;; ediff-save-variables returns an association list: ((var . val) ...)
4080 (defsubst ediff-save-variables (vars)
4081 (mapcar (lambda (v) (cons v (symbol-value v)))
4082 vars))
4083 ;; VARS is a list of variable symbols.
4084 (defun ediff-restore-variables (vars assoc-list)
4085 (while vars
4086 (set (car vars) (cdr (assoc (car vars) assoc-list)))
4087 (setq vars (cdr vars))))
4089 (defun ediff-change-saved-variable (var value buf-type)
4090 (let* ((assoc-list
4091 (symbol-value (ediff-get-symbol-from-alist
4092 buf-type
4093 ediff-buffer-values-orig-alist)))
4094 (assoc-elt (assoc var assoc-list)))
4095 (if assoc-elt
4096 (setcdr assoc-elt value))))
4099 ;; must execute in control buf
4100 (defun ediff-save-protected-variables ()
4101 (setq ediff-buffer-values-orig-A
4102 (ediff-with-current-buffer ediff-buffer-A
4103 (ediff-save-variables ediff-protected-variables)))
4104 (setq ediff-buffer-values-orig-B
4105 (ediff-with-current-buffer ediff-buffer-B
4106 (ediff-save-variables ediff-protected-variables)))
4107 (if ediff-3way-comparison-job
4108 (setq ediff-buffer-values-orig-C
4109 (ediff-with-current-buffer ediff-buffer-C
4110 (ediff-save-variables ediff-protected-variables))))
4111 (if (ediff-buffer-live-p ediff-ancestor-buffer)
4112 (setq ediff-buffer-values-orig-Ancestor
4113 (ediff-with-current-buffer ediff-ancestor-buffer
4114 (ediff-save-variables ediff-protected-variables)))))
4116 ;; must execute in control buf
4117 (defun ediff-restore-protected-variables ()
4118 (let ((values-A ediff-buffer-values-orig-A)
4119 (values-B ediff-buffer-values-orig-B)
4120 (values-C ediff-buffer-values-orig-C)
4121 (values-Ancestor ediff-buffer-values-orig-Ancestor))
4122 (ediff-with-current-buffer ediff-buffer-A
4123 (ediff-restore-variables ediff-protected-variables values-A))
4124 (ediff-with-current-buffer ediff-buffer-B
4125 (ediff-restore-variables ediff-protected-variables values-B))
4126 (if ediff-3way-comparison-job
4127 (ediff-with-current-buffer ediff-buffer-C
4128 (ediff-restore-variables ediff-protected-variables values-C)))
4129 (if (ediff-buffer-live-p ediff-ancestor-buffer)
4130 (ediff-with-current-buffer ediff-ancestor-buffer
4131 (ediff-restore-variables ediff-protected-variables values-Ancestor)))
4134 ;; save BUFFER in FILE. used in hooks.
4135 (defun ediff-save-buffer-in-file (buffer file)
4136 (ediff-with-current-buffer buffer
4137 (write-file file)))
4140 ;;; Debug
4142 (ediff-defvar-local ediff-command-begin-time '(0 0 0) "")
4144 ;; calculate time used by command
4145 (defun ediff-calc-command-time ()
4146 (let ((end (current-time))
4147 micro sec)
4148 (setq micro
4149 (if (>= (nth 2 end) (nth 2 ediff-command-begin-time))
4150 (- (nth 2 end) (nth 2 ediff-command-begin-time))
4151 (+ (nth 2 end) (- 1000000 (nth 2 ediff-command-begin-time)))))
4152 (setq sec (- (nth 1 end) (nth 1 ediff-command-begin-time)))
4153 (or (equal ediff-command-begin-time '(0 0 0))
4154 (message "Elapsed time: %d second(s) + %d microsecond(s)" sec micro))))
4156 (defsubst ediff-save-time ()
4157 (setq ediff-command-begin-time (current-time)))
4159 (defun ediff-profile ()
4160 "Toggle profiling Ediff commands."
4161 (interactive)
4162 (ediff-barf-if-not-control-buffer)
4164 (if (featurep 'xemacs)
4165 (make-local-hook 'post-command-hook))
4167 (let ((pre-hook 'pre-command-hook)
4168 (post-hook 'post-command-hook))
4169 (if (not (equal ediff-command-begin-time '(0 0 0)))
4170 (progn (remove-hook pre-hook 'ediff-save-time)
4171 (remove-hook post-hook 'ediff-calc-command-time)
4172 (setq ediff-command-begin-time '(0 0 0))
4173 (message "Ediff profiling disabled"))
4174 (add-hook pre-hook 'ediff-save-time t 'local)
4175 (add-hook post-hook 'ediff-calc-command-time nil 'local)
4176 (message "Ediff profiling enabled"))))
4178 (defun ediff-print-diff-vector (diff-vector-var)
4179 (princ (format "\n*** %S ***\n" diff-vector-var))
4180 (mapcar (lambda (overl-vec)
4181 (princ
4182 (format
4183 "Diff %d: \tOverlay: %S
4184 \t\tFine diffs: %s
4185 \t\tNo-fine-diff-flag: %S
4186 \t\tState-of-diff:\t %S
4187 \t\tState-of-merge:\t %S
4189 (1+ (ediff-overlay-get (aref overl-vec 0) 'ediff-diff-num))
4190 (aref overl-vec 0)
4191 ;; fine-diff-vector
4192 (if (= (length (aref overl-vec 1)) 0)
4193 "none\n"
4194 (mapconcat 'prin1-to-string
4195 (aref overl-vec 1) "\n\t\t\t "))
4196 (aref overl-vec 2) ; no fine diff flag
4197 (aref overl-vec 3) ; state-of-diff
4198 (aref overl-vec 4) ; state-of-merge
4200 (eval diff-vector-var)))
4204 (defun ediff-debug-info ()
4205 (interactive)
4206 (ediff-barf-if-not-control-buffer)
4207 (with-output-to-temp-buffer ediff-debug-buffer
4208 (ediff-with-current-buffer standard-output
4209 (fundamental-mode))
4210 (princ (format "\nCtl buffer: %S\n" ediff-control-buffer))
4211 (ediff-print-diff-vector (intern "ediff-difference-vector-A"))
4212 (ediff-print-diff-vector (intern "ediff-difference-vector-B"))
4213 (ediff-print-diff-vector (intern "ediff-difference-vector-C"))
4214 (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor"))
4218 ;;; General utilities
4220 ;; this uses comparison-func to decide who is a member
4221 (defun ediff-member (elt lis comparison-func)
4222 (while (and lis (not (funcall comparison-func (car lis) elt)))
4223 (setq lis (cdr lis)))
4224 lis)
4226 ;; Make a readable representation of the invocation sequence for FUNC-DEF.
4227 ;; It would either be a key or M-x something.
4228 (defun ediff-format-bindings-of (func-def)
4229 (let ((desc (car (where-is-internal func-def
4230 overriding-local-map
4231 nil nil))))
4232 (if desc
4233 (key-description desc)
4234 (format "M-x %s" func-def))))
4236 ;; this uses comparison-func to decide who is a member, and this determines how
4237 ;; intersection looks like
4238 (defun ediff-intersection (lis1 lis2 comparison-func)
4239 (let ((result (list 'a)))
4240 (while lis1
4241 (if (ediff-member (car lis1) lis2 comparison-func)
4242 (nconc result (list (car lis1))))
4243 (setq lis1 (cdr lis1)))
4244 (cdr result)))
4247 ;; eliminates duplicates using comparison-func
4248 (defun ediff-union (lis1 lis2 comparison-func)
4249 (let ((result (list 'a)))
4250 (while lis1
4251 (or (ediff-member (car lis1) (cdr result) comparison-func)
4252 (nconc result (list (car lis1))))
4253 (setq lis1 (cdr lis1)))
4254 (while lis2
4255 (or (ediff-member (car lis2) (cdr result) comparison-func)
4256 (nconc result (list (car lis2))))
4257 (setq lis2 (cdr lis2)))
4258 (cdr result)))
4260 ;; eliminates duplicates using comparison-func
4261 (defun ediff-set-difference (lis1 lis2 comparison-func)
4262 (let ((result (list 'a)))
4263 (while lis1
4264 (or (ediff-member (car lis1) (cdr result) comparison-func)
4265 (ediff-member (car lis1) lis2 comparison-func)
4266 (nconc result (list (car lis1))))
4267 (setq lis1 (cdr lis1)))
4268 (cdr result)))
4270 (defun ediff-add-to-history (history-var newelt)
4271 (if (fboundp 'add-to-history)
4272 (add-to-history history-var newelt)
4273 (set history-var (cons newelt (symbol-value history-var)))))
4275 (defalias 'ediff-copy-list 'copy-sequence)
4278 ;; don't report error if version control package wasn't found
4279 ;;(ediff-load-version-control 'silent)
4281 (run-hooks 'ediff-load-hook)
4283 (provide 'ediff-util)
4286 ;; Local Variables:
4287 ;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
4288 ;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
4289 ;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
4290 ;; End:
4292 ;; arch-tag: f51099b6-ef4b-470f-88a1-3a0e0b03a879
4293 ;;; ediff-util.el ends here