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