(gdb-registers-mode): Let gdbmi use
[bpt/emacs.git] / lisp / ediff-vers.el
CommitLineData
8122a6da
MK
1;;; ediff-vers.el --- version control interface to Ediff
2
50a07e18 3;;; Copyright (C) 1995, 96, 97, 2002 Free Software Foundation, Inc.
8122a6da 4
50a07e18 5;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
8122a6da
MK
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
3afbc435 24;;; Commentary:
8122a6da
MK
25
26;;; Code:
bbe6126c
MK
27
28;; Compiler pacifier
29(defvar rcs-default-co-switches)
30(defvar sc-mode)
31(defvar cvs-shell)
32(defvar cvs-program)
33(defvar cvs-cookie-handle)
ddc90f39 34(defvar ediff-temp-file-prefix)
bbe6126c 35
92c51e07
MK
36(and noninteractive
37 (eval-when-compile
50a07e18
MK
38 (let ((load-path (cons (expand-file-name ".") load-path)))
39 (load "pcl-cvs" 'noerror)
40 (load "rcs" 'noerror)
41 ;; On 8+3 MS-DOS filesystems, generic-x.el is loaded
42 ;; instead of (the missing) generic-sc.el. Since the
43 ;; version of Emacs which supports MS-DOS doesn't have
44 ;; generic-sc, we simply avoid loading it.
45 (or (and (fboundp 'msdos-long-file-names)
46 (not (msdos-long-file-names)))
47 (load "generic-sc" 'noerror))
48 ;; (load "vc" 'noerror) ; this sometimes causes compiler error
49 (or (featurep 'ediff-init)
50 (load "ediff-init.el" nil nil 'nosuffix))
51 )))
bbe6126c 52;; end pacifier
71296446 53
8122a6da 54;; VC.el support
0831d50c
MK
55
56(defun ediff-vc-latest-version (file)
57 "Return the version level of the latest version of FILE in repository."
58 (if (fboundp 'vc-latest-version)
59 (vc-latest-version file)
60 (or (vc-file-getprop file 'vc-latest-version)
61 (cond ((vc-backend file)
62 (vc-call state file)
63 (vc-file-getprop file 'vc-latest-version))
64 (t (error "File %s is not under version control" file))))
65 ))
66
67
92c51e07 68(defun ediff-vc-internal (rev1 rev2 &optional startup-hooks)
0831d50c
MK
69 ;; Run Ediff on versions of the current buffer.
70 ;; If REV1 is "", use the latest version of the current buffer's file.
71 ;; If REV2 is "" then compare current buffer with REV1.
72 ;; If the current buffer is named `F', the version is named `F.~REV~'.
73 ;; If `F.~REV~' already exists, it is used instead of being re-created.
8122a6da 74 (let (file1 file2 rev1buf rev2buf)
71296446 75 (if (string= rev1 "")
0831d50c 76 (setq rev1 (ediff-vc-latest-version (buffer-file-name))))
657f9cb8
MK
77 (save-window-excursion
78 (save-excursion
79 (vc-version-other-window rev1)
80 (setq rev1buf (current-buffer)
81 file1 (buffer-file-name)))
82 (save-excursion
83 (or (string= rev2 "") ; use current buffer
84 (vc-version-other-window rev2))
85 (setq rev2buf (current-buffer)
86 file2 (buffer-file-name)))
87 (setq startup-hooks
88 (cons `(lambda ()
89 (delete-file ,file1)
90 (or ,(string= rev2 "") (delete-file ,file2)))
91 startup-hooks)))
8122a6da
MK
92 (ediff-buffers
93 rev1buf rev2buf
94 startup-hooks
95 'ediff-revision)))
71296446 96
8122a6da
MK
97;; RCS.el support
98(defun rcs-ediff-view-revision (&optional rev)
99;; View previous RCS revision of current file.
100;; With prefix argument, prompts for a revision name.
71296446 101 (interactive (list (if current-prefix-arg
8122a6da
MK
102 (read-string "Revision: "))))
103 (let* ((filename (buffer-file-name (current-buffer)))
104 (switches (append '("-p")
105 (if rev (list (concat "-r" rev)) nil)))
106 (buff (concat (file-name-nondirectory filename) ".~" rev "~")))
107 (message "Working ...")
108 (setq filename (expand-file-name filename))
109 (with-output-to-temp-buffer buff
7de0717c
DL
110 (ediff-with-current-buffer standard-output
111 (fundamental-mode))
8122a6da
MK
112 (let ((output-buffer (ediff-rcs-get-output-buffer filename buff)))
113 (delete-windows-on output-buffer)
114 (save-excursion
115 (set-buffer output-buffer)
116 (apply 'call-process "co" nil t nil
117 ;; -q: quiet (no diagnostics)
118 (append switches rcs-default-co-switches
71296446 119 (list "-q" filename)))))
8122a6da 120 (message "")
71296446
JB
121 buff)))
122
8122a6da
MK
123(defun ediff-rcs-get-output-buffer (file name)
124 ;; Get a buffer for RCS output for FILE, make it writable and clean it up.
125 ;; Optional NAME is name to use instead of `*RCS-output*'.
3af0304a 126 ;; This is a modified version from rcs.el v1.1. I use it here to make
8122a6da
MK
127 ;; Ediff immune to changes in rcs.el
128 (let* ((default-major-mode 'fundamental-mode) ; no frills!
129 (buf (get-buffer-create name)))
130 (save-excursion
131 (set-buffer buf)
132 (setq buffer-read-only nil
133 default-directory (file-name-directory (expand-file-name file)))
134 (erase-buffer))
135 buf))
136
92c51e07 137(defun ediff-rcs-internal (rev1 rev2 &optional startup-hooks)
8122a6da
MK
138;; Run Ediff on versions of the current buffer.
139;; If REV2 is "" then use current buffer.
657f9cb8
MK
140 (let (rev2buf rev1buf)
141 (save-window-excursion
142 (setq rev2buf (if (string= rev2 "")
143 (current-buffer)
144 (rcs-ediff-view-revision rev2))
145 rev1buf (rcs-ediff-view-revision rev1)))
71296446 146
8122a6da
MK
147 ;; rcs.el doesn't create temp version files, so we don't have to delete
148 ;; anything in startup hooks to ediff-buffers
149 (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)
150 ))
151
152
153;; GENERIC-SC.el support
154
155(defun generic-sc-get-latest-rev ()
156 (cond ((eq sc-mode 'CCASE)
157 (eval "main/LATEST"))
158 (t (eval ""))))
159
92c51e07 160(defun ediff-generic-sc-internal (rev1 rev2 &optional startup-hooks)
8122a6da
MK
161;; Run Ediff on versions of the current buffer.
162;; If REV2 is "" then compare current buffer with REV1.
163;; If the current buffer is named `F', the version is named `F.~REV~'.
164;; If `F.~REV~' already exists, it is used instead of being re-created.
165 (let (rev1buf rev2buf)
166 (save-excursion
167 (if (or (not rev1) (string= rev1 ""))
168 (setq rev1 (generic-sc-get-latest-rev)))
169 (sc-visit-previous-revision rev1)
170 (setq rev1buf (current-buffer)))
171 (save-excursion
172 (or (string= rev2 "") ; use current buffer
173 (sc-visit-previous-revision rev2))
174 (setq rev2buf (current-buffer)))
175 (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)))
176
177
178;;; Merge with Version Control
179
71296446 180(defun ediff-vc-merge-internal (rev1 rev2 ancestor-rev
328b4b70 181 &optional startup-hooks merge-buffer-file)
8122a6da
MK
182;; If ANCESTOR-REV non-nil, merge with ancestor
183 (let (buf1 buf2 ancestor-buf)
657f9cb8
MK
184 (save-window-excursion
185 (save-excursion
186 (vc-version-other-window rev1)
187 (setq buf1 (current-buffer)))
188 (save-excursion
189 (or (string= rev2 "")
190 (vc-version-other-window rev2))
191 (setq buf2 (current-buffer)))
192 (if ancestor-rev
193 (save-excursion
194 (if (string= ancestor-rev "")
195 (setq ancestor-rev (vc-workfile-version buffer-file-name)))
196 (vc-version-other-window ancestor-rev)
197 (setq ancestor-buf (current-buffer))))
71296446
JB
198 (setq startup-hooks
199 (cons
200 `(lambda ()
657f9cb8
MK
201 (delete-file ,(buffer-file-name buf1))
202 (or ,(string= rev2 "")
203 (delete-file ,(buffer-file-name buf2)))
204 (or ,(string= ancestor-rev "")
205 ,(not ancestor-rev)
206 (delete-file ,(buffer-file-name ancestor-buf)))
207 )
208 startup-hooks)))
8122a6da
MK
209 (if ancestor-rev
210 (ediff-merge-buffers-with-ancestor
211 buf1 buf2 ancestor-buf
328b4b70
MK
212 startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
213 (ediff-merge-buffers
214 buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))
8122a6da
MK
215 ))
216
92c51e07 217(defun ediff-rcs-merge-internal (rev1 rev2 ancestor-rev
328b4b70
MK
218 &optional
219 startup-hooks merge-buffer-file)
8122a6da
MK
220 ;; If ANCESTOR-REV non-nil, merge with ancestor
221 (let (buf1 buf2 ancestor-buf)
657f9cb8
MK
222 (save-window-excursion
223 (setq buf1 (rcs-ediff-view-revision rev1)
224 buf2 (if (string= rev2 "")
225 (current-buffer)
226 (rcs-ediff-view-revision rev2))
227 ancestor-buf (if ancestor-rev
228 (if (string= ancestor-rev "")
229 (current-buffer)
230 (rcs-ediff-view-revision ancestor-rev)))))
8122a6da
MK
231 ;; rcs.el doesn't create temp version files, so we don't have to delete
232 ;; anything in startup hooks to ediff-buffers
233 (if ancestor-rev
234 (ediff-merge-buffers-with-ancestor
235 buf1 buf2 ancestor-buf
328b4b70
MK
236 startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
237 (ediff-merge-buffers
238 buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
8122a6da 239
92c51e07 240(defun ediff-generic-sc-merge-internal (rev1 rev2 ancestor-rev
328b4b70
MK
241 &optional
242 startup-hooks merge-buffer-file)
8122a6da
MK
243 ;; If ANCESTOR-REV non-nil, merge with ancestor
244 (let (buf1 buf2 ancestor-buf)
245 (save-excursion
246 (if (string= rev1 "")
247 (setq rev1 (generic-sc-get-latest-rev)))
248 (sc-visit-previous-revision rev1)
249 (setq buf1 (current-buffer)))
250 (save-excursion
251 (or (string= rev2 "")
252 (sc-visit-previous-revision rev2))
253 (setq buf2 (current-buffer)))
254 (if ancestor-rev
255 (save-excursion
256 (or (string= ancestor-rev "")
257 (sc-visit-previous-revision ancestor-rev))
258 (setq ancestor-buf (current-buffer))))
259 (if ancestor-rev
260 (ediff-merge-buffers-with-ancestor
261 buf1 buf2 ancestor-buf
328b4b70
MK
262 startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
263 (ediff-merge-buffers
264 buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
8122a6da
MK
265
266
267;; PCL-CVS.el support
268
50a07e18 269;; MK: Check. This function doesn't seem to be used any more by pcvs or pcl-cvs
8122a6da
MK
270(defun cvs-run-ediff-on-file-descriptor (tin)
271;; This is a replacement for cvs-emerge-mode
328b4b70 272;; Runs after cvs-update.
8122a6da
MK
273;; Ediff-merge appropriate revisions of the selected file.
274 (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
275 (type (cvs-fileinfo->type fileinfo))
276 (tmp-file
277 (cvs-retrieve-revision-to-tmpfile fileinfo))
c004db97 278 (default-directory
2eb4bdca 279 (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
8122a6da 280 ancestor-file)
71296446 281
8122a6da
MK
282 (or (memq type '(MERGED CONFLICT MODIFIED))
283 (error
284 "Can only merge `Modified', `Merged' or `Conflict' files"))
71296446 285
8122a6da
MK
286 (cond ((memq type '(MERGED CONFLICT))
287 (setq ancestor-file
288 (cvs-retrieve-revision-to-tmpfile
289 fileinfo
290 ;; revision
291 (cvs-fileinfo->base-revision fileinfo)))
292 (ediff-merge-buffers-with-ancestor
293 (find-file-noselect tmp-file)
294 (find-file-noselect (cvs-fileinfo->backup-file fileinfo))
295 (find-file-noselect ancestor-file)
296 nil ; startup-hooks
297 'ediff-merge-revisions-with-ancestor))
298 ((eq type 'MODIFIED)
c004db97 299 (ediff-buffers
8122a6da
MK
300 (find-file-noselect tmp-file)
301 (find-file-noselect (cvs-fileinfo->full-path fileinfo))
302 nil ; startup-hooks
c004db97 303 'ediff-revisions)))
8122a6da
MK
304 (if (stringp tmp-file) (delete-file tmp-file))
305 (if (stringp ancestor-file) (delete-file ancestor-file))))
306
307;;; Local Variables:
308;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
e756eb9f
MK
309;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
310;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
8122a6da
MK
311;;; End:
312
313(provide 'ediff-vers)
314
ab5796a9 315;;; arch-tag: bbb34f0c-2a90-426a-a77a-c75f479ebbbf
8122a6da 316;;; ediff-vers.el ends here