lisp/ediff-vers.el

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