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