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