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