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