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