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